Return to freemap.sml CVS log

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

Annotation of researchv10no/cmd/sml/src/cps/freemap.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: signature FREEMAP =
        !             3:   sig
        !             4:     val freemap : (CPS.lvar -> bool)
        !             5:                    -> (CPS.lvar * CPS.lvar list -> unit)
        !             6:                        -> (CPS.cexp -> CPS.lvar list)
        !             7:     val freemapClose : CPS.cexp * (CPS.lvar -> bool)
        !             8:                        -> (CPS.lvar -> CPS.lvar list)
        !             9:   end
        !            10: 
        !            11: structure FreeMap : FREEMAP =
        !            12: struct
        !            13: open CPS SortedList
        !            14: 
        !            15: fun sublist test =
        !            16:   let fun subl(a::r) = if test a then a::(subl r) else subl r
        !            17:         | subl nil = nil
        !            18:   in  subl
        !            19:   end
        !            20: 
        !            21: fun freemap constant add =
        !            22: let val clean = (sublist (not o constant)) o uniq
        !            23:     val enter = fn (x,y) => if constant x then y else enter(x,y)
        !            24:     fun setvars (w,free) = let val g = rem(w,free)
        !            25:                           in add(w,g); g
        !            26:                           end
        !            27:     val rec freevars =
        !            28:         fn APP(v,args) => enter(v,clean args)
        !            29:          | SWITCH(v,l) => enter(v,foldmerge (map freevars l))
        !            30:          | RECORD(l,w,ce) => merge(clean (map #1 l), setvars(w, freevars ce))
        !            31:          | SELECT(_,v,w,ce) => enter(v, setvars(w, freevars ce))
        !            32:          | OFFSET(_,v,w,ce) => enter(v, setvars(w, freevars ce))
        !            33:          | PRIMOP(_,args,ret,ce) =>
        !            34:             let fun f(nil,a) = a
        !            35:                   | f(w::wl,a) = f(wl,setvars(w,a))
        !            36:             in  merge(clean args,f(ret,foldmerge(map freevars ce)))
        !            37:             end
        !            38:          | FIX _ => ErrorMsg.impossible "FIX in Freemap.freemap"
        !            39: in freevars
        !            40: end
        !            41: 
        !            42: (* Produces a free variable mapping at each function binding.
        !            43:    The mapping includes the functions bound at the FIX, but
        !            44:    not the arguments of the function.
        !            45:    It assumes that the only lvars which refer to constants
        !            46:    are the arguments of PRIMOPs, contents of RECORDs, and
        !            47:    arguments of APPs.  In particular, the optimizer had better
        !            48:    get rid of SWITCHes on constants. *)
        !            49: fun freemapClose(ce,constant) =
        !            50: let exception Freemap
        !            51:     val vars : lvar list Intmap.intmap = Intmap.new(32, Freemap)
        !            52:     val notconst = sublist (not o constant)
        !            53:     fun setvars(v,l) = (Intmap.add vars (v,l); l)
        !            54:     val rec freevars =
        !            55:         fn FIX(l,ce) =>
        !            56:                let val functions = uniq(map #1 l)
        !            57:                    val freel = map (fn(v,args,body) =>
        !            58:                                       setvars(v,remove(uniq args,freevars body)))
        !            59:                                    l
        !            60:                in  remove(functions,foldmerge((freevars ce)::freel))
        !            61:                end
        !            62:          | APP(v,args) => enter(v,notconst(uniq args))
        !            63:          | SWITCH(v,l) => foldmerge ([v]::(map freevars l))
        !            64:          | RECORD(l,w,ce) => merge(notconst(uniq(map #1 l)),
        !            65:                                    rem(w,freevars ce))
        !            66:          | SELECT(_,v,w,ce) => enter(v,rem(w,freevars ce))
        !            67:          | OFFSET(_,v,w,ce) => enter(v,rem(w,freevars ce))
        !            68:          | PRIMOP(_,args,ret,ce) =>
        !            69:              let val args = notconst(uniq args)
        !            70:              in merge(args,remove(uniq ret,foldmerge(map freevars ce)))
        !            71:              end
        !            72: in  freevars ce; Intmap.map vars
        !            73: end
        !            74: 
        !            75: (* temporary, for debugging *)
        !            76: fun timeit f a =
        !            77:   let val t = System.Timer.start_timer()
        !            78:       val r = f a
        !            79:   in  System.Stats.update(System.Stats.freemap,System.Timer.check_timer t);
        !            80:       r
        !            81:   end
        !            82: val freemap = timeit freemap
        !            83: val freemapClose = timeit freemapClose
        !            84: 
        !            85: end (* structure FreeMap *)
        !            86: 

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