Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/compiler/FLINT/clos/unrebind.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/FLINT/clos/unrebind.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2162 - (view) (download)

1 : monnier 245 (* Copyright 1996 by Bell Laboratories *)
2 :     (* unrebind.sml *)
3 :    
4 :     (****************************************************************************
5 :     * *
6 :     * "Alpha conversion": the closure converter introduces duplicate bindings *
7 :     * at function arguments (the free variables of known functions) and at *
8 :     * SELECT's and OFFSET's from closures. This function restores unique *
9 :     * bindings, and also eliminates OFFSET's of 0 (which are introduced as *
10 :     * a side effect of trying to improve lazy display). It assumes that a *
11 :     * FIX has no free variables. *
12 :     * *
13 :     ****************************************************************************)
14 :    
15 :     signature UNREBIND =
16 :     sig
17 :     val unrebind : CPS.function -> CPS.function
18 :     end
19 :    
20 :     structure UnRebind : UNREBIND = struct
21 :    
22 :     local
23 :     open CPS
24 :     in
25 :    
26 :     fun bug s = ErrorMsg.impossible ("UnRebind: " ^ s)
27 :    
28 :     fun unrebind (fk,v,args,cl,ce) =
29 :     let fun rename rebind(VAR v) =
30 :     let fun f nil = VAR v
31 :     | f ((w:int,v')::t) = if v=w then v' else f t
32 :     in f rebind
33 :     end
34 :     | rename _ x = x
35 :    
36 :     fun f (kind,l,args,cl,b) =
37 :     let val (args',rebind') =
38 :     foldr (fn (v,(args',rebind')) =>
39 :     let val v' = LambdaVar.dupLvar v
40 :     in (v'::args',(v, VAR v')::rebind')
41 :     end)
42 :     (nil,nil) args
43 :     in (kind,l,args',cl,g rebind' b)
44 :     end
45 :    
46 :     and g (rebind: (lvar * value) list) =
47 :     let val rename = rename rebind
48 :     val rec h =
49 :     fn RECORD(kind,vl,w,e) =>
50 :     let val w' = LambdaVar.dupLvar w
51 :     in RECORD(kind, map (fn(v,p) => (rename v,p)) vl,
52 :     w', g ((w, VAR w')::rebind) e)
53 :     end
54 :     | OFFSET(0,v,w,e) => g ((w,rename v)::rebind) e
55 :     | OFFSET(i,v,w,e) => bug "unexpected none-zero OFFSET"
56 :     (*
57 :     let val w' = LambdaVar.dupLvar w
58 :     in OFFSET(i, rename v, w', g ((w, VAR w')::rebind) e)
59 :     end
60 :     *)
61 :     | SELECT(i,v,w,t,e) =>
62 :     let val w' = LambdaVar.dupLvar w
63 :     in SELECT(i, rename v, w', t, g((w, VAR w')::rebind) e)
64 :     end
65 :     | APP(f,vl) => APP(rename f,map rename vl)
66 :     | FIX(l,e) => FIX(map f l,h e)
67 :     | SWITCH(v,c,el) => SWITCH(rename v,c,map h el)
68 :     | BRANCH(i,vl,c,e1,e2) => BRANCH(i,map rename vl,c, h e1, h e2)
69 :     | SETTER(i,vl,e) => SETTER(i,map rename vl,h e)
70 :     | LOOKER(i,vl,w,t,e) => LOOKER(i,map rename vl,w,t,h e)
71 :     | ARITH(i,vl,w,t,e) => ARITH(i,map rename vl,w,t,h e)
72 :     | PURE(i,vl,w,t,e) => PURE(i,map rename vl,w,t,h e)
73 : mblume 1755 | RCC(k,l,p,vl,wtl,e) => RCC(k, l, p, map rename vl, wtl, h e)
74 : monnier 245 in h
75 :     end
76 :    
77 :     in (fk,v,args,cl,g nil ce)
78 :     end (* unrebind *)
79 :    
80 :     end (* local *)
81 :    
82 :     end (* structure UnRebind *)
83 :    
84 :    

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