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

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

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

revision 99, Thu May 14 04:56:46 1998 UTC revision 100, Thu May 14 04:56:46 1998 UTC
# Line 2  Line 2 
2  (* cpsopt.sml *)  (* cpsopt.sml *)
3    
4  signature CPSOPT = sig  signature CPSOPT = sig
5      val reduce : (CPS.function * LtyDef.lty Intmap.intmap      val reduce : (CPS.function * Unsafe.Object.object option * bool)
6                    * Unsafe.Object.object option * bool)                   -> CPS.function
                  -> CPS.function * LtyDef.lty Intmap.intmap  
7  end (* signature CPSOPT *)  end (* signature CPSOPT *)
8    
9  functor CPSopt(MachSpec: MACH_SPEC) : CPSOPT = struct  functor CPSopt(MachSpec: MACH_SPEC) : CPSOPT = struct
# Line 18  Line 17 
17  structure Uncurry = Uncurry(MachSpec)  structure Uncurry = Uncurry(MachSpec)
18  val say = Control.Print.say  val say = Control.Print.say
19    
20  fun reduce (function, table, _, afterClosure) =  (** obsolete table: used by cpsopt as a dummy template *)
21    exception ZZZ
22    val dummyTable : FLINT.lty Intmap.intmap = Intmap.new(32, ZZZ)
23    
24    (** the main function reduce *)
25    fun reduce (function, _, afterClosure) =
26  (* NOTE: The third argument to reduce is currently ignored.  (* NOTE: The third argument to reduce is currently ignored.
27     It used to be used for reopening closures. *)     It used to be used for reopening closures. *)
28  let  let
29    
30    val table = dummyTable
31  val debug = !CG.debugcps (* false *)  val debug = !CG.debugcps (* false *)
32  fun debugprint s = if debug then say s else ()  fun debugprint s = if debug then say s else ()
33  fun debugflush() = if debug then Control.Print.flush() else ()  fun debugflush() = if debug then Control.Print.flush() else ()
# Line 30  Line 35 
35  fun click (s:string) = (debugprint s; clicked := !clicked+1)  fun click (s:string) = (debugprint s; clicked := !clicked+1)
36    
37  val cpssize = ref 0  val cpssize = ref 0
38  (*  
39  val prC =  val prC =
40    let fun prGen (flag,printE) s e =    let fun prGen (flag,printE) s e =
41          if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e; e)          if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e; e)
42          else e          else e
43     in prGen (Control.CG.printit, PPCps.printcps0)     in prGen (Control.CG.printit, PPCps.printcps0)
44    end    end
 *)  
45    
46  fun contract last f =  fun contract last f =
47    let val f' = (clicked := 0;    let val f' = (clicked := 0;
# Line 159  Line 163 
163                 if !CG.betaexpand orelse !CG.flattenargs                 if !CG.betaexpand orelse !CG.flattenargs
164                     then expand_flatten_contract(func,linear_decrease k)                     then expand_flatten_contract(func,linear_decrease k)
165                 else (0,func)                 else (0,func)
166               (* val _ = prC "cycle_contract" func *)
167    
168         in  if c * 1000 <= !cpssize * reducemore         in  if c * 1000 <= !cpssize * reducemore
169             then if unrolled then func             then if unrolled then func
170                              else unroll func                              else unroll func
# Line 171  Line 177 
177             else func'             else func'
178         end         end
179    
180  in  (if rounds < 0 then (function,table)  in  (if rounds < 0 then function
181       else (let val function1 = first_contract function       else (let val function1 = first_contract function
182                 val function2 = eta function1                 val function2 = eta function1
183                 val function3 = uncurry function2                 val function3 = uncurry function2
# Line 179  Line 185 
185                 val function5 = cycle(rounds, not(!CG.unroll), function4)                 val function5 = cycle(rounds, not(!CG.unroll), function4)
186                 val function6 = eta function5 (* ZSH added this new phase *)                 val function6 = eta function5 (* ZSH added this new phase *)
187                 val function7 = last_contract function6                 val function7 = last_contract function6
188              in (function7, table)              in function7
189             end))             end))
190      before (debugprint "\n"; debugflush())      before (debugprint "\n"; debugflush())
191    

Legend:
Removed from v.99  
changed lines
  Added in v.100

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