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/branches/primop-branch-2/src/compiler/Semant/statenv/prim.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-2/src/compiler/Semant/statenv/prim.sml

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

revision 1955, Thu Jul 6 20:10:33 2006 UTC revision 1956, Thu Jul 6 20:13:39 2006 UTC
# Line 23  Line 23 
23    structure T = Types    structure T = Types
24    structure TU = TypesUtil    structure TU = TypesUtil
25    structure MU = ModuleUtil    structure MU = ModuleUtil
   structure P = PrimOp  
26    
27    structure ST = Stamps    structure ST = Stamps
28    structure V = VarCon    structure V = VarCon
29    
30    structure A = Access    structure A = Access
   structure II = InlInfo  
31    
32  in  in
33    
# Line 140  Line 138 
138   *                 BUILDING A COMPLETE LIST OF PRIMOPS                    *   *                 BUILDING A COMPLETE LIST OF PRIMOPS                    *
139   **************************************************************************)   **************************************************************************)
140    
141  local  (* We generate unique numbers for each primop, and bind them as components
142    of a structure InLine, with the generic type all = (All 'a).'a. The primop
143  fun bits size oper = P.ARITH{oper=oper, overflow=false, kind=P.INT size}  intrinsic types will be specified in a separate table used in the translate
144  val bits31 = bits 31  phase (and FLINT?).
 val bits32 = bits 32  
   
 fun int size oper = P.ARITH{oper=oper, overflow=true, kind=P.INT size}  
 val int31 = int 31  
 val int32 = int 32  
   
 fun word size oper = P.ARITH{oper=oper, overflow=false, kind=P.UINT size}  
 val word32 = word 32  
 val word31 = word 31  
 val word8  = word 8  
   
 fun purefloat size oper = P.ARITH{oper=oper,overflow=false,kind=P.FLOAT size}  
 val purefloat64 = purefloat 64  
   
 fun cmp kind oper = P.CMP{oper=oper, kind=kind}  
 val int31cmp = cmp (P.INT 31)  
 val int32cmp = cmp (P.INT 32)  
   
 val word32cmp = cmp (P.UINT 32)  
 val word31cmp = cmp (P.UINT 31)  
 val word8cmp  = cmp (P.UINT 8)  
   
 val float64cmp = cmp (P.FLOAT 64)  
   
 val v1 = T.IBOUND 0  
 val v2 = T.IBOUND 1  
 val v3 = T.IBOUND 2  
   
 val tu = BT.tupleTy  
 fun ar(t1,t2) = BT.--> (t1, t2)  
   
 fun ap(tc,l) = T.CONty(tc, l)  
 fun cnt t = T.CONty(BT.contTycon,[t])  
 fun ccnt t = T.CONty(BT.ccontTycon,[t])  
 fun rf t = T.CONty(BT.refTycon,[t])  
 fun ay t = T.CONty(BT.arrayTycon,[t])  
 fun vct t = T.CONty(BT.vectorTycon,[t])  
   
 val u = BT.unitTy  
 val bo = BT.boolTy  
 val i = BT.intTy  
 val i32 = BT.int32Ty  
 val i64 = BT.int64Ty  
 val inf = BT.intinfTy  
 val w8 = BT.word8Ty  
 val w = BT.wordTy  
 val w32 = BT.word32Ty  
 val w64 = BT.word64Ty  
 val f64 = BT.realTy  
 val s  = BT.stringTy  
   
 fun p0 t = t  
 fun p1 t = T.POLYty {sign=[false], tyfun=T.TYFUN {arity=1, body=t}}  
 fun ep1 t = T.POLYty {sign=[true], tyfun=T.TYFUN {arity=1, body=t}}  
 fun p2 t = T.POLYty {sign=[false,false], tyfun=T.TYFUN {arity=2, body=t}}  
 fun p3 t = T.POLYty {sign=[false,false,false], tyfun=T.TYFUN {arity=3, body=t}}  
   
 fun sub kind = P.NUMSUBSCRIPT{kind=kind, checked=false, immutable=false}  
 fun chkSub kind = P.NUMSUBSCRIPT{kind=kind, checked=true, immutable=false}  
   
 fun subv kind = P.NUMSUBSCRIPT{kind=kind, checked=false, immutable=true}  
 fun chkSubv kind = P.NUMSUBSCRIPT{kind=kind, checked=true, immutable=true}  
   
 fun update kind = P.NUMUPDATE {kind=kind, checked=false}  
 fun chkUpdate kind = P.NUMUPDATE {kind=kind, checked=true}  
   
 val numSubTy = p2(ar(tu[v1,i],v2))  
 val numUpdTy = p2(ar(tu[v1,i,v2],u))  
   
 fun unf t = p0(ar(t,t))  
 fun binf t = p0(ar(tu[t,t],t))  
 fun binp t = p0(ar(tu[t,t],bo))  
 fun shifter t = p0(ar(tu[t,w],t))  
   
 val w32_i32 = p0(ar(w32,i32))  
 val w32_f64 = p0(ar(w32,f64))  
 val w32w32_u = p0(ar(tu[w32,w32],u))  
 val w32i32_u = p0(ar(tu[w32,i32],u))  
 val w32f64_u = p0(ar(tu[w32,f64],u))  
   
 val i_x      = p1(ar(i,v1))  
 val xw32_w32 = p1(ar(tu[v1,w32],w32))  
 val xw32_i32 = p1(ar(tu[v1,w32],i32))  
 val xw32_f64 = p1(ar(tu[v1,w32],f64))  
 val xw32w32_u = p1(ar(tu[v1,w32,w32],u))  
 val xw32i32_u = p1(ar(tu[v1,w32,i32],u))  
 val xw32f64_u = p1(ar(tu[v1,w32,f64],u))  
   
 val b_b = unf bo  
   
 val f64_i = p0(ar(f64,i))  
 val i_f64 = p0(ar(i,f64))  
 val i32_f64 = p0(ar(i32,f64))  
   
 val w32_i = p0(ar(w32,i))  
 val i32_i = p0(ar(i32,i))  
   
 val i_i32 = p0(ar(i,i32))  
 val i_w32 = p0(ar(i,w32))  
   
 val w32_w = p0(ar(w32,w))  
 val i32_w = p0(ar(i32,w))  
   
 val w_w32 = p0(ar(w,w32))  
 val w_i32 = p0(ar(w,i32))  
   
 val w_i = p0(ar(w,i))  
 val i_w = p0(ar(i,w))  
   
 val w32_i32 = p0(ar(w32,i32))  
 val i32_w32 = p0(ar(i32,w32))  
   
 val i_i = unf i  
 val ii_i = binf i  
 val ii_b = binp i  
 val iw_i = shifter i  
   
 val w_w = unf w  
 val ww_w = binf w  
 val ww_b = binp w  
   
 val i32_i32 = unf i32  
 val i32i32_i32 = binf i32  
 val i32i32_b = binp i32  
   
 val w32_w32 = unf w32  
 val w32w32_w32 = binf w32  
 val w32w32_b = binp w32  
 val w32w_w32 = shifter w32  
   
 val w8_w8 = unf w8  
 val w8w8_w8 = binf w8  
 val w8w8_b = binp w8  
 val w8w_w8 = shifter w8  
   
 val f64_f64 = unf f64  
 val f64f64_f64 = binf f64  
 val f64f64_b = binp f64  
   
 val w8_i = p0(ar(w8,i))  
 val w8_i32 = p0(ar(w8,i32))  
 val w8_w32 = p0(ar(w8,w32))  
 val i_w8 = p0(ar(i,w8))  
 val i32_w8 = p0(ar(i32,w8))  
 val w32_w8 = p0(ar(w32,w8))  
   
 val inf_i   = p0(ar(inf,i))  
 val inf_i32 = p0(ar(inf,i32))  
 val inf_i64 = p0(ar(inf,i64))  
 val inf_w8  = p0(ar(inf,w8))  
 val inf_w   = p0(ar(inf,w))  
 val inf_w32 = p0(ar(inf,w32))  
 val inf_w64 = p0(ar(inf,w64))  
 val i_inf   = p0(ar(i,inf))  
 val i32_inf = p0(ar(i32,inf))  
 val i64_inf = p0(ar(i64,inf))  
 val w8_inf  = p0(ar(w8,inf))  
 val w_inf   = p0(ar(w,inf))  
 val w32_inf = p0(ar(w32,inf))  
 val w64_inf = p0(ar(w64,inf))  
   
 val w64_pw32 = p0(ar(w64,tu[w32,w32]))  
 val pw32_w64 = p0(ar(tu[w32,w32],w64))  
 val i64_pw32 = p0(ar(i64,tu[w32,w32]))  
 val pw32_i64 = p0(ar(tu[w32,w32],i64))  
   
 val cc_b = binp BT.charTy  
   
 (* The type of the RAW_CCALL primop (as far as the type checker is concerned)  
  * is:  
  *    word32 * 'a * 'b -> 'd  
  * However, the primop cannot be used without having 'a, 'b, and 'c  
  * monomorphically instantiated.  In particular, 'a will be the type of the  
  * ML argument list, 'c will be the type of the result, and 'b  
  * will be a type of a fake arguments.  The idea is that 'b will be  
  * instantiated with some ML type that encodes the type of the actual  
  * C function in order to be able to generate code according to the C  
  * calling convention.  
  * (In other words, 'b will be a completely ad-hoc encoding of a CTypes.c_proto  
  * value in ML types.  The encoding also contains information about  
  * calling conventions and reentrancy.)  
145   *)   *)
 val rccType = p3(ar(tu[w32,v1,v2],v3))  
   
 in  
146    
147  (*  (*
148   * I made an effort to eliminate the cases where type info for primops  val v1 = T.IBOUND 0
149   * is left NONE because this is, in fact, incorrect.  (As long as they  fun p1 t = T.POLYty {sign=[false], tyfun=T.TYFUN {arity=1, body=t}}
  * are left at NONE, there are correct ML programs that trigger internal  
  * compiler errors.)  
  *    - M.Blume (1/2001)  
150   *)   *)
151    (* the generic type (All 'a).'a *)
152    val all = T.POLYty {sign=[false], tyfun=T.TYFUN {arity=1, body=T.IBOUND 0}}
153    
154  val allPrimops =  val allPrimops =
155      [] :-:      ["callcc",
156         ("callcc",        P.CALLCC,      p1(ar(ar(cnt(v1),v1),v1))) :-:       "throw",
157         ("throw",         P.THROW,       p2(ar(cnt(v1),ar(v1,v2)))) :-:       "capture",
158         ("capture",       P.CAPTURE,     p1(ar(ar(ccnt(v1),v1),v1))) :-:       "isolate",
159         ("isolate",       P.ISOLATE,     p1(ar(ar(v1,u),cnt(v1)))) :-:       "cthrow",
160         ("cthrow",        P.THROW,       p2(ar(ccnt(v1),ar(v1,v2)))) :-:       "!",
161         ("!",             P.DEREF,       p1(ar(rf(v1),v1))) :-:       ":=",
162         (":=",            P.ASSIGN,      p1(ar(tu[rf(v1),v1],u))) :-:       "makeref",
163         ("makeref",       P.MAKEREF,     p1(ar(v1,rf(v1)))) :-:       "boxed",
164         ("boxed",         P.BOXED,       p1(ar(v1,bo))) :-:       "unboxed",
165         ("unboxed",       P.UNBOXED,     p1(ar(v1,bo))) :-:       "cast",
166         ("cast",          P.CAST,        p2(ar(v1,v2))) :-:       "=",
167         ("=",             P.POLYEQL,     ep1(ar(tu[v1,v1],bo))) :-:       "<>",
168         ("<>",            P.POLYNEQ,     ep1(ar(tu[v1,v1],bo))) :-:       "ptreql",
169         ("ptreql",        P.PTREQL,      p1(ar(tu[v1,v1],bo))) :-:       "ptrneq",
170         ("ptrneq",        P.PTRNEQ,      p1(ar(tu[v1,v1],bo))) :-:       "getvar",
171         ("getvar",        P.GETVAR,      p1(ar(u,v1))) :-:       "setvar",
172         ("setvar",        P.SETVAR,      p1(ar(v1,u))) :-:       "setpseudo",
173         ("setpseudo",     P.SETPSEUDO,   p1(ar(tu[v1,i],u))) :-:       "getpseudo",
174         ("getpseudo",     P.GETPSEUDO,   p1(ar(i,v1))) :-:       "mkspecial",
175         ("mkspecial",     P.MKSPECIAL,   p2(ar(tu[i,v1],v2))) :-:       "getspecial",
176         ("getspecial",    P.GETSPECIAL,  p1(ar(v1,i))) :-:       "setspecial",
177         ("setspecial",    P.SETSPECIAL,  p1(ar(tu[v1,i],u))) :-:       "gethdlr",
178         ("gethdlr",       P.GETHDLR,     p1(ar(u,cnt(v1)))) :-:       "sethdlr",
179         ("sethdlr",       P.SETHDLR,     p1(ar(cnt(v1),u))) :-:       "gettag",
180         ("gettag",        P.GETTAG,      p1(ar(v1,i))) :-:       "setmark",
181         ("setmark",       P.SETMARK,     p1(ar(v1,u))) :-:       "dispose",
182         ("dispose",       P.DISPOSE,     p1(ar(v1,u))) :-:       "compose",
183         ("compose",       P.INLCOMPOSE,  p3(ar(tu[ar(v2,v3),ar(v1,v2)],ar(v1,v3)))) :-:       "before",
184         ("before",        P.INLBEFORE,   p2(ar(tu[v1,v2],v1))) :-:       "ignore",
185         ("ignore",        P.INLIGNORE,   p1(ar(v1,u))) :-:       "identity",
186         ("identity",      P.INLIDENTITY, p1(ar(v1,v1))) :-:       "length",
187         "objlength",
188         "unboxedupdate",
189         ("length",        P.LENGTH,      p1(ar(v1,i))) :-:       "inlnot",
190         ("objlength",     P.OBJLENGTH,   p1(ar(v1,i))) :-:       "floor",
191         "round",
192         (*       "real",
193          * I believe the following five primops should not be exported into       "real32",
194          * the InLine structure. (ZHONG)       "ordof",
195          *)       "store",
196         (* So we take them out... (Matthias)       "inlbyteof",
197         ("boxedupdate",   P.BOXEDUPDATE,   ?) :-:       "inlstore",
198         ("getrunvec",     P.GETRUNVEC,     ?) :-:       "inlordof",
199         ("uselvar",       P.USELVAR,       ?) :-:       "mkarray",
200         ("deflvar",       P.DEFLVAR,       ?) :-:       "arrSub",
201         *)       "arrChkSub",
202         "vecSub",
203         (* I put this one back in so tprof can find it in _Core       "vecChkSub",
204          * instead of having to construct it ... (Matthias) *)       "arrUpdate",
205         ("unboxedupdate", P.UNBOXEDUPDATE, p1(ar(tu[ay(v1),i,v1],u))) :-:       "arrChkUpdate",
206         "newArray0",
207         ("inlnot",        P.INLNOT,                      b_b) :-:       "getSeqData",
208         ("floor",         P.ROUND{floor=true,       "recordSub",
209                                 fromkind=P.FLOAT 64,       "raw64Sub",
210                                 tokind=P.INT 31},        f64_i) :-:       "test_32_31_w",
211         ("round",         P.ROUND{floor=false,       "test_32_31_i",
212                                 fromkind=P.FLOAT 64,       "testu_31_31",
213                                 tokind=P.INT 31},        f64_i) :-:       "testu_32_31",
214         ("real",          P.REAL{fromkind=P.INT 31,       "testu_32_32",
215                                tokind=P.FLOAT 64},       i_f64) :-:       "copy_32_32_ii",
216         ("real32",        P.REAL{fromkind=P.INT 32,       "copy_32_32_wi",
217                                  tokind=P.FLOAT 64},     i32_f64) :-:       "copy_32_32_iw",
218         "copy_32_32_ww",
219         ("ordof",         P.NUMSUBSCRIPT{kind=P.INT 8,       "copy_31_31_ii",
220                                        checked=false,       "copy_31_31_wi",
221                                        immutable=true},  numSubTy) :-:       "copy_31_31_iw",
222         ("store",         P.NUMUPDATE{kind=P.INT 8,       "copy_31_32_i",
223                                     checked=false},      numUpdTy) :-:       "copy_31_32_w",
224         ("inlbyteof",     P.NUMSUBSCRIPT{kind=P.INT 8,       "copy_8_32_i",
225                                        checked=true,       "copy_8_32_w",
226                                        immutable=false}, numSubTy) :-:       "copy_8_31",
227         ("inlstore",      P.NUMUPDATE{kind=P.INT 8,       "extend_31_32_ii",
228                                     checked=true},       numUpdTy) :-:       "extend_31_32_iw",
229         ("inlordof",      P.NUMSUBSCRIPT{kind=P.INT 8,       "extend_31_32_wi",
230                                        checked=true,       "extend_31_32_ww",
231                                        immutable=true},  numSubTy) :-:       "extend_8_31",
232         "extend_8_32_i",
233         (*** polymorphic array and vector ***)       "extend_8_32_w",
234         ("mkarray",       P.INLMKARRAY,          p1(ar(tu[i,v1],ay(v1)))) :-:       "trunc_32_31_i",
235         ("arrSub",        P.SUBSCRIPT,           p1(ar(tu[ay(v1),i],v1))) :-:       "trunc_32_31_w",
236         ("arrChkSub",     P.INLSUBSCRIPT,        p1(ar(tu[ay(v1),i],v1))) :-:       "trunc_31_8",
237         ("vecSub",        P.SUBSCRIPTV,          p1(ar(tu[vct(v1),i],v1))) :-:       "trunc_32_8_i",
238         ("vecChkSub",     P.INLSUBSCRIPTV,       p1(ar(tu[vct(v1),i],v1))) :-:       "trunc_32_8_w",
239         ("arrUpdate",     P.UPDATE,              p1(ar(tu[ay(v1),i,v1],u))) :-:       "test_inf_31",
240         ("arrChkUpdate",  P.INLUPDATE,           p1(ar(tu[ay(v1),i,v1],u))) :-:       "test_inf_32",
241         "test_inf_64",
242         (* new array representations *)       "copy_8_inf",
243          ("newArray0",   P.NEW_ARRAY0,           p1(ar(u,v1))) :-:       "copy_8_inf_w",
244          ("getSeqData",  P.GET_SEQ_DATA,         p2(ar(v1, v2))) :-:       "copy_31_inf_w",
245          ("recordSub",   P.SUBSCRIPT_REC,        p2(ar(tu[v1,i],v2))) :-:       "copy_32_inf_w",
246          ("raw64Sub",    P.SUBSCRIPT_RAW64,      p1(ar(tu[v1,i],f64))) :-:       "copy_64_inf_w",
247         "copy_31_inf_i",
248         (* *** conversion primops ***       "copy_32_inf_i",
249          *   There are certain duplicates for the same primop (but with       "copy_64_inf_i",
250          *   different types).  In such a case, the "canonical" name       "extend_8_inf",
251          *   of the primop has been extended using a simple suffix       "extend_8_inf_w",
252          *   scheme. *)       "extend_31_inf_w",
253         ("test_32_31_w",  P.TEST(32,31),         w32_i) :-:       "extend_32_inf_w",
254         ("test_32_31_i",  P.TEST(32,31),         i32_i) :-:       "extend_64_inf_w",
255         "extend_31_inf_i",
256         ("testu_31_31",   P.TESTU(31,31),      w_i) :-:       "extend_32_inf_i",
257         "extend_64_inf_i",
258         ("testu_32_31",   P.TESTU(32,31),      w32_i) :-:       "trunc_inf_8",
259         "trunc_inf_31",
260         ("testu_32_32",   P.TESTU(32,32),        w32_i32) :-:       "trunc_inf_32",
261         "trunc_inf_64",
262         ("copy_32_32_ii", P.COPY(32,32),         i32_i32) :-:       "w64p",
263         ("copy_32_32_wi", P.COPY(32,32),         w32_i32) :-:       "p64w",
264         ("copy_32_32_iw", P.COPY(32,32),         i32_w32) :-:       "i64p",
265         ("copy_32_32_ww", P.COPY(32,32),         w32_w32) :-:       "p64i",
266         "i31add",
267         ("copy_31_31_ii", P.COPY(31,31),         i_i) :-:       "i31add_8",
268         ("copy_31_31_wi", P.COPY(31,31),         w_i) :-:       "i31sub",
269         ("copy_31_31_iw", P.COPY(31,31),         i_w) :-:       "i31sub_8",
270         "i31mul",
271         ("copy_31_32_i",  P.COPY(31,32),         w_i32) :-:       "i31mul_8",
272         ("copy_31_32_w",  P.COPY(31,32),         w_w32) :-:       "i31div",
273         "i31div_8",
274         ("copy_8_32_i",   P.COPY(8,32),          w8_i32) :-:       "i31mod",
275         ("copy_8_32_w",   P.COPY(8,32),          w8_w32) :-:       "i31mod_8",
276         "i31quot",
277         ("copy_8_31",     P.COPY(8,31),          w8_i) :-:       "i31rem",
278         "i31orb",
279         ("extend_31_32_ii", P.EXTEND(31,32),     i_i32) :-:       "i31orb_8",
280         ("extend_31_32_iw", P.EXTEND(31,32),     i_w32) :-:       "i31andb",
281         ("extend_31_32_wi", P.EXTEND(31,32),     w_i32) :-:       "i31andb_8",
282         ("extend_31_32_ww", P.EXTEND(31,32),     w_w32) :-:       "i31xorb",
283         "i31xorb_8",
284         ("extend_8_31",   P.EXTEND(8,31),        w8_i) :-:       "i31notb",
285         "i31notb_8",
286         ("extend_8_32_i", P.EXTEND(8,32),        w8_i32) :-:       "i31neg",
287         ("extend_8_32_w", P.EXTEND(8,32),        w8_w32) :-:       "i31neg_8",
288         "i31lshift",
289         ("trunc_32_31_i", P.TRUNC(32,31),        i32_w) :-:       "i31lshift_8",
290         ("trunc_32_31_w", P.TRUNC(32,31),        w32_w) :-:       "i31rshift",
291         "i31rshift_8",
292         ("trunc_31_8",    P.TRUNC(31,8),         i_w8) :-:       "i31lt",
293         "i31lt_8",
294         ("trunc_32_8_i",  P.TRUNC(32,8),         i32_w8) :-:       "i31lt_c",
295         ("trunc_32_8_w",  P.TRUNC(32,8),         w32_w8) :-:       "i31le",
296         "i31le_8",
297         (* conversion primops involving intinf *)       "i31le_c",
298         ("test_inf_31",   P.TEST_INF 31,         inf_i)   :-:       "i31gt",
299         ("test_inf_32",   P.TEST_INF 32,         inf_i32) :-:       "i31gt_8",
300         ("test_inf_64",   P.TEST_INF 64,         inf_i64) :-:       "i31gt_c",
301         ("copy_8_inf",    P.COPY_INF 8,          w8_inf)  :-:       "i31ge",
302         ("copy_8_inf_w",  P.COPY_INF 8,          w8_inf)  :-:       "i31ge_8",
303         ("copy_31_inf_w", P.COPY_INF 31,         w_inf)   :-:       "i31ge_c",
304         ("copy_32_inf_w", P.COPY_INF 32,         w32_inf) :-:       "i31ltu",
305         ("copy_64_inf_w", P.COPY_INF 64,         w64_inf) :-:       "i31geu",
306         ("copy_31_inf_i", P.COPY_INF 31,         i_inf)   :-:       "i31eq",
307         ("copy_32_inf_i", P.COPY_INF 32,         i32_inf) :-:       "i31ne",
308         ("copy_64_inf_i", P.COPY_INF 64,         i64_inf) :-:       "i31min",
309         ("extend_8_inf",  P.EXTEND_INF 8,        w8_inf)  :-:       "i31min_8",
310         ("extend_8_inf_w",  P.EXTEND_INF 8,      w8_inf)  :-:       "i31max",
311         ("extend_31_inf_w", P.EXTEND_INF 31,     w_inf) :-:       "i31max_8",
312         ("extend_32_inf_w", P.EXTEND_INF 32,     w32_inf) :-:       "i31abs",
313         ("extend_64_inf_w", P.EXTEND_INF 64,     w64_inf) :-:       "i32mul",
314         ("extend_31_inf_i", P.EXTEND_INF 31,     i_inf) :-:       "i32div",
315         ("extend_32_inf_i", P.EXTEND_INF 32,     i32_inf) :-:       "i32mod",
316         ("extend_64_inf_i", P.EXTEND_INF 64,     i64_inf) :-:       "i32quot",
317         ("trunc_inf_8",   P.TRUNC_INF 8,         inf_w8)  :-:       "i32rem",
318         ("trunc_inf_31",  P.TRUNC_INF 31,        inf_w) :-:       "i32add",
319         ("trunc_inf_32",  P.TRUNC_INF 32,        inf_w32) :-:       "i32sub",
320         ("trunc_inf_64",  P.TRUNC_INF 64,        inf_w64) :-:       "i32orb",
321         "i32andb",
322         (* primops to go between abstract and concrete representation of       "i32xorb",
323          * 64-bit ints and words *)       "i32lshift",
324         ("w64p",          P.CVT64,               w64_pw32) :-:       "i32rshift",
325         ("p64w",          P.CVT64,               pw32_w64) :-:       "i32neg",
326         ("i64p",          P.CVT64,               i64_pw32) :-:       "i32lt",
327         ("p64i",          P.CVT64,               pw32_i64) :-:       "i32le",
328         "i32gt",
329         (* *** integer 31 primops ***       "i32ge",
330          *   Many of the i31 primops are being abused for different types       "i32eq",
331          *   (mostly Word8.word and also for char).  In these cases       "i32ne",
332          *   there are suffixed alternative versions of the primop       "i32min",
333          *   (i.e., same primop, different type). *)       "i32max",
334         ("i31add",        int31 P.+,             ii_i) :-:       "i32abs",
335         ("i31add_8",      int31 P.+,             w8w8_w8) :-:       "f64add",
336         "f64sub",
337         ("i31sub",        int31 P.-,             ii_i) :-:       "f64div",
338         ("i31sub_8",      int31 P.-,             w8w8_w8) :-:       "f64mul",
339         "f64neg",
340         ("i31mul",        int31 P.*,             ii_i) :-:       "f64ge",
341         ("i31mul_8",      int31 P.*,             w8w8_w8) :-:       "f64gt",
342         "f64le",
343         ("i31div",        int31 P.DIV,           ii_i) :-:       "f64lt",
344         ("i31div_8",      int31 P.DIV,           w8w8_w8) :-:       "f64eq",
345         "f64ne",
346         ("i31mod",        int31 P.MOD,           ii_i) :-:       "f64abs",
347         ("i31mod_8",      int31 P.MOD,           w8w8_w8) :-:       "f64sin",
348         "f64cos",
349         ("i31quot",       int31 P./,             ii_i) :-:       "f64tan",
350         "f64sqrt",
351         ("i31rem",        int31 P.REM,           ii_i) :-:       "f64min",
352         "f64max",
353         ("i31orb",        bits31 P.ORB,          ii_i) :-:       "f64Sub",
354         ("i31orb_8",      bits31 P.ORB,          w8w8_w8) :-:       "f64chkSub",
355         "f64Update",
356         ("i31andb",       bits31 P.ANDB,         ii_i) :-:       "f64chkUpdate",
357         ("i31andb_8",     bits31 P.ANDB,         w8w8_w8) :-:       "w8orb",
358         "w8xorb",
359         ("i31xorb",       bits31 P.XORB,         ii_i) :-:       "w8andb",
360         ("i31xorb_8",     bits31 P.XORB,         w8w8_w8) :-:       "w8gt",
361         "w8ge",
362         ("i31notb",       bits31 P.NOTB,         i_i) :-:       "w8lt",
363         ("i31notb_8",     bits31 P.NOTB,         w8_w8) :-:       "w8le",
364         "w8eq",
365         ("i31neg",        int31 P.~,             i_i) :-:       "w8ne",
366         ("i31neg_8",      int31 P.~,             w8_w8) :-:       "w8Sub",
367         "w8chkSub",
368         ("i31lshift",     bits31 P.LSHIFT,       ii_i) :-:       "w8subv",
369         ("i31lshift_8",   bits31 P.LSHIFT,       w8w_w8) :-:       "w8chkSubv",
370         "w8update",
371         ("i31rshift",     bits31 P.RSHIFT,       ii_i) :-:       "w8chkUpdate",
372         ("i31rshift_8",   bits31 P.RSHIFT,       w8w_w8) :-:       "w31mul",
373         "w31div",
374         ("i31lt",         int31cmp P.<,          ii_b) :-:       "w31mod",
375         ("i31lt_8",       int31cmp P.<,          w8w8_b) :-:       "w31add",
376         ("i31lt_c",       int31cmp P.<,          cc_b) :-:       "w31sub",
377         "w31orb",
378         ("i31le",         int31cmp P.<=,         ii_b) :-:       "w31xorb",
379         ("i31le_8",       int31cmp P.<=,         w8w8_b) :-:       "w31andb",
380         ("i31le_c",       int31cmp P.<=,         cc_b) :-:       "w31notb",
381         "w31neg",
382         ("i31gt",         int31cmp P.>,          ii_b) :-:       "w31rshift",
383         ("i31gt_8",       int31cmp P.>,          w8w8_b) :-:       "w31rshiftl",
384         ("i31gt_c",       int31cmp P.>,          cc_b) :-:       "w31lshift",
385         "w31gt",
386         ("i31ge",         int31cmp P.>=,         ii_b) :-:       "w31ge",
387         ("i31ge_8",       int31cmp P.>=,         w8w8_b) :-:       "w31lt",
388         ("i31ge_c",       int31cmp P.>=,         cc_b) :-:       "w31le",
389         "w31eq",
390         ("i31ltu",        word31cmp P.LTU,       ii_b) :-:       "w31ne",
391         ("i31geu",        word31cmp P.GEU,       ii_b) :-:       "w31ChkRshift",
392         ("i31eq",         int31cmp P.EQL,        ii_b) :-:       "w31ChkRshiftl",
393         ("i31ne",         int31cmp P.NEQ,        ii_b) :-:       "w31ChkLshift",
394         "w31min",
395         ("i31min",        P.INLMIN (P.INT 31),   ii_i) :-:       "w31max",
396         ("i31min_8",      P.INLMIN (P.INT 31),   w8w8_w8) :-:       "w31mul_8",
397         ("i31max",        P.INLMAX (P.INT 31),   ii_i) :-:       "w31div_8",
398         ("i31max_8",      P.INLMAX (P.INT 31),   w8w8_w8) :-:       "w31mod_8",
399         "w31add_8",
400         ("i31abs",        P.INLABS (P.INT 31),   i_i) :-:       "w31sub_8",
401         "w31orb_8",
402         (*** integer 32 primops ***)       "w31xorb_8",
403         ("i32mul",        int32 P.*,             i32i32_i32) :-:       "w31andb_8",
404         ("i32div",        int32 P.DIV,           i32i32_i32) :-:       "w31notb_8",
405         ("i32mod",        int32 P.MOD,           i32i32_i32) :-:       "w31neg_8",
406         ("i32quot",       int32 P./,             i32i32_i32) :-:       "w31rshift_8",
407         ("i32rem",        int32 P.REM,           i32i32_i32) :-:       "w31rshiftl_8",
408         ("i32add",        int32 P.+,             i32i32_i32) :-:       "w31lshift_8",
409         ("i32sub",        int32 P.-,             i32i32_i32) :-:       "w31gt_8",
410         ("i32orb",        bits32 P.ORB,          i32i32_i32) :-:       "w31ge_8",
411         ("i32andb",       bits32 P.ANDB,         i32i32_i32) :-:       "w31lt_8",
412         ("i32xorb",       bits32 P.XORB,         i32i32_i32) :-:       "w31le_8",
413         ("i32lshift",     bits32 P.LSHIFT,       i32i32_i32) :-:       "w31eq_8",
414         ("i32rshift",     bits32 P.RSHIFT,       i32i32_i32) :-:       "w31ne_8",
415         ("i32neg",        int32 P.~,             i32_i32) :-:       "w31ChkRshift_8",
416         ("i32lt",         int32cmp P.<,          i32i32_b) :-:       "w31ChkRshiftl_8",
417         ("i32le",         int32cmp P.<=,         i32i32_b) :-:       "w31ChkLshift_8",
418         ("i32gt",         int32cmp P.>,          i32i32_b) :-:       "w31min_8",
419         ("i32ge",         int32cmp P.>=,         i32i32_b) :-:       "w31max_8",
420         ("i32eq",         int32cmp P.EQL,        i32i32_b) :-:       "w32mul",
421         ("i32ne",         int32cmp P.NEQ,        i32i32_b) :-:       "w32div",
422         "w32mod",
423         ("i32min",        P.INLMIN (P.INT 32),   i32i32_i32) :-:       "w32add",
424         ("i32max",        P.INLMAX (P.INT 32),   i32i32_i32) :-:       "w32sub",
425         ("i32abs",        P.INLABS (P.INT 32),   i32_i32) :-:       "w32orb",
426         "w32xorb",
427         (*** float 64 primops ***)       "w32andb",
428         ("f64add",        purefloat64 (P.+),      f64f64_f64) :-:       "w32notb",
429         ("f64sub",        purefloat64 (P.-),      f64f64_f64) :-:       "w32neg",
430         ("f64div",        purefloat64 (P./),      f64f64_f64) :-:       "w32rshift",
431         ("f64mul",        purefloat64 (P.* ),     f64f64_f64) :-:       "w32rshiftl",
432         ("f64neg",        purefloat64 P.~,        f64_f64) :-:       "w32lshift",
433         ("f64ge",         float64cmp (P.>=),      f64f64_b) :-:       "w32gt",
434         ("f64gt",         float64cmp (P.>),       f64f64_b) :-:       "w32ge",
435         ("f64le",         float64cmp (P.<=),      f64f64_b) :-:       "w32lt",
436         ("f64lt",         float64cmp (P.<),       f64f64_b) :-:       "w32le",
437         ("f64eq",         float64cmp P.EQL,       f64f64_b) :-:       "w32eq",
438         ("f64ne",         float64cmp P.NEQ,       f64f64_b) :-:       "w32ne",
439         ("f64abs",        purefloat64 P.ABS,      f64_f64) :-:       "w32ChkRshift",
440         "w32ChkRshiftl",
441         ("f64sin",        purefloat64 P.FSIN,     f64_f64) :-:       "w32ChkLshift",
442         ("f64cos",        purefloat64 P.FCOS,     f64_f64) :-:       "w32min",
443         ("f64tan",        purefloat64 P.FTAN,     f64_f64) :-:       "w32max",
444         ("f64sqrt",       purefloat64 P.FSQRT,    f64_f64) :-:       "raww8l",
445         "rawi8l",
446         ("f64min",        P.INLMIN (P.FLOAT 64),  f64f64_f64) :-:       "raww16l",
447         ("f64max",        P.INLMAX (P.FLOAT 64),  f64f64_f64) :-:       "rawi16l",
448         "raww32l",
449         (*** float64 array ***)       "rawi32l",
450         ("f64Sub",        sub (P.FLOAT 64),       numSubTy) :-:       "rawf32l",
451         ("f64chkSub",     chkSub (P.FLOAT 64),    numSubTy) :-:       "rawf64l",
452         ("f64Update",     update (P.FLOAT 64),    numUpdTy) :-:       "raww8s",
453         ("f64chkUpdate",  chkUpdate (P.FLOAT 64), numUpdTy) :-:       "rawi8s",
454         "raww16s",
455         (*** word8 primops ***)       "rawi16s",
456         (*       "raww32s",
457          * In the long run, we plan to represent WRAPPED word8 tagged, and       "rawi32s",
458          * UNWRAPPED untagged. But right now, we represent both of them       "rawf32s",
459          * tagged, with 23 high-order zero bits and 1 low-order 1 bit.       "rawf64s",
460          * In this representation, we can use the comparison and (some of       "rawccall",
461          * the) bitwise operators of word31; but we cannot use the shift       "rawrecord",
462          * and arithmetic operators.       "rawrecord64",
463          *       "rawselectw8",
464          * WARNING: THIS IS A TEMPORARY HACKJOB until all the word8 primops       "rawselecti8",
465          * are correctly implemented.       "rawselectw16",
466          *       "rawselecti16",
467          * ("w8mul",     word8 (P.* ),           w8w8_w8) :-:       "rawselectw32",
468          * ("w8div",     word8 (P./),            w8w8_w8) :-:       "rawselecti32",
469          * ("w8add",     word8 (P.+),            w8w8_w8) :-:       "rawselectf32",
470          * ("w8sub",     word8 (P.-),            w8w8_w8) :-:       "rawselectf64",
471          *       "rawupdatew8",
472          * ("w8notb",    word31 P.NOTB,          w8_w8) :-:       "rawupdatei8",
473          * ("w8rshift",  word8 P.RSHIFT,         w8w_w8) :-:       "rawupdatew16",
474          * ("w8rshiftl", word8 P.RSHIFTL,        w8w_w8) :-:       "rawupdatei16",
475          * ("w8lshift",  word8 P.LSHIFT,         w8w_w8) :-:       "rawupdatew32",
476          *       "rawupdatei32",
477          * ("w8toint",   P.ROUND{floor=true,       "rawupdatef32",
478          *                     fromkind=P.UINT 8,       "rawupdatef64"]
         *                     tokind=P.INT 31},   w8_i) :-:  
         * ("w8fromint", P.REAL{fromkind=P.INT 31,  
         *                    tokind=P.UINT 8},    i_w8) :-:  
         *)  
   
        ("w8orb",        word31 P.ORB,           w8w8_w8) :-:  
        ("w8xorb",       word31 P.XORB,          w8w8_w8) :-:  
        ("w8andb",       word31 P.ANDB,          w8w8_w8) :-:  
   
        ("w8gt",         word8cmp P.>,           w8w8_b) :-:  
        ("w8ge",         word8cmp P.>=,          w8w8_b) :-:  
        ("w8lt",         word8cmp P.<,           w8w8_b) :-:  
        ("w8le",         word8cmp P.<=,          w8w8_b) :-:  
        ("w8eq",         word8cmp P.EQL,         w8w8_b) :-:  
        ("w8ne",         word8cmp P.NEQ,         w8w8_b) :-:  
   
        (*** word8 array and vector ***)  
        ("w8Sub",        sub (P.UINT 8),         numSubTy) :-:  
        ("w8chkSub",     chkSub (P.UINT 8),      numSubTy) :-:  
        ("w8subv",       subv (P.UINT 8),        numSubTy) :-:  
        ("w8chkSubv",    chkSubv (P.UINT 8),     numSubTy) :-:  
        ("w8update",     update (P.UINT 8),      numUpdTy) :-:  
        ("w8chkUpdate",  chkUpdate (P.UINT 8),   numUpdTy) :-:  
   
        (* word31 primops *)  
        ("w31mul",       word31 (P.* ),          ww_w) :-:  
        ("w31div",       word31 (P./),           ww_w) :-:  
        ("w31mod",       word31 (P.REM),         ww_w) :-:  
        ("w31add",       word31 (P.+),           ww_w) :-:  
        ("w31sub",       word31 (P.-),           ww_w) :-:  
        ("w31orb",       word31 P.ORB,           ww_w) :-:  
        ("w31xorb",      word31 P.XORB,          ww_w) :-:  
        ("w31andb",      word31 P.ANDB,          ww_w) :-:  
        ("w31notb",      word31 P.NOTB,          w_w) :-:  
        ("w31neg",       word31 P.~,             w_w) :-:  
        ("w31rshift",    word31 P.RSHIFT,        ww_w) :-:  
        ("w31rshiftl",   word31 P.RSHIFTL,       ww_w) :-:  
        ("w31lshift",    word31 P.LSHIFT,        ww_w) :-:  
        ("w31gt",        word31cmp (P.>),        ww_b) :-:  
        ("w31ge",        word31cmp (P.>=),       ww_b) :-:  
        ("w31lt",        word31cmp (P.<),        ww_b) :-:  
        ("w31le",        word31cmp (P.<=),       ww_b) :-:  
        ("w31eq",        word31cmp P.EQL,        ww_b) :-:  
        ("w31ne",        word31cmp P.NEQ,        ww_b) :-:  
        ("w31ChkRshift", P.INLRSHIFT(P.UINT 31), ww_w) :-:  
        ("w31ChkRshiftl",P.INLRSHIFTL(P.UINT 31),ww_w) :-:  
        ("w31ChkLshift", P.INLLSHIFT(P.UINT 31), ww_w) :-:  
   
        ("w31min",       P.INLMIN (P.UINT 31),   ww_w) :-:  
        ("w31max",       P.INLMAX (P.UINT 31),   ww_w) :-:  
   
        (* (pseudo-)word8 primops *)  
        ("w31mul_8",     word31 (P.* ),          w8w8_w8) :-:  
        ("w31div_8",     word31 (P./),           w8w8_w8) :-:  
        ("w31mod_8",     word31 (P.REM),         w8w8_w8) :-:  
        ("w31add_8",     word31 (P.+),           w8w8_w8) :-:  
        ("w31sub_8",     word31 (P.-),           w8w8_w8) :-:  
        ("w31orb_8",     word31 P.ORB,           w8w8_w8) :-:  
        ("w31xorb_8",    word31 P.XORB,          w8w8_w8) :-:  
        ("w31andb_8",    word31 P.ANDB,          w8w8_w8) :-:  
        ("w31notb_8",    word31 P.NOTB,          w8_w8) :-:  
        ("w31neg_8",     word31 P.~,             w8_w8) :-:  
        ("w31rshift_8",  word31 P.RSHIFT,        w8w_w8) :-:  
        ("w31rshiftl_8", word31 P.RSHIFTL,       w8w_w8) :-:  
        ("w31lshift_8",  word31 P.LSHIFT,        w8w_w8) :-:  
        ("w31gt_8",      word31cmp (P.>),        w8w8_b) :-:  
        ("w31ge_8",      word31cmp (P.>=),       w8w8_b) :-:  
        ("w31lt_8",      word31cmp (P.<),        w8w8_b) :-:  
        ("w31le_8",      word31cmp (P.<=),       w8w8_b) :-:  
        ("w31eq_8",      word31cmp P.EQL,        w8w8_b) :-:  
        ("w31ne_8",      word31cmp P.NEQ,        w8w8_b) :-:  
        ("w31ChkRshift_8", P.INLRSHIFT(P.UINT 31), w8w_w8) :-:  
        ("w31ChkRshiftl_8",P.INLRSHIFTL(P.UINT 31),w8w_w8) :-:  
        ("w31ChkLshift_8", P.INLLSHIFT(P.UINT 31), w8w_w8) :-:  
   
        ("w31min_8",     P.INLMIN (P.UINT 31),   w8w8_w8) :-:  
        ("w31max_8",     P.INLMAX (P.UINT 31),   w8w8_w8) :-:  
   
        (*** word32 primops ***)  
        ("w32mul",       word32 (P.* ),          w32w32_w32) :-:  
        ("w32div",       word32 (P./),           w32w32_w32) :-:  
        ("w32mod",       word32 (P.REM),         w32w32_w32) :-:  
        ("w32add",       word32 (P.+),           w32w32_w32) :-:  
        ("w32sub",       word32 (P.-),           w32w32_w32) :-:  
        ("w32orb",       word32 P.ORB,           w32w32_w32) :-:  
        ("w32xorb",      word32 P.XORB,          w32w32_w32) :-:  
        ("w32andb",      word32 P.ANDB,          w32w32_w32) :-:  
        ("w32notb",      word32 P.NOTB,          w32_w32) :-:  
        ("w32neg",       word32 P.~,             w32_w32) :-:  
        ("w32rshift",    word32 P.RSHIFT,        w32w_w32) :-:  
        ("w32rshiftl",   word32 P.RSHIFTL,       w32w_w32) :-:  
        ("w32lshift",    word32 P.LSHIFT,        w32w_w32) :-:  
        ("w32gt",        word32cmp (P.>),        w32w32_b) :-:  
        ("w32ge",        word32cmp (P.>=),       w32w32_b) :-:  
        ("w32lt",        word32cmp (P.<),        w32w32_b) :-:  
        ("w32le",        word32cmp (P.<=),       w32w32_b) :-:  
        ("w32eq",        word32cmp P.EQL,        w32w32_b) :-:  
        ("w32ne",        word32cmp P.NEQ,        w32w32_b) :-:  
        ("w32ChkRshift", P.INLRSHIFT(P.UINT 32), w32w_w32) :-:  
        ("w32ChkRshiftl",P.INLRSHIFTL(P.UINT 32),w32w_w32) :-:  
        ("w32ChkLshift", P.INLLSHIFT(P.UINT 32), w32w_w32) :-:  
   
        ("w32min",        P.INLMIN (P.UINT 32),  w32w32_w32) :-:  
        ("w32max",        P.INLMAX (P.UINT 32),  w32w32_w32) :-:  
   
        (* experimental C FFI primops *)  
        ("raww8l",       P.RAW_LOAD (P.UINT 8),    w32_w32) :-:  
        ("rawi8l",       P.RAW_LOAD (P.INT 8),     w32_i32) :-:  
        ("raww16l",      P.RAW_LOAD (P.UINT 16),   w32_w32) :-:  
        ("rawi16l",      P.RAW_LOAD (P.INT 16),    w32_i32) :-:  
        ("raww32l",      P.RAW_LOAD (P.UINT 32),   w32_w32) :-:  
        ("rawi32l",      P.RAW_LOAD (P.INT 32),    w32_i32) :-:  
        ("rawf32l",      P.RAW_LOAD (P.FLOAT 32),  w32_f64) :-:  
        ("rawf64l",      P.RAW_LOAD (P.FLOAT 64),  w32_f64) :-:  
        ("raww8s",       P.RAW_STORE (P.UINT 8),   w32w32_u) :-:  
        ("rawi8s",       P.RAW_STORE (P.INT 8),    w32i32_u) :-:  
        ("raww16s",      P.RAW_STORE (P.UINT 16),  w32w32_u) :-:  
        ("rawi16s",      P.RAW_STORE (P.INT 16),   w32i32_u) :-:  
        ("raww32s",      P.RAW_STORE (P.UINT 32),  w32w32_u) :-:  
        ("rawi32s",      P.RAW_STORE (P.INT 32),   w32i32_u) :-:  
        ("rawf32s",      P.RAW_STORE (P.FLOAT 32), w32f64_u) :-:  
        ("rawf64s",      P.RAW_STORE (P.FLOAT 64), w32f64_u) :-:  
        ("rawccall",     P.RAW_CCALL NONE,         rccType) :-:  
   
           (* Support for direct construction of C objects on ML heap.  
            * rawrecord builds a record holding C objects on the heap.  
            * rawselectxxx index on this record.  They are of type:  
            *    'a * Word32.word -> Word32.word  
            * The 'a is to guarantee that the compiler will treat  
            * the record as a ML object, in case it passes thru a gc boundary.  
            * rawupdatexxx writes to the record.  
            *)  
        ("rawrecord",    P.RAW_RECORD { fblock = false }, i_x) :-:  
        ("rawrecord64",  P.RAW_RECORD { fblock = true }, i_x) :-:  
   
        ("rawselectw8",  P.RAW_LOAD (P.UINT 8), xw32_w32) :-:  
        ("rawselecti8",  P.RAW_LOAD (P.INT 8), xw32_i32) :-:  
        ("rawselectw16", P.RAW_LOAD (P.UINT 16), xw32_w32) :-:  
        ("rawselecti16", P.RAW_LOAD (P.INT 16), xw32_i32) :-:  
        ("rawselectw32", P.RAW_LOAD (P.UINT 32), xw32_w32) :-:  
        ("rawselecti32", P.RAW_LOAD (P.INT 32), xw32_i32) :-:  
        ("rawselectf32", P.RAW_LOAD (P.FLOAT 32), xw32_f64) :-:  
        ("rawselectf64", P.RAW_LOAD (P.FLOAT 64), xw32_f64) :-:  
   
        ("rawupdatew8",  P.RAW_STORE (P.UINT 8), xw32w32_u) :-:  
        ("rawupdatei8",  P.RAW_STORE (P.INT 8), xw32i32_u) :-:  
        ("rawupdatew16", P.RAW_STORE (P.UINT 16), xw32w32_u) :-:  
        ("rawupdatei16", P.RAW_STORE (P.INT 16), xw32i32_u) :-:  
        ("rawupdatew32", P.RAW_STORE (P.UINT 32), xw32w32_u) :-:  
        ("rawupdatei32", P.RAW_STORE (P.INT 32), xw32i32_u) :-:  
        ("rawupdatef32", P.RAW_STORE (P.FLOAT 32), xw32f64_u) :-:  
        ("rawupdatef64", P.RAW_STORE (P.FLOAT 64), xw32f64_u)  
479    
480  end (* local *)  end (* local *)
481    
# Line 852  Line 513 
513    let val bottom = T.POLYty{sign=[false],    let val bottom = T.POLYty{sign=[false],
514                              tyfun=T.TYFUN{arity=1,body=T.IBOUND 0}}                              tyfun=T.TYFUN{arity=1,body=T.IBOUND 0}}
515    
516        fun mkVarElement((name, p, t),(symbols,elements,dacc,offset)) =        fun mkVarElement(name,(symbols,elements,primElems,offset)) =
517          let val s = S.varSymbol name          let val s = S.varSymbol name
518              val sp = M.VALspec{spec=t, slot=offset}              val sp = M.VALspec{spec=bottom, slot=offset}
519              val d = II.mkPrimInfo(p, t)                      (* using universal generic type bottom for all components *)
520           in (s::symbols, (s,sp)::elements, d::dacc, offset+1)              val p = PrimOpId.PrimE(PrimOpId.Prim offset) (* the primop code *)
521             in (s::symbols, (s,sp)::elements, p::primElems, offset+1)
522          end          end
523    
524        val (allSymbols, allElements, infList, _) =        val (allSymbols, allElements, primList, _) =
525              foldl mkVarElement ([],[],[],0) allPrimops              foldl mkVarElement ([],[],[],0) allPrimops
526    
527        val (allSymbols, allElements, infList) =        val (allSymbols, allElements, primList) =
528              (rev allSymbols, rev allElements, rev infList)              (rev allSymbols, rev allElements, rev primList)
529    
530        val sigrec ={stamp=ST.special "inLineSig",        val sigrec ={stamp=ST.special "inLineSig",
531                     name=NONE, closed=true,                     name=NONE, closed=true,
532                     fctflag=false,                     fctflag=false,
533                     symbols=allSymbols, elements=allElements,                     symbols=allSymbols, elements=allElements,
534                     typsharing=nil, strsharing=nil,                     typsharing=nil, strsharing=nil,
535                     properties = PropList.newHolder (),                     properties = PropList.newHolder (),  (* dbm: ??? *)
                    (* boundeps=ref (SOME []), *)  
                    (* lambdaty=ref NONE, *)  
536                     stub = NONE}                     stub = NONE}
537    
538        val _ = ModulePropLists.setSigBoundeps (sigrec, SOME [])        val _ = ModulePropLists.setSigBoundeps (sigrec, SOME [])
539    
540     in M.STR{sign = M.SIG sigrec,     in M.STR{sign = M.SIG sigrec,
541              rlzn = {stamp=ST.special "inLineStr",              rlzn = {stamp=ST.special "inLineStr",
542                      stub=NONE,                      stub=NONE,
543                      entities=EE.empty,                      entities=EE.empty,
544                      properties = PropList.newHolder (),                      properties = PropList.newHolder (),  (* dbm: ??? *)
                     (* lambdaty=ref(NONE), *)  
545                      rpath=IP.IPATH[S.strSymbol "inLine"]},                      rpath=IP.IPATH[S.strSymbol "inLine"]},
546              access = A.nullAcc,              access = A.nullAcc,
547              info = II.mkStrInfo infList}              info = primList}
548    end    end
549    
550  (* priming structures: PrimTypes and InLine *)  (* priming structures: PrimTypes and InLine *)

Legend:
Removed from v.1955  
changed lines
  Added in v.1956

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