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

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

Parent Directory Parent Directory | Revision Log 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