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/FLINT/reps/rttype.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/reps/rttype.sml

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

revision 217, Sun Feb 28 23:41:30 1999 UTC revision 218, Tue Mar 2 08:12:06 1999 UTC
# Line 86  Line 86 
86     in SELECT(u, i, x, RET [VAR x])     in SELECT(u, i, x, RET [VAR x])
87    end    end
88    
89  fun APPg(e1, e2) =  fun APPg (e1,(v2s,h2)) =
90    let val (v1, h1) = split e1    let val (v1, h1) = split e1
91        val (v2, h2) = split e2     in h1(h2(APP(v1, v2s)))
    in h1(h2(APP(v1, [v2])))  
92    end    end
93    
94  fun RECORDg es =  fun RETg es =
95    let fun f ([], vs, hdr) =    let fun f ([], vs, hdr) = (rev vs, hdr)
                let val x = mkv()  
                 in hdr(RECORD(FU_rk_tuple, rev vs, x, RET[VAR x]))  
                end  
         | f (e::r, vs, hdr) =  
               let val (v, h) = split e  
                in f(r, v::vs, hdr o h)  
               end  
    in f(es, [], ident)  
   end  
   
 fun SRECORDg es =  
   let fun f ([], vs, hdr) =  
                let val x = mkv()  
                 in hdr(RECORD(RK_STRUCT, rev vs, x, RET[VAR x]))  
                end  
96          | f (e::r, vs, hdr) =          | f (e::r, vs, hdr) =
97                let val (v, h) = split e                let val (v, h) = split e
98                 in f(r, v::vs, hdr o h)                 in f(r, v::vs, hdr o h)
# Line 227  Line 211 
211  (* val tkAbsGen : kenv * lvar list * tkind list * lvar * fkind  (* val tkAbsGen : kenv * lvar list * tkind list * lvar * fkind
212                    -> kenv * ((lexp *lexp) -> lexp) *)                    -> kenv * ((lexp *lexp) -> lexp) *)
213  fun tkAbsGen (kenv, vs, ks, f, fk) =  fun tkAbsGen (kenv, vs, ks, f, fk) =
214    let val mkArgTy = case fk of {cconv=CC_FUN _,...} => LT.ltc_tuple    let val args = ListPair.map (fn (tv,k) => (tv, LT.tk_lty k)) (vs,ks)
215                               | {cconv=CC_FCT,...} => LT.ltc_str        fun hdr (e1, e2) = FIX([(fk, f, args, e1)], e2)
       val argt = mkArgTy (map LT.tk_lty ks)  
   
       val w = mkv()  
       fun h([], i, base) = base  
         | h(v::r, i, base) = h(r, i+1, SELECT(VAR w, i, v, base))  
   
       fun hdr (e1, e2) = FIX([(fk, f, [(w, argt)], h(vs,0,e1))], e2)  
216     in (addKE(kenv, vs, ks), hdr)     in (addKE(kenv, vs, ks), hdr)
217    end    end
218    
# Line 269  Line 246 
246                    of (TC_APP _ | TC_PROJ _ | TC_VAR _) =>                    of (TC_APP _ | TC_PROJ _ | TC_VAR _) =>
247                          APPg(loop tx, tcsLexp(kenv, ts))                          APPg(loop tx, tcsLexp(kenv, ts))
248                     | _ => tcode_void)                     | _ => tcode_void)
249             | (TC_SEQ ts) => tcsLexp(kenv, ts)             | (TC_SEQ ts) =>
250                 let val (vs,hdr) = tcsLexp(kenv, ts)
251                     val x = mkv()
252                 in hdr(RECORD(FU_rk_tuple, vs, x, RET[VAR x]))
253                 end
254             | (TC_PROJ(tx, i)) => SELECTg(i, loop tx)             | (TC_PROJ(tx, i)) => SELECTg(i, loop tx)
255             | (TC_PRIM pt) =>             | (TC_PRIM pt) =>
256                  if (pt = PT.ptc_real) then tcode_real                  if (pt = PT.ptc_real) then tcode_real
# Line 324  Line 305 
305    
306  and tcsLexp (kenv, ts) =  and tcsLexp (kenv, ts) =
307    let fun h tc = rtLexp kenv tc    let fun h tc = rtLexp kenv tc
308     in RECORDg(map h ts)     in RETg(map h ts)
309    end (* function tcsLexp *)    end (* function tcsLexp *)
310    
311  and tsLexp (kenv, ts) =  and tsLexp (kenv, ts) =
312    let fun h tc = rtLexp kenv tc    let fun h tc = rtLexp kenv tc
313     in SRECORDg(map h ts)     in RETg(map h ts)
314    end (* function tsLexp *)    end (* function tsLexp *)
315    
316  and isFloat (kenv, tc) =  and isFloat (kenv, tc) =

Legend:
Removed from v.217  
changed lines
  Added in v.218

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