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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* 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 unrebind (fk,v,args,cl,ce) =
27 :     let fun rename rebind(VAR v) =
28 :     let fun f nil = VAR v
29 :     | f ((w:int,v')::t) = if v=w then v' else f t
30 :     in f rebind
31 :     end
32 :     | rename _ x = x
33 :    
34 :     fun f (kind,l,args,cl,b) =
35 :     let val (args',rebind') =
36 :     foldr (fn (v,(args',rebind')) =>
37 :     let val v' = LambdaVar.dupLvar v
38 :     in (v'::args',(v, VAR v')::rebind')
39 :     end)
40 :     (nil,nil) args
41 :     in (kind,l,args',cl,g rebind' b)
42 :     end
43 :    
44 :     and g (rebind: (lvar * value) list) =
45 :     let val rename = rename rebind
46 :     val rec h =
47 :     fn RECORD(kind,vl,w,e) =>
48 :     RECORD(kind,map (fn(v,p) => (rename v,p)) vl,w,h e)
49 :     | OFFSET(0,v,w,e) => g ((w,rename v)::rebind) e
50 :     | OFFSET(i,v,w,e) =>
51 :     let val w' = LambdaVar.dupLvar w
52 :     in OFFSET(i,rename v,w',g ((w, VAR w')::rebind) e)
53 :     end
54 :     | SELECT(i,v,w,t,e) =>
55 :     let val w' = LambdaVar.dupLvar w
56 :     in SELECT(i,rename v,w',t,g((w, VAR w')::rebind) e)
57 :     end
58 :     | APP(f,vl) => APP(rename f,map rename vl)
59 :     | FIX(l,e) => FIX(map f l,h e)
60 :     | SWITCH(v,c,el) => SWITCH(rename v,c,map h el)
61 :     | BRANCH(i,vl,c,e1,e2) => BRANCH(i,map rename vl,c, h e1, h e2)
62 :     | SETTER(i,vl,e) => SETTER(i,map rename vl,h e)
63 :     | LOOKER(i,vl,w,t,e) => LOOKER(i,map rename vl,w,t,h e)
64 :     | ARITH(i,vl,w,t,e) => ARITH(i,map rename vl,w,t,h e)
65 :     | PURE(i,vl,w,t,e) => PURE(i,map rename vl,w,t,h e)
66 :     in h
67 :     end
68 :    
69 :     in (fk,v,args,cl,g nil ce)
70 :     end (* unrebind *)
71 :    
72 :     end (* local *)
73 :    
74 :     end (* structure UnRebind *)
75 :    
76 :    
77 :     (*
78 :     * $Log: unrebind.sml,v $
79 :     * Revision 1.1.1.1 1997/01/14 01:38:33 george
80 :     * Version 109.24
81 :     *
82 :     *)

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