Annotation of /sml/trunk/src/compiler/FLINT/opt/flintcomp.sml

Parent Directory | Revision Log

---

Revision 21 - (view) (download)

1 :	monnier	21	(* COPYRIGHT 1997 YALE FLINT PROJECT *)
2 :			(* flintcomp.sml *)
3 :
4 :			signature FLINTCOMP =
5 :			sig
6 :			val flintcomp : Lambda.lexp -> Lambda.lexp
7 :			end
8 :
9 :			structure FLINTComp : FLINTCOMP =
10 :			struct
11 :
12 :			fun bug s = ErrorMsg.impossible ("Compile:" ^ s)
13 :			val say = Control.Print.say
14 :
15 :			fun flintcomp lambda =
16 :			let fun prLexp (s,le) =
17 :			let val outS = TextIO.openAppend ((!CheckLty.fname_ref)^s);
18 :			val saveOut = !Control.Print.out
19 :			in Control.Print.out := {
20 :			say = fn s => TextIO.output(outS,s),
21 :			flush = fn () => TextIO.flushOut outS
22 :			};
23 :			MCprint.printLexp (le);
24 :			TextIO.closeOut outS;
25 :			Control.Print.out := saveOut
26 :			end
27 :
28 :			val _ = if !Control.CG.printLambda
29 :			then (say "\n\n[After Translation ...]\n\n";
30 :			MCprint.printLexp lambda)
31 :			else ()
32 :
33 :			val _ = if !Control.CG.checklty1 then
34 :			(if CheckLty.checkLty(lambda, 1) then
35 :			(prLexp(".log1",lambda); bug "lambda typing errors1 !")
36 :			else ())
37 :			else ()
38 :
39 :			val lconLexp =
40 :			Stats.doPhase(Stats.makePhase "Compiler 052 lcontract") LContract.lcontract
41 :
42 :			val lambda = if !Control.CG.specialize then lconLexp lambda else lambda
43 :
44 :			val _ = if (!Control.CG.printLambda) andalso (!Control.CG.specialize)
45 :			then (say "\n\n[After LContract ...]\n\n";
46 :			MCprint.printLexp lambda)
47 :			else ()
48 :
49 :			val specLexp =
50 :			Stats.doPhase(Stats.makePhase "Compiler 053 specLexp") Specialize.specLexp
51 :
52 :			val lambda = if !Control.CG.specialize then specLexp lambda else lambda
53 :
54 :			val _ = if (!Control.CG.printLambda) andalso (!Control.CG.specialize)
55 :			then (say "\n\n[After Specialization ...]\n\n";
56 :			MCprint.printLexp lambda)
57 :			else ()
58 :
59 :			val _ = if (!Control.CG.checklty1) andalso (!Control.CG.specialize)
60 :			then
61 :			(if CheckLty.checkLty(lambda, 11) then
62 :			(prLexp(".log2",lambda); bug "lambda typing errors2 !")
63 :			else ())
64 :			else ()
65 :
66 :
67 :			val wrapLexp =
68 :			Stats.doPhase(Stats.makePhase "Compiler 054 wrapLexp") Wrapping.wrapLexp
69 :
70 :			val lambda = wrapLexp lambda
71 :
72 :			val _ = if !Control.CG.printLambda
73 :			then (say "\n\n[After Wrapping ...]\n\n";
74 :			MCprint.printLexp lambda)
75 :			else ()
76 :
77 :			val _ = if !Control.CG.checklty1 then
78 :			(if CheckLty.checkLty(lambda, 11) then
79 :			(prLexp(".log2",lambda); bug "lambda typing errors2 !")
80 :			else ())
81 :			else ()
82 :
83 :
84 :
85 :			val ltyComp =
86 :			Stats.doPhase(Stats.makePhase "Compiler 055 ltyComp") Reify.ltyComp
87 :
88 :			val lambda = ltyComp lambda
89 :			(*
90 :
91 :			val _ = if !Control.CG.printLambda
92 :			then (say "\n\n[After ltycompilation ...]\n\n";
93 :			MCprint.printLexp lambda)
94 :			else ()
95 :			*)
96 :			val _ = if !Control.CG.checklty1 then
97 :			(if CheckLty.checkLty(lambda, 21) then
98 :			(prLexp(".log3",lambda); bug "lambda typing errors3 !")
99 :			else ())
100 :			else ()
101 :
102 :			val narrow =
103 :			Stats.doPhase(Stats.makePhase "Compiler 056 ltNarrow") LtNarrow.narrow
104 :
105 :			val lambda = narrow lambda
106 :			(*
107 :			val _ = if !Control.CG.printLambda
108 :			then (say "\n\n[After ltynarrowing ...]\n\n";
109 :			MCprint.printLexp lambda)
110 :			else ()
111 :			*)
112 :			val _ = if !Control.CG.checklty1 then
113 :			(if CheckLty.checkLty(lambda, 21) then
114 :			(prLexp(".log4",lambda); bug "lambda typing errors4 !")
115 :			else ())
116 :			else ()
117 :
118 :			val lambdaopt =
119 :			Stats.doPhase(Stats.makePhase "Compiler 057 lambdaopt") LambdaOpt.lambdaopt
120 :
121 :			val lambda = lambdaopt lambda
122 :			val _ = if !Control.CG.checklty2 then
123 :			(if CheckLty.checkLty(lambda, 21) then
124 :			(prLexp(".log5",lambda); bug "lambda typing errors5 !")
125 :			else ())
126 :			else ()
127 :
128 :			val reorder =
129 :			Stats.doPhase(Stats.makePhase "Compiler 058 reorder") Reorder.reorder
130 :
131 :			val lambda = reorder lambda
132 :			val _ = if !Control.CG.checklty3 then
133 :			(if CheckLty.checkLty(lambda, 31) then
134 :			(prLexp(".log6",lambda); bug "lambda typing errors6 !")
135 :			else ())
136 :			else ()
137 :
138 :			val _ = if !Control.CG.printLambda
139 :			then (say "\n\n[After lambdaopt and reorder ...]\n\n";
140 :			MCprint.printLexp lambda)
141 :			else ()
142 :
143 :			in lambda
144 :			end
145 :
146 :			val flintcomp =
147 :			Stats.doPhase (Stats.makePhase "Compiler 050 FLINTComp") flintcomp
148 :
149 :			end (* structure FLINTComp *)

---

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