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 191, Fri Nov 20 02:01:27 1998 UTC revision 197, Sun Nov 22 01:25:23 1998 UTC
# Line 21  Line 21 
21  fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)  fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)
22  val say = Control.Print.say  val say = Control.Print.say
23    
24    datatype flintkind = FK_WRAP | FK_REIFY | FK_DEBRUIJN | FK_NAMED | FK_CPS
25    
26  fun phase x = Stats.doPhase (Stats.makePhase x)  fun phase x = Stats.doPhase (Stats.makePhase x)
27    
28  val lcontract = phase "Compiler 052 lcontract" LContract.lcontract  val lcontract = phase "Compiler 052 lcontract" LContract.lcontract
29  val fcollect  = phase "Compiler 052a fcollect" Collect.collect  val fcollect  = phase "Compiler 052a fcollect" Collect.collect
30  val fcontract = phase "Compiler 052b fcontract" FContract.contract  val fcontract = phase "Compiler 052b fcontract" FContract.contract
31  val fcontract = fn f => (fcontract(fcollect f, Stats.newCounter[]))  val fcontract = fn f => (fcontract(fcollect f, Stats.newCounter[]))
   
32  val loopify   = phase "Compiler 057 loopify" Loopify.loopify  val loopify   = phase "Compiler 057 loopify" Loopify.loopify
33    val fixfix    = phase "Compiler 056 fixfix" FixFix.fixfix
34    
35    val typelift  = phase "Compiler 0535 typelift" Lift.typeLift
36    val wformed   = phase "Compiler 0536 wformed" Lift.wellFormed
37    
38  val specialize= phase "Compiler 053 specialize" Specialize.specialize  val specialize= phase "Compiler 053 specialize" Specialize.specialize
39  val wrapping  = phase "Compiler 054 wrapping" Wrapping.wrapping  val wrapping  = phase "Compiler 054 wrapping" Wrapping.wrapping
40  val reify     = phase "Compiler 055 reify" Reify.reify  val reify     = phase "Compiler 055 reify" Reify.reify
41  val fixfix    = phase "Compiler 056 fixfix" FixFix.fixfix  
42    val deb2names = phase "Compiler 056 deb2names" TvarCvt.debIndex2names
43    val names2deb = phase "Compiler 057 names2deb" TvarCvt.names2debIndex
44    
45  val convert   = phase "Compiler 060 convert" Convert.convert  val convert   = phase "Compiler 060 convert" Convert.convert
46  val cpstrans  = phase "Compiler 065 cpstrans" CPStrans.cpstrans  val cpstrans  = phase "Compiler 065 cpstrans" CPStrans.cpstrans
# Line 95  Line 102 
102          check (ChkFlint.checkTop, PPFlint.printFundec,          check (ChkFlint.checkTop, PPFlint.printFundec,
103                 "FLINT") (CTRL.check, b, s)                 "FLINT") (CTRL.check, b, s)
104    
105        val fcing = ref (!fcs)        fun wff (f, s) = if wformed f then ()
106                           else print ("\nAfter " ^ s ^ " CODE NOT WELL FORMED\n")
107    
108        (* fun fcontract f =        (* val fcing = ref (!fcs)
109          fun fcontract f =
110            case !fcing            case !fcing
111             of fcontract::fcs => (fcing := fcs; fcontract f)             of fcontract::fcs => (fcing := fcs; fcontract f)
112              | [] => let val fcc = Stats.newCounter[]              | [] => let val fcc = Stats.newCounter[]
# Line 121  Line 130 
130        (* f:FLINT.prog   flint codee        (* f:FLINT.prog   flint codee
131         * r:boot         whether it has gone through reify yet         * r:boot         whether it has gone through reify yet
132         * l:string       last phase through which it went *)         * l:string       last phase through which it went *)
133        fun runphase (p as "fcontract",(f,r,l)) = (fcontract f, r, p)        fun runphase (p,(f,fk,l)) =
134          | runphase (p as "lcontract",(f,r,l)) = (lcontract f, r, p)            case (p,fk)
135          | runphase (p as "fixfix",(f,r,l)) = (fixfix f, r, p)             of (("fcontract" | "lcontract"), FK_DEBRUIJN) =>
136          | runphase (p as "loopify",(f,r,l)) = (loopify f, r, p)                (say("\n!! "^p^" cannot be applied to the DeBruijn form !!\n");
137          | runphase (p as "wrap",(f,false,l)) = (wrapping f, false, p)                 (f, fk, l))
138          | runphase (p as "specialize",(f,false,l)) = (specialize f, false, p)  
139          | runphase (p as "reify",(f,false,l)) = (reify f, true, p)              | ("fcontract",_)           => (fcontract f,  fk, p)
140                | ("lcontract",_)           => (lcontract f,  fk, p)
141                | ("fixfix",   _)           => (fixfix f,     fk, p)
142                | ("loopify",  _)           => (loopify f,    fk, p)
143                | ("specialize",FK_NAMED)   => (specialize f, fk, p)
144                | ("typelift",FK_DEBRUIJN)  => (typelift f,   fk, p)
145                | ("wrap",FK_NAMED)         => (wrapping f,   FK_WRAP, p)
146                | ("reify",FK_WRAP)         => (reify f,      FK_REIFY, p)
147                | ("deb2names",FK_DEBRUIJN) => (deb2names f,  FK_NAMED, p)
148                | ("names2deb",FK_NAMED)    => (names2deb f,  FK_DEBRUIJN, p)
149    
150          (* pseudo FLINT phases *)          (* pseudo FLINT phases *)
151          | runphase ("id",(f,r,l)) = (f,r,l)              | ("id",_) => (f,fk,l)
152          | runphase (p as "collect",(f,r,l)) = (fcollect f, r, p)              | ("collect",_) => (fcollect f, fk, p)
153          | runphase (p as "print",(f,r,l)) =              | ("print",_) =>
154            (say("\n[ After "^l^"... ]\n\n");                (say("\n\n[ After "^l^"... ]\n\n");
155             PPFlint.printFundec f; (f,r,l)                 PPFlint.printFundec f;
156             before say "\n")                 (f, fk, l) before say "\n")
157          | runphase ("check",(f,r,l)) =              | ("wellformed",FK_DEBRUIJN) => (wff(f,l); (f,fk,p))
158                | ("check",_) =>
159            (check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT")            (check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT")
160                   (ref true, r, l) f; (f,r,l))                       (ref true, fk = FK_REIFY, l) f; (f,fk,l))
161          | runphase (p as ("reify"|"specialize"|"wrap"),(f,true,l)) =              | _ =>
162            (say("\n"^p^"cannot be used after reify!\n"); (f,true,l))                (say("\n!! Unknown or badly scheduled FLINT phase '"^p^"' !!\n");
163          | runphase (p,(f,r,l)) =                 (f,fk,l))
164            (say("\n!! Unknown FLINT phase '"^p^"' !!\n"); (f,r,l))  
165          fun print (f,fk,l) = (prF l f; (f, fk, l))
166        fun print (f,r,l) = (prF l f; (f, r, l))        fun check (f,fk,l) =
167        fun check (f,r,l) = (chkF (r, l) f; (f, r, l))            ((* if fk <> FK_NAMED *) chkF (fk = FK_REIFY, l) (names2deb f) (* else f *);
168               (f, fk, l))
169    
170        fun runphase' (arg as (p,{1=f,...})) =        fun runphase' (arg as (p,{1=f,...})) =
171            (if !CTRL.printPhases then say("Phase "^p^"...") else ();            (if !CTRL.printPhases then say("Phase "^p^"...") else ();
# Line 156  Line 176 
176                             raise x)                             raise x)
177    
178        (* the "id" phase is just added to do the print/check at the entrance *)        (* the "id" phase is just added to do the print/check at the entrance *)
179        val (flint,r,_) = foldl runphase'        val (flint,fk,_) = foldl runphase'
180                                (flint,false,"flintnm")                                 (flint, FK_DEBRUIJN, "flintnm")
181                                ((*  "id" :: *) !CTRL.phases)                                ((*  "id" :: *) !CTRL.phases)
       val flint = if r then flint else (say "\n!!Forgot reify!!\n"; reify flint)  
   
 (*        val _ = (chkF (false,"1") o prF "Translation/Normalization") flint *)  
 (*        val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)  
   
 (*        val flint = *)  
 (*          if !Control.FLINT.specialize then *)  
 (*             (chkF (false,"3") o prF "Specialization" o specialize) flint *)  
 (*          else flint *)  
 (*        val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)  
   
 (*        val flint = (chkF (false,"6") o prF "FixFix" o fixfix) flint *)  
 (*        val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)  
   
 (*        val flint = (chkF (false, "4") o prF "Wrapping" o wrapping) flint *)  
 (*        val flint = (chkF (true, "5") o prF "Reify" o reify) flint *)  
182    
183  (*        val flint = (chkF (true,"2") o prF "Fcontract" o fcontract) flint *)        (* run any missing phases *)
184          val (flint,fk) =
185              if fk = FK_NAMED
186              then (say "\n!!Forgot deb2names!!\n"; (deb2names flint, FK_DEBRUIJN))
187              else (flint,fk)
188          val (flint,fk) =
189              if fk = FK_DEBRUIJN
190              then (say "\n!!Forgot wrap!!\n"; (wrapping flint, FK_WRAP))
191              else (flint,fk)
192          val (flint,fk) =
193              if fk = FK_WRAP
194              then (say "\n!!Forgot reify!!\n"; (reify flint, FK_REIFY))
195              else (flint,fk)
196    
197          (* finish up with CPS *)
198        val (nc0, ncn, dseg) =        val (nc0, ncn, dseg) =
199          let val function = convert flint          let val function = convert flint
200              val _ = prC "convert" function              val _ = prC "convert" function
Legend:
Removed from v.191  
changed lines
  Added in v.197
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge