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/Elaborator/elaborate/elabutil.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Elaborator/elaborate/elabutil.sml

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

revision 1331, Sat May 17 17:14:15 2003 UTC revision 1332, Sun May 18 03:21:16 2003 UTC
# Line 254  Line 254 
254    
255  val trivialCompleteMatch = completeMatch(SE.empty,"Match")  val trivialCompleteMatch = completeMatch(SE.empty,"Match")
256    
   
 (* Transform a while loop in a call to a recursive function *)  
 val whileSym = S.varSymbol "while"  
   
 fun IFexp (a,b,c) =  
     CASEexp(a, trivialCompleteMatch [RULE(TRUEpat,b), RULE(FALSEpat,c)],true)  
   
257  val TUPLEpat = AbsynUtil.TUPLEpat  val TUPLEpat = AbsynUtil.TUPLEpat
258  (*  (*
259  fun TUPLEpat l =  fun TUPLEpat l =
# Line 271  Line 264 
264  *)  *)
265    
266  fun wrapRECdecGen (rvbs, compInfo as {mkLvar=mkv, ...} : compInfo) =  fun wrapRECdecGen (rvbs, compInfo as {mkLvar=mkv, ...} : compInfo) =
267    let fun g (RVB{var=v as VALvar{path=SP.SPATH [sym], ...}, ...},    let fun g (RVB{var=v as VALvar{path=SP.SPATH [sym], ...}, ...}, nvars) =
              nvars) =  
268            let val nv = newVALvar(sym, mkv)            let val nv = newVALvar(sym, mkv)
269            in ((v, nv, sym)::nvars)            in ((v, nv, sym)::nvars)
270            end            end
# Line 363  Line 355 
355       in wrapRECdec (map fb2rvb fbl, compInfo)       in wrapRECdec (map fb2rvb fbl, compInfo)
356      end      end
357    
 fun WHILEexp (a, b, compInfo as {mkLvar=mkv, ...} : compInfo) =  
     let val fvar = newVALvar(whileSym, mkv)  
         val id = fn x => x  
         val (markdec,markall,markend,markbody) =  
             case (a,b)  
               of (MARKexp(_,(a1,a2)), MARKexp(_,(b1,b2))) =>  
                     (fn e => MARKdec(e,(a1,b2)), fn e => MARKexp(e,(a1,b2)),  
                      fn e => MARKexp(e,(b2,b2)), fn e => MARKexp(e,(b1,b2)))  
                | _ => (id,id,id,id)  
         val body =  
             markbody(SEQexp[b, APPexp(markend(VARexp(ref fvar,[])),  
                                       markend unitExp)])  
         val loop = markall(IFexp(a,body, markend unitExp))  
         val fnloop = markall(FNexp(trivialCompleteMatch  
                                      [RULE(unitPat,loop)],UNDEFty))  
   
         val (nvar, ndec) =  
           wrapRECdec0([RVB{var=fvar, exp=fnloop, resultty = NONE,  
                            boundtvs=[], tyvars = ref []}], compInfo)  
      in markall  
          (LETexp(markdec ndec,  
             APPexp(markall(VARexp (ref nvar, [])), markend unitExp)))  
     end  
   
358  fun makeHANDLEexp(exp, rules, compInfo as {mkLvar=mkv, ...}: compInfo) =  fun makeHANDLEexp(exp, rules, compInfo as {mkLvar=mkv, ...}: compInfo) =
359      let val v = newVALvar(exnID, mkv)      let val v = newVALvar(exnID, mkv)
360          val r = RULE(VARpat v, RAISEexp(VARexp(ref(v),[]),UNDEFty))          val r = RULE(VARpat v, RAISEexp(VARexp(ref(v),[]),UNDEFty))
# Line 506  Line 474 
474              (case e              (case e
475                of VARexp (ref(V.VALvar{access=A.LVAR x, ...}), _) =>                of VARexp (ref(V.VALvar{access=A.LVAR x, ...}), _) =>
476                     if v=x then raise IsRec else ()                     if v=x then raise IsRec else ()
477                   | VARexp _ => ()
478                 | RECORDexp l => app (fn (lab, x)=>findexp x) l                 | RECORDexp l => app (fn (lab, x)=>findexp x) l
479                 | SEQexp l => app findexp l                 | SEQexp l => app findexp l
480                 | APPexp (a,b) => (findexp a; findexp b)                 | APPexp (a,b) => (findexp a; findexp b)
# Line 515  Line 484 
484                 | LETexp (d, x) => (finddec d; findexp x)                 | LETexp (d, x) => (finddec d; findexp x)
485                 | CASEexp (x, l, _) =>                 | CASEexp (x, l, _) =>
486                     (findexp x; app (fn RULE (_, x) => findexp x) l)                     (findexp x; app (fn RULE (_, x) => findexp x) l)
487                   | IFexp { test, thenCase, elseCase } =>
488                       (findexp test; findexp thenCase; findexp elseCase)
489                   | (ANDALSOexp (e1, e2) | ORELSEexp (e1, e2) |
490                      WHILEexp { test = e1, expr = e2 }) =>
491                       (findexp e1; findexp e2)
492                 | FNexp (l, _) =>  app (fn RULE (_, x) => findexp x) l                 | FNexp (l, _) =>  app (fn RULE (_, x) => findexp x) l
493                 | MARKexp (x, _) => findexp x                 | MARKexp (x, _) => findexp x
494                 | _ => ())                 | SELECTexp (_, e) => findexp e
495                   | VECTORexp (el, _) => app findexp el
496                   | PACKexp (e, _, _) => findexp e
497                   | (CONexp _ | INTexp _ | WORDexp _ | REALexp _ | STRINGexp _ |
498                      CHARexp _) => ())
499    
500            and finddec d =            and finddec d =
501              (case d              (case d

Legend:
Removed from v.1331  
changed lines
  Added in v.1332

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