Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/Semant/pickle/pickmod-new.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/pickle/pickmod-new.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 772, Thu Jan 4 15:36:41 2001 UTC revision 773, Mon Jan 8 16:18:37 2001 UTC
# Line 142  Line 142 
142           DTF, TYCON, T, II, VAR, SD, SG, FSG,  SP, EN,           DTF, TYCON, T, II, VAR, SD, SG, FSG,  SP, EN,
143           STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,           STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,
144           B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD,           B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD,
145           OVERLD, FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID) =           OVERLD, FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID, CCI, CTYPE) =
146          (1, 2, 3, 4, 5, 6, 7, 8, 9, 10,          (1, 2, 3, 4, 5, 6, 7, 8, 9, 10,
147           11, 12, 13, 14, 15, 16, 17, 18, 19, 20,           11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
148           21, 22, 23, 24, 25, 26, 27, 28, 29, 30,           21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
149           31, 32, 33, 34, 35, 36, 37, 38, 39, 40,           31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
150           41, 42, 43, 44, 45, 46, 47, 48, 49,           41, 42, 43, 44, 45, 46, 47, 48, 49,
151           50, 51, 52, 53, 54, 55, 56, 57)           50, 51, 52, 53, 54, 55, 56, 57, 58, 59)
152    
153      (* this is a bit awful...      (* this is a bit awful...
154       * (we really ought to have syntax for "functional update") *)       * (we really ought to have syntax for "functional update") *)
# Line 313  Line 313 
313          cmpopc oper $ []          cmpopc oper $ []
314      end      end
315    
316        fun ctype t = let
317            val op $ = PU.$ CTYPE
318            fun ?n = String.str (Char.chr n)
319            fun %?n = ?n $ []
320        in
321            case t of
322                CTypes.C_void => %?0
323              | CTypes.C_float => %?1
324              | CTypes.C_double => %?2
325              | CTypes.C_long_double => %?3
326              | CTypes.C_unsigned CTypes.I_char => %?4
327              | CTypes.C_unsigned CTypes.I_short => %?5
328              | CTypes.C_unsigned CTypes.I_int => %?6
329              | CTypes.C_unsigned CTypes.I_long => %?7
330              | CTypes.C_unsigned CTypes.I_long_long => %?8
331              | CTypes.C_signed CTypes.I_char => %?9
332              | CTypes.C_signed CTypes.I_short => %?10
333              | CTypes.C_signed CTypes.I_int => %?11
334              | CTypes.C_signed CTypes.I_long => %?12
335              | CTypes.C_signed CTypes.I_long_long => %?13
336              | CTypes.C_PTR => %?14
337    
338              | CTypes.C_ARRAY (t, i) => ?20 $ [ctype t, int i]
339              | CTypes.C_STRUCT l => ?21 $ [list ctype l]
340        end
341    
342        fun ccall_info { c_proto = { conv, retTy, paramTys },
343                         ml_flt_args, ml_flt_res } = let
344            val op $ = PU.$ CCI
345        in
346            "C" $ [string conv, ctype retTy, list ctype paramTys,
347                   list bool ml_flt_args, bool ml_flt_res]
348        end
349    
350      fun primop p = let      fun primop p = let
351          val op $ = PU.$ PO          val op $ = PU.$ PO
352          fun ?n = String.str (Char.chr n)          fun ?n = String.str (Char.chr n)
# Line 343  Line 377 
377                | P.INL_MONOVECTOR kind => ?115 $ [numkind kind]                | P.INL_MONOVECTOR kind => ?115 $ [numkind kind]
378                | P.RAW_LOAD kind => ?116 $ [numkind kind]                | P.RAW_LOAD kind => ?116 $ [numkind kind]
379                | P.RAW_STORE kind => ?117 $ [numkind kind]                | P.RAW_STORE kind => ?117 $ [numkind kind]
380                  | P.RAW_CCALL (SOME i) => ?118 $ [ccall_info i]
381    
382                | P.MKETAG => %?0                | P.MKETAG => %?0
383                | P.WRAP => %?1                | P.WRAP => %?1
# Line 408  Line 443 
443                | P.SUBSCRIPT_REC => %?58                | P.SUBSCRIPT_REC => %?58
444                | P.SUBSCRIPT_RAW64 => %?59                | P.SUBSCRIPT_RAW64 => %?59
445                | P.UNBOXEDASSIGN => %?60                | P.UNBOXEDASSIGN => %?60
446                | P.RAW_CCALL => %?61                | P.RAW_CCALL NONE => %?61
447      end      end
448    
449      fun consig arg = let      fun consig arg = let
# Line 765  Line 800 
800          val op $ = PU.$ IPATH          val op $ = PU.$ IPATH
801          fun ipath (IP.IPATH p) = "i" $ [list symbol p]          fun ipath (IP.IPATH p) = "i" $ [list symbol p]
802    
803              (* for debugging *)
804            fun showipath (IP.IPATH p) =
805                concat (map (fn s => Symbol.symbolToString s ^ ".") (rev p))
806    
807          val label = symbol          val label = symbol
808    
809          fun eqprop eqp = let          fun eqprop eqp = let

Legend:
Removed from v.772  
changed lines
  Added in v.773

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0