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     ! 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.