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/compiler/FLINT/clos/closure.sml
ViewVC logotype

Diff of /sml/trunk/compiler/FLINT/clos/closure.sml

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

revision 2162, Thu Nov 2 21:20:47 2006 UTC revision 4153, Tue Sep 29 13:30:46 2015 UTC
# Line 10  Line 10 
10   *                   at most ONE continuation function definition per FIX;  *   *                   at most ONE continuation function definition per FIX;  *
11   *                                                                          *   *                                                                          *
12   *               (3) The outermost function is always a non-recursive       *   *               (3) The outermost function is always a non-recursive       *
13   *                   escaping funciton.                                     *   *                   escaping function.                                     *
14   *                                                                          *   *                                                                          *
15   ****************************************************************************)   ****************************************************************************)
16    
# Line 402  Line 402 
402   * Environment Lookup (whatIs, returning object type)                       *   * Environment Lookup (whatIs, returning object type)                       *
403   ****************************************************************************)   ****************************************************************************)
404    
405  exception Lookup of lvar * env  exception Lookup of string * lvar * env
406  fun whatIs(env as Env(_,_,_,whatMap),v) =  fun whatIs(env as Env(_,_,_,whatMap),v) =
407    IntHashTable.lookup whatMap v handle NotBound => raise Lookup(v,env)    IntHashTable.lookup whatMap v handle NotBound => raise Lookup("whatIs", v,env)
408    
409  (* Add v to the access environment, v must be in whatMap already *)  (* Add v to the access environment, v must be in whatMap already *)
410  fun augvar(v,e as Env(valueL,closureL,dispL,whatMap)) =  fun augvar(v,e as Env(valueL,closureL,dispL,whatMap)) =
# Line 417  Line 417 
417   * Environment Access (whereIs, returning object access path)               *   * Environment Access (whereIs, returning object access path)               *
418   ****************************************************************************)   ****************************************************************************)
419    
420  fun whereIs(env as Env(valueL,closureL,_,whatMap),target) =  fun whereIs (env as Env(valueL,closureL,_,whatMap), target) = let
421    let fun bfs(nil,nil) = raise Lookup(target,env)        fun bfs (nil, nil) = raise Lookup("whereIs",target,env)
422          | bfs(nil,next) = bfs(next,nil)          | bfs(nil,next) = bfs(next,nil)
423          | bfs((h, ox as (_, CR(off, {functions,values,          | bfs ((h, ox as (_, CR(off, {functions,values, closures,stamp,...})))::m, next) = let
424                                       closures,stamp,...})))::m, next) =              fun cls(nil, _, next) = bfs(m,next)
             let fun cls(nil, _, next) = bfs(m,next)  
425                    | cls((u as (v,cr))::t, i, next) =                    | cls((u as (v,cr))::t, i, next) =
426                          if target=v then h(SELp(i, OFFp 0), [])                          if target=v then h(SELp(i, OFFp 0), [])
427                       else let val nh = fn (p,z) => h(SELp(i, p), u::z)                       else let val nh = fn (p,z) => h(SELp(i, p), u::z)
# Line 443  Line 442 
442                       else h(OFFp(~off), [ox])                       else h(OFFp(~off), [ox])
443                  else fns(functions, 0)                  else fns(functions, 0)
444              end              end
445        fun search closures =        fun search closures = let
446          let val s = map (fn x => (fn (p,z) => (#1 x,p,z), x)) closures              val s = map (fn x => (fn (p,z) => (#1 x,p,z), x)) closures
447           in Path (bfs(s,nil))              in
448                  Path (bfs(s,nil))
449          end          end
450        fun withTgt(v,CR(_,{free,...})) = member free target        fun withTgt(v,CR(_,{free,...})) = member free target
451        fun lookC ((v,cr)::tl) =        fun lookC ((v,cr)::tl) =
# Line 469  Line 469 
469    end    end
470    
471    
472    
473  (****************************************************************************  (****************************************************************************
474   * Environment Filtering (get the set of current reusable closures)         *   * Environment Filtering (get the set of current reusable closures)         *
475   ****************************************************************************)   ****************************************************************************)
# Line 1925  Line 1926 
1926    
1927  fun closefix(fk,f,vl,cl,ce,env,sn,csg,csf,ret) =  fun closefix(fk,f,vl,cl,ce,env,sn,csg,csf,ret) =
1928    ((fk,f,vl,cl,close(ce,env,sn,csg,csf,ret))    ((fk,f,vl,cl,close(ce,env,sn,csg,csf,ret))
1929         handle Lookup(v,env) => (pr "LOOKUP FAILS on "; vp v;         handle Lookup(f,v,env) => (pr(concat["LOOKUP FAILS on ", f, " "]); vp v;
1930                                       pr "\nin environment:\n";                                       pr "\nin environment:\n";
1931                                  printEnv env;                                  printEnv env;
1932                                  pr "\nin function:\n";                                  pr "\nin function:\n";

Legend:
Removed from v.2162  
changed lines
  Added in v.4153

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