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/globalfix.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 245 (* Copyright 1989 by AT&T Bell Laboratories
2 :     *
3 :     *)
4 :     signature GLOBALFIX =
5 :     sig val globalfix : CPS.function -> CPS.function list
6 :     end
7 :    
8 :     structure GlobalFix : GLOBALFIX =
9 :     struct
10 :     open CPS
11 :     fun globalfix(fk,f,vl,cl,cexp) =
12 :     let
13 :     fun gfix ce =
14 :     case ce
15 :     of FIX(fl,c) =>
16 :     let val (n,c') = gfix c
17 :     val l' = foldl
18 :     (fn((k,v,a,t,c),m) => let val (l,d) = gfix c in (k,v,a,t,d)::l@m end)
19 :     n fl
20 :     in (l',c')
21 :     end
22 :     | APP _ => ([],ce)
23 :     | SWITCH(v,c0,l) =>
24 :     let val (f,l') =
25 :     foldr (fn(c,(fl,cl)) => let val (f,d) = gfix c in (f@fl,d::cl) end)
26 :     ([],[]) l
27 :     in (f,SWITCH(v,c0,l'))
28 :     end
29 :     | RECORD(k,l,v,c) => let val (f,c') = gfix c in (f,RECORD(k,l,v,c')) end
30 :     | SELECT(i,v,w,t,c) => let val (f,c') = gfix c in (f,SELECT(i,v,w,t,c')) end
31 :     | OFFSET(i,v,w,c) => let val (f,c') = gfix c in (f,OFFSET(i,v,w,c')) end
32 :     | SETTER(i,vl,c) => let val (f,c') = gfix c in (f,SETTER(i,vl,c')) end
33 :     | LOOKER(i,vl,w,t,c) => let val (f,c') = gfix c in (f,LOOKER(i,vl,w,t,c')) end
34 :     | ARITH(i,vl,w,t,c) => let val (f,c') = gfix c in (f,ARITH(i,vl,w,t,c')) end
35 :     | PURE(i,vl,w,t,c) => let val (f,c') = gfix c in (f,PURE(i,vl,w,t,c')) end
36 :     | BRANCH(i,args,c,e1,e2) =>
37 :     let val (f1,e1') = gfix e1
38 :     val (f2,e2') = gfix e2
39 :     in (f1@f2, BRANCH(i,args,c,e1',e2'))
40 :     end
41 :     val (l,body) = gfix cexp
42 :     in (fk,f,vl,cl,body) :: l
43 :     end
44 :     end (* structure GlobalFix *)
45 :    

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