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

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.