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

Diff of /sml/trunk/src/compiler/FLINT/opt/fixfix.sml

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

revision 122, Sat Jun 6 15:05:38 1998 UTC revision 160, Mon Oct 12 03:31:38 1998 UTC
# Line 1  Line 1 
1  (* copyright 1998 YALE FLINT PROJECT *)  (* copyright 1998 YALE FLINT PROJECT *)
2    (* monnier@cs.yale.edu *)
3    
4  (* This module does various FIX-related transformations:  (* This module does various FIX-related transformations:
5   * - FIXes are split into their strongly-connected components   * - FIXes are split into their strongly-connected components
6   * - small non-recursive functions are marked inlinable   * - small non-recursive functions are marked inlinable
7     * - curried functions are uncurried
8   *)   *)
9    
10  signature FIXFIX =  signature FIXFIX =
# Line 10  Line 12 
12      val fixfix : FLINT.prog -> FLINT.prog      val fixfix : FLINT.prog -> FLINT.prog
13  end  end
14    
15  (* It could later be extended to also do:  (* Maybe later:
  * - curried functrions are uncurried  
16   * - hoisting of inner functions out of their englobing function   * - hoisting of inner functions out of their englobing function
17   *   so that the outer function becomes smaller, giving more opportunity   *   so that the outer function becomes smaller, giving more opportunity
18   *   for inlining.   *   for inlining.
19     * - eta expand escaping functions
20     * - loop-preheader introduction
21   *)   *)
22    
23  structure FixFix :> FIXFIX =  structure FixFix :> FIXFIX =
# Line 25  Line 28 
28      structure S = IntSetF      structure S = IntSetF
29      structure M = IntmapF      structure M = IntmapF
30      structure PP = PPFlint      structure PP = PPFlint
     structure LV = LambdaVar  
31      structure LK = LtyKernel      structure LK = LtyKernel
32      structure LT = LtyExtern      structure LT = LtyExtern
33  in  in
# Line 36  Line 38 
38  fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)  fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
39  fun assert p = if p then () else bug ("assertion failed")  fun assert p = if p then () else bug ("assertion failed")
40    
41    val cplv = LambdaVar.dupLvar
42    
43  structure SccNode = struct  structure SccNode = struct
44      type node = LambdaVar.lvar      type node = LambdaVar.lvar
45      val eq = (op =)      val eq = (op =)
# Line 92  Line 96 
96    
97      (* do the actual uncurrying *)      (* do the actual uncurrying *)
98      fun uncurry (args as (fk,f,fargs)::_::_,body) =      fun uncurry (args as (fk,f,fargs)::_::_,body) =
99          let val f' = LV.mkLvar()        (* the new fun name *)          let val f' = cplv f     (* the new fun name *)
100    
101              fun getrtypes ([],rtys) = (NONE, rtys)              fun getrtypes ([],rtys) = (NONE, rtys)
102                | getrtypes ((fk,f,fargs:(F.lvar * F.lty) list)::rest,rtys) =                | getrtypes ((fk,f,fargs:(F.lvar * F.lty) list)::rest,rtys) =
# Line 132  Line 136 
136                      end                      end
137    
138              (* funarg renaming *)              (* funarg renaming *)
139              fun newargs fargs = map (fn (_,t) => (LV.mkLvar(),t)) fargs              fun newargs fargs = map (fn (a,t) => (cplv a,t)) fargs
140    
141              (* create (curried) wrappers to be inlined *)              (* create (curried) wrappers to be inlined *)
142              fun recurry ([],args) = F.APP(F.VAR f', map (F.VAR o #1) args)              fun recurry ([],args) = F.APP(F.VAR f', map (F.VAR o #1) args)
# Line 143  Line 147 
147                                   F.FK_FUN{isrec=NONE, fixed=fixed,                                   F.FK_FUN{isrec=NONE, fixed=fixed,
148                                            known=known, inline=true}                                            known=known, inline=true}
149                      val nfargs = newargs fargs                      val nfargs = newargs fargs
150                      val g = LV.mkLvar()                      val g = cplv f'
151                  in F.FIX([(fk, g, nfargs, recurry(rest, args @ nfargs))],                  in F.FIX([(fk, g, nfargs, recurry(rest, args @ nfargs))],
152                           F.RET[F.VAR g])                           F.RET[F.VAR g])
153                  end                  end
# Line 198  Line 202 
202    
203             (* process the main lexp and make it into a dummy function.             (* process the main lexp and make it into a dummy function.
204              * The computation of the freevars is a little sloppy since `fv'              * The computation of the freevars is a little sloppy since `fv'
205              * includes freevars of the continuation, but the unicity              * includes freevars of the continuation, but the uniqueness
206              * of varnames ensures that S.inter(fv, funs) gives the correct              * of varnames ensures that S.inter(fv, funs) gives the correct
207              * result nonetheless. *)              * result nonetheless. *)
208             val (s,fv,le) = fexp(fv, le)             val (s,fv,le) = fexp(fv, le)

Legend:
Removed from v.122  
changed lines
  Added in v.160

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