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

Diff of /sml/trunk/compiler/FLINT/cpsopt/uncurry.sml

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

revision 4812, Wed Sep 12 21:56:57 2018 UTC revision 4813, Wed Sep 12 23:55:25 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 rep_flag = MachSpec.representations  
 val type_flag = (!Control.CG.checkcps1) andalso  
                 (!Control.CG.checkcps1) andalso rep_flag  
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 75  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 121  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.4812  
changed lines
  Added in v.4813

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