CVS: sml-dist/src/compiler/FLINT/opt fcontract.sml, 1.40, 1.40.12.1 fixfix.sml, 1.21, 1.21.20.1 lift.sml, 1.7, 1.7.12.1 loopify.sml, 1.11, 1.11.18.1 optutils.sml, 1.8, 1.8.26.1
David MacQueen <[email protected]> Fri, 11 Aug 2006 13:42:26 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv18989/src/compiler/FLINT/opt
Modified Files:
Tag: primop-branch-2
fcontract.sml fixfix.sml lift.sml loopify.sml optutils.sml
Log Message:
broke ltykernel into lty and ltykernel, improved pplty
Index: fcontract.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt/fcontract.sml,v
retrieving revision 1.40
retrieving revision 1.40.12.1
diff -C2 -d -r1.40 -r1.40.12.1
*** fcontract.sml 22 May 2003 22:46:27 -0000 1.40
--- fcontract.sml 11 Aug 2006 20:42:24 -0000 1.40.12.1
***************
*** 261,265 ****
let val f = mklv()
val fk = {isrec=NONE,known=true,inline=F.IH_SAFE,
! cconv=F.CC_FUN(LK.FF_FIXED)}
in case con of
F.DATAcon(dc as (_,_,lty),tycs,lv) =>
--- 261,265 ----
let val f = mklv()
val fk = {isrec=NONE,known=true,inline=F.IH_SAFE,
! cconv=F.CC_FUN(Lty.FF_FIXED)}
in case con of
F.DATAcon(dc as (_,_,lty),tycs,lv) =>
Index: fixfix.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt/fixfix.sml,v
retrieving revision 1.21
retrieving revision 1.21.20.1
diff -C2 -d -r1.21 -r1.21.20.1
*** fixfix.sml 4 May 2001 20:58:47 -0000 1.21
--- fixfix.sml 11 Aug 2006 20:42:24 -0000 1.21.20.1
***************
*** 110,114 ****
* is already recursive *)
of ((SOME{isrec=NONE,...},{isrec=SOME _,...}) |
! (SOME{cconv=F.CC_FCT,...},{cconv=F.CC_FUN (LK.FF_VAR _),...}) |
(SOME{cconv=F.CC_FUN _,...},{cconv=F.CC_FCT,...})) =>
([], le)
--- 110,114 ----
* is already recursive *)
of ((SOME{isrec=NONE,...},{isrec=SOME _,...}) |
! (SOME{cconv=F.CC_FCT,...},{cconv=F.CC_FUN (Lty.FF_VAR _),...}) |
(SOME{cconv=F.CC_FUN _,...},{cconv=F.CC_FCT,...})) =>
([], le)
***************
*** 141,146 ****
of F.CC_FCT => F.CC_FCT
| _ => case #cconv(#1(List.last args))
! of F.CC_FUN(LK.FF_VAR(_,raw)) =>
! F.CC_FUN(LK.FF_VAR(true, raw))
| cconv => cconv
val (nfk,nfk') = OU.fk_wrap(fk, foldl getrtypes NONE args)
--- 141,146 ----
of F.CC_FCT => F.CC_FCT
| _ => case #cconv(#1(List.last args))
! of F.CC_FUN(Lty.FF_VAR(_,raw)) =>
! F.CC_FUN(Lty.FF_VAR(true, raw))
| cconv => cconv
val (nfk,nfk') = OU.fk_wrap(fk, foldl getrtypes NONE args)
Index: lift.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt/lift.sml,v
retrieving revision 1.7
retrieving revision 1.7.12.1
diff -C2 -d -r1.7 -r1.7.12.1
*** lift.sml 22 May 2003 22:46:28 -0000 1.7
--- lift.sml 11 Aug 2006 20:42:24 -0000 1.7.12.1
***************
*** 143,147 ****
let fun g(fvs', exp') =
let val newvar = mkv()
! val fund = {isrec = NONE, cconv = CC_FUN(FF_VAR(true,true)), known = false,
inline = IH_SAFE }
in FIX([(fund, newvar, fvs', exp')], RET [VAR newvar])
--- 143,147 ----
let fun g(fvs', exp') =
let val newvar = mkv()
! val fund = {isrec = NONE, cconv = CC_FUN(Lty.FF_VAR(true,true)), known = false,
inline = IH_SAFE }
in FIX([(fund, newvar, fvs', exp')], RET [VAR newvar])
Index: loopify.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt/loopify.sml,v
retrieving revision 1.11
retrieving revision 1.11.18.1
diff -C2 -d -r1.11 -r1.11.18.1
*** loopify.sml 12 Sep 2001 20:45:52 -0000 1.11
--- loopify.sml 11 Aug 2006 20:42:24 -0000 1.11.18.1
***************
*** 16,19 ****
--- 16,20 ----
structure S = IntRedBlackSet
structure OU = OptUtils
+ structure LT = Lty
structure LK = LtyKernel
structure CTRL = FLINT_Control
***************
*** 149,155 ****
let val cconv' =
case cconv
! of (F.CC_FCT | F.CC_FUN(LK.FF_FIXED)) => cconv
! | F.CC_FUN(LK.FF_VAR(f1,f2)) =>
! F.CC_FUN(LK.FF_VAR(true,f2))
(* figure out what arguments of the tail loop
--- 150,156 ----
let val cconv' =
case cconv
! of (F.CC_FCT | F.CC_FUN(LT.FF_FIXED)) => cconv
! | F.CC_FUN(LT.FF_VAR(f1,f2)) =>
! F.CC_FUN(LT.FF_VAR(true,f2))
(* figure out what arguments of the tail loop
Index: optutils.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/opt/optutils.sml,v
retrieving revision 1.8
retrieving revision 1.8.26.1
diff -C2 -d -r1.8 -r1.8.26.1
*** optutils.sml 1 Jun 2000 18:33:26 -0000 1.8
--- optutils.sml 11 Aug 2006 20:42:24 -0000 1.8.26.1
***************
*** 31,36 ****
structure OptUtils :> OPT_UTILS =
struct
! local structure F = FLINT
! structure LK = LtyKernel
in
datatype ('a,'b) either = A of 'a | B of 'b
--- 31,40 ----
structure OptUtils :> OPT_UTILS =
struct
! local
!
! structure F = FLINT
! structure LT = Lty
! structure LK = LtyKernel
!
in
datatype ('a,'b) either = A of 'a | B of 'b
***************
*** 41,46 ****
let val cconv' =
case cconv
! of F.CC_FUN(LK.FF_VAR(f1,f2)) => F.CC_FUN(LK.FF_VAR(true, f2))
! | (F.CC_FCT | F.CC_FUN(LK.FF_FIXED)) => cconv
val isrec' = Option.map (fn ltys => (ltys, F.LK_UNKNOWN)) rtys'
in ({isrec=isrec, known=known, cconv=cconv, inline=F.IH_ALWAYS},
--- 45,50 ----
let val cconv' =
case cconv
! of F.CC_FUN(LT.FF_VAR(f1,f2)) => F.CC_FUN(LT.FF_VAR(true, f2))
! | (F.CC_FCT | F.CC_FUN(LT.FF_FIXED)) => cconv
val isrec' = Option.map (fn ltys => (ltys, F.LK_UNKNOWN)) rtys'
in ({isrec=isrec, known=known, cconv=cconv, inline=F.IH_ALWAYS},
-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642