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

Parent Directory | Revision Log

---

Revision 94 - (view) (download)

1 :	monnier	16	(* 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 :
46 :			(*
47 :			* $Log: globalfix.sml,v $
48 :	monnier	93	* Revision 1.1.1.1 1998/04/08 18:39:46 george
49 :			* Version 110.5
50 :	monnier	16	*
51 :			*)

---

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