25 |
|
|
26 |
fun phase x = Stats.doPhase (Stats.makePhase x) |
fun phase x = Stats.doPhase (Stats.makePhase x) |
27 |
|
|
28 |
|
val fcc = Stats.newCounter[]; |
29 |
|
val _ = Stats.registerStat(Stats.newStat("FContract", [fcc])) |
30 |
|
|
31 |
|
val deb2names = phase "Compiler 056 deb2names" TvarCvt.debIndex2names |
32 |
|
val names2deb = phase "Compiler 057 names2deb" TvarCvt.names2debIndex |
33 |
|
|
34 |
val lcontract = phase "Compiler 052 lcontract" LContract.lcontract |
val lcontract = phase "Compiler 052 lcontract" LContract.lcontract |
35 |
|
val lcontract' = phase "Compiler 052 lcontract'" LContract.lcontract |
36 |
val fcollect = phase "Compiler 052a fcollect" Collect.collect |
val fcollect = phase "Compiler 052a fcollect" Collect.collect |
37 |
val fcontract = phase "Compiler 052b fcontract" FContract.contract |
val fcontract = phase "Compiler 052b fcontract" FContract.contract |
38 |
val fcontract = fn f => (fcontract(fcollect f, Stats.newCounter[])) |
val fcontract = fn f => ((* lcontract' f; *) fcontract(fcollect f, fcc)) |
39 |
val loopify = phase "Compiler 057 loopify" Loopify.loopify |
val loopify = phase "Compiler 057 loopify" Loopify.loopify |
40 |
val fixfix = phase "Compiler 056 fixfix" FixFix.fixfix |
val fixfix = phase "Compiler 056 fixfix" FixFix.fixfix |
41 |
|
|
46 |
val wrapping = phase "Compiler 054 wrapping" Wrapping.wrapping |
val wrapping = phase "Compiler 054 wrapping" Wrapping.wrapping |
47 |
val reify = phase "Compiler 055 reify" Reify.reify |
val reify = phase "Compiler 055 reify" Reify.reify |
48 |
|
|
|
val deb2names = phase "Compiler 056 deb2names" TvarCvt.debIndex2names |
|
|
val names2deb = phase "Compiler 057 names2deb" TvarCvt.names2debIndex |
|
|
|
|
49 |
val convert = phase "Compiler 060 convert" Convert.convert |
val convert = phase "Compiler 060 convert" Convert.convert |
50 |
val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans |
val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans |
51 |
val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce |
val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce |
96 |
let fun err severity s = |
let fun err severity s = |
97 |
error (0,0) severity (concat["Real constant out of range: ",s,"\n"]) |
error (0,0) severity (concat["Real constant out of range: ",s,"\n"]) |
98 |
|
|
99 |
fun check (checkE,printE,chkId) (enableChk,lvl,logId) e = |
fun check (checkE,printE,chkId) (lvl,logId) e = |
100 |
(if !enableChk andalso checkE (e,lvl) then |
if checkE (e,lvl) then |
101 |
(dumpTerm (printE, src ^ "." ^ chkId ^ logId, e); |
(dumpTerm (printE, src ^ "." ^ chkId ^ logId, e); |
102 |
bug (chkId ^ " typing errors " ^ logId)) |
bug (chkId ^ " typing errors " ^ logId)) |
103 |
else (); |
else () |
|
e) |
|
|
fun chkF (b, s) = |
|
|
check (ChkFlint.checkTop, PPFlint.printFundec, |
|
|
"FLINT") (CTRL.check, b, s) |
|
|
|
|
104 |
fun wff (f, s) = if wformed f then () |
fun wff (f, s) = if wformed f then () |
105 |
else print ("\nAfter " ^ s ^ " CODE NOT WELL FORMED\n") |
else print ("\nAfter " ^ s ^ " CODE NOT WELL FORMED\n") |
106 |
|
|
158 |
| ("wellformed",_) => (wff(f,l); (f,fk,p)) |
| ("wellformed",_) => (wff(f,l); (f,fk,p)) |
159 |
| ("check",_) => |
| ("check",_) => |
160 |
(check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT") |
(check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT") |
161 |
(ref true, fk = FK_REIFY, l) f; (f,fk,l)) |
(fk = FK_REIFY, l) f; (f,fk,l)) |
162 |
| _ => |
| _ => |
163 |
(say("\n!! Unknown or badly scheduled FLINT phase '"^p^"' !!\n"); |
(say("\n!! Unknown or badly scheduled FLINT phase '"^p^"' !!\n"); |
164 |
(f,fk,l)) |
(f,fk,l)) |
165 |
|
|
166 |
fun print (f,fk,l) = (prF l f; (f, fk, l)) |
fun print (f,fk,l) = (prF l f; (f, fk, l)) |
167 |
fun check (f,fk,l) = |
fun check' (f,fk,l) = |
168 |
((* if fk <> FK_NAMED *) chkF (fk = FK_REIFY, l) (names2deb f) (* else f *); |
(if !CTRL.check then |
169 |
|
check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT") |
170 |
|
(fk = FK_REIFY, l) |
171 |
|
(if fk = FK_DEBRUIJN then f else names2deb f) |
172 |
|
else (); |
173 |
(f, fk, l)) |
(f, fk, l)) |
174 |
|
|
175 |
fun runphase' (arg as (p,{1=f,...})) = |
fun runphase' (arg as (p,{1=f,...})) = |
176 |
(if !CTRL.printPhases then say("Phase "^p^"...") else (); |
(if !CTRL.printPhases then say("Phase "^p^"...") else (); |
177 |
((check o print o runphase) arg) before |
((check' o print o runphase) arg) before |
178 |
(if !CTRL.printPhases then say("..."^p^" Done.\n") else ())) |
(if !CTRL.printPhases then say("..."^p^" Done.\n") else ())) |
179 |
handle x => (say ("\nwhile in "^p^" phase\n"); |
handle x => (say ("\nwhile in "^p^" phase\n"); |
180 |
dumpTerm(PPFlint.printFundec,"FLINT.core", f); |
dumpTerm(PPFlint.printFundec,"FLINT.core", f); |
181 |
raise x) |
raise x) |
182 |
|
|
|
(* the "id" phase is just added to do the print/check at the entrance *) |
|
183 |
val (flint,fk,_) = foldl runphase' |
val (flint,fk,_) = foldl runphase' |
184 |
(deb2names flint, FK_NAMED, "flintnm") |
(flint, FK_DEBRUIJN, "flintnm") |
185 |
((* "id" :: *) !CTRL.phases) |
((* "id" :: *) "deb2names" :: !CTRL.phases) |
186 |
|
|
187 |
(* run any missing phases *) |
(* run any missing phases *) |
188 |
val (flint,fk) = |
val (flint,fk) = |