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/branches/arith64/compiler/FLINT/cpsopt/uncurry.sml
ViewVC logotype

Diff of /sml/branches/arith64/compiler/FLINT/cpsopt/uncurry.sml

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

revision 4809, Wed Sep 12 21:50:55 2018 UTC revision 4810, Wed Sep 12 21:52:19 2018 UTC
# Line 41  Line 41 
41     in g     in g
42    end    end
43    
44  fun etasplit {function=(fkind,fvar,fargs,ctyl,cexp),  fun etasplit {function=(fkind,fvar,fargs,ctyl,cexp), click} =
               table=typtable, click} =  
45  let  let
46    
47  val debug = !Control.CG.debugcps (* false *)  val debug = !Control.CG.debugcps (* false *)
48  fun debugprint s = if debug then Control.Print.say s else ()  fun debugprint s = if debug then Control.Print.say s else ()
49  fun debugflush() = if debug then Control.Print.flush() else ()  fun debugflush() = if debug then Control.Print.flush() else ()
 val type_flag = (!Control.CG.checkcps1) andalso (!Control.CG.checkcps1)  
50    
51  val defaultArrow = LT.ltc_parrow(LT.ltc_void,LT.ltc_void)  val defaultArrow = LT.ltc_parrow(LT.ltc_void,LT.ltc_void)
52    
# Line 73  Line 71 
71     in h(cl, 0, 0)     in h(cl, 0, 0)
72    end    end
73    
74  exception NEWETA  fun copyLvar v = LV.dupLvar v
 fun getty v =  
   if type_flag  
   then (IntHashTable.lookup typtable v) handle _ =>  
                 (Control.Print.say ("NEWETA: Can't find the variable "^  
                             (Int.toString v)^" in the typtable ***** \n");  
                  raise NEWETA)  
   else LT.ltc_void  
   
 fun addty(f,t) = if type_flag then IntHashTable.insert typtable (f,t) else ()  
 fun mkv(t) = let val v = LV.mkLvar()  
               in (addty(v,t); v)  
              end  
 fun copyLvar v = let val x = LV.dupLvar(v)  
                   in (addty(x,getty v); x)  
                  end  
   
 (* fun userfun(f) = case LT.out(getty(f)) of LT.ARROW _ => true  
                                 | _ => false  
  *)  
75    
76  val rec reduce =  val rec reduce =
77     fn RECORD(k,vl,w,e) => RECORD(k, vl, w, reduce e)     fn RECORD(k,vl,w,e) => RECORD(k, vl, w, reduce e)
# Line 119  Line 98 
98                              and vl' = map copyLvar vl                              and vl' = map copyLvar vl
99                              val k'= copyLvar k                              val k'= copyLvar k
100                              and g'= copyLvar g                              and g'= copyLvar g
101                              val newlt = extendLty(getty(g),(map getty vl))                              val f' = LV.mkLvar()
                             val f' = mkv(newlt)  
102                          in click "u";                          in click "u";
103                              (NO_INLINE_INTO,f,k'::vl',ct::cl,                              (NO_INLINE_INTO,f,k'::vl',ct::cl,
104                               FIX([(gk,g',ul',cl',APP(VAR f',                               FIX([(gk,g',ul',cl',APP(VAR f',

Legend:
Removed from v.4809  
changed lines
  Added in v.4810

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