Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml
[smlnj] / sml / trunk / src / compiler / FLINT / main / flintcomp.sml  
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 198, Sun Nov 22 02:11:29 1998 UTC revision 202, Sun Dec 13 02:29:45 1998 UTC
# Line 25  Line 25 
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    
# Line 39  Line 46 
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
# Line 92  Line 96 
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    
# Line 159  Line 158 
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) =
Legend:
Removed from v.198  
changed lines
  Added in v.202
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge