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

Parent Directory | Revision Log | Patch

	revision 159, Mon Oct 12 02:45:03 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)

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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

---

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