Return to globalfix.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / cps

Annotation of researchv10no/cmd/sml/src/cps/globalfix.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: signature GLOBALFIX =
                      3:   sig structure CPS : CPS
                      4:       val globalfix : (CPS.function * (CPS.lvar->bool))->(CPS.function * bool) list
                      5:   end
                      6: 
                      7: structure GlobalFix : GLOBALFIX =
                      8: struct
                      9: structure CPS = CPS
                     10: open CPS
                     11: fun globalfix((f,vl,cexp),known) =
                     12: let
                     13: fun gfix ce =
                     14:   case ce of
                     15:     FIX(fl,c) =>
                     16:     let val (n,c') = gfix c
                     17:        val l' =
                     18:        revfold (fn((v,a,c),m) => let val (l,d) = gfix c in (v,a,d)::l@m end) fl n
                     19:     in (l',c')
                     20:     end
                     21:   | APP _ => ([],ce)
                     22:   | SWITCH(v,l) =>
                     23:     let val (f,l') =
                     24:        fold (fn(c,(fl,cl)) => let val (f,d) = gfix c in (f@fl,d::cl) end) l ([],[])
                     25:     in  (f,SWITCH(v,l'))
                     26:     end
                     27:   | RECORD(l,v,c) => let val (f,c') = gfix c in (f,RECORD(l,v,c')) end
                     28:   | SELECT(i,v,w,c) => let val (f,c') = gfix c in (f,SELECT(i,v,w,c')) end
                     29:   | OFFSET(i,v,w,c) => let val (f,c') = gfix c in (f,OFFSET(i,v,w,c')) end
                     30:   | PRIMOP(i,args,ret,l) =>
                     31:     let val (f,m) =
                     32:        fold (fn(c,(fl,cl)) => let val (f,c) = gfix c in (f@fl,c::cl) end) l ([],[])
                     33:     in (f,PRIMOP(i,args,ret,m))
                     34:     end
                     35: val (l,body) = gfix cexp (* THROW AWAY bogus body. *)
                     36: in  ((f,vl,body),false) :: map (fn x as (lb,_,_) => (x,known lb)) l
                     37: end
                     38: end (* structure GlobalFix *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.