CVS: sml-dist/src/compiler/FLINT/cpsopt contract.sml,1.14,1.15 eta.sml,1.5,1.6 etasplit.sml,1.5,1.6 expand.sml,1.6,1.7 flatten.sml,1.5,1.6 infcnv.sml,1.2,1.3 uncurry.sml,1.5,1.6
Matthias Blume <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18358/src/compiler/FLINT/cpsopt
Modified Files:
contract.sml eta.sml etasplit.sml expand.sml flatten.sml
infcnv.sml uncurry.sml
Log Message:
long long results implemented
Index: contract.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/contract.sml,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** contract.sml 28 Aug 2003 21:59:06 -0000 1.14
--- contract.sml 10 Feb 2005 23:54:05 -0000 1.15
***************
*** 131,134 ****
--- 131,137 ----
| samefields _ = false
fun samewith p = equ (p::pairs)
+ fun samewith' args =
+ equ (ListPair.foldr (fn ((w, _), (w', _), l) => (w,w')::l)
+ pairs args)
fun all2 f (e::r,e'::r') = f(e,e') andalso all2 f (r,r')
| all2 f (nil,nil) = true
***************
*** 159,167 ****
| (PURE(i,vl,w,_,e),PURE(i',vl',w',_,e')) =>
i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')
! | (RCC(k,l,p,vl,w,_,e),RCC(k',l',p',vl',w',_,e')) =>
(* We don't need to compare protocol info: The protocols are
* the same iff the functions and arguments are the same. *)
k = k' andalso l = l' andalso
! all2 same (vl,vl') andalso samewith(w,w')(e,e')
| _ => false
in sameexp
--- 162,170 ----
| (PURE(i,vl,w,_,e),PURE(i',vl',w',_,e')) =>
i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')
! | (RCC(k,l,p,vl,wtl,e),RCC(k',l',p',vl',wtl',e')) =>
(* We don't need to compare protocol info: The protocols are
* the same iff the functions and arguments are the same. *)
k = k' andalso l = l' andalso
! all2 same (vl,vl') andalso samewith'(wtl,wtl')(e,e')
| _ => false
in sameexp
***************
*** 407,411 ****
| PURE(p as P.funwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)
| PURE(i,vl,w,_,e) => (app use vl; enterMISC0 w; g1 e)
! | RCC(k,l,p,vl,w,t,e) => (app use vl; enterMISC0 w; g1 e)
in g1
end
--- 410,414 ----
| PURE(p as P.funwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)
| PURE(i,vl,w,_,e) => (app use vl; enterMISC0 w; g1 e)
! | RCC(k,l,p,vl,wtl,e) => (app use vl; app (enterMISC0 o #1) wtl; g1 e)
in g1
end
***************
*** 460,464 ****
| drop_body(ARITH(_,vl,_,_,e)) = (app use_less vl; drop_body e)
| drop_body(PURE(_,vl,_,_,e)) = (app use_less vl; drop_body e)
! | drop_body(RCC(_,_,_,vl,_,_,e)) = (app use_less vl; drop_body e)
end (* local *)
--- 463,467 ----
| drop_body(ARITH(_,vl,_,_,e)) = (app use_less vl; drop_body e)
| drop_body(PURE(_,vl,_,_,e)) = (app use_less vl; drop_body e)
! | drop_body(RCC(_,_,_,vl,_,e)) = (app use_less vl; drop_body e)
end (* local *)
***************
*** 982,988 ****
end)
end
! | RCC(k,l,p,vl,w,t,e) =>
(* leave raw C calls alone *)
! RCC (k, l, p, map ren vl, w, t, g' e)
| BRANCH(i,vl,c,e1,e2) =>
let val vl' = map ren vl
--- 985,991 ----
end)
end
! | RCC(k,l,p,vl,wtl,e) =>
(* leave raw C calls alone *)
! RCC (k, l, p, map ren vl, wtl, g' e)
| BRANCH(i,vl,c,e1,e2) =>
let val vl' = map ren vl
Index: eta.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/eta.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** eta.sml 23 Mar 2002 21:14:39 -0000 1.5
--- eta.sml 10 Feb 2005 23:54:05 -0000 1.6
***************
*** 145,149 ****
| PURE(i,vl,w,t,e) => PURE(i,map rename vl, w, t, pass2 e)
| SETTER(i,vl,e) => SETTER(i,map rename vl, pass2 e)
! | RCC(k,l,p,vl,w,t,e) => RCC (k, l, p, map rename vl, w, t, pass2 e)
| FIX(l,e) =>
FIX(map (fn (fk,f,vl,cl,body) => (fk,f,vl,cl,pass2 body)) l,
--- 145,149 ----
| PURE(i,vl,w,t,e) => PURE(i,map rename vl, w, t, pass2 e)
| SETTER(i,vl,e) => SETTER(i,map rename vl, pass2 e)
! | RCC(k,l,p,vl,wtl,e) => RCC (k, l, p, map rename vl, wtl, pass2 e)
| FIX(l,e) =>
FIX(map (fn (fk,f,vl,cl,body) => (fk,f,vl,cl,pass2 body)) l,
***************
*** 165,170 ****
(addvt(w, t); PURE(i,map rename vl, w, t, reduce e))
| SETTER(i,vl,e) => SETTER(i,map rename vl, reduce e)
! | RCC (k,l,p,vl,w,t,e) =>
! (addvt(w,t); RCC (k, l, p, map rename vl, w, t, reduce e))
| FIX(l,e) =>
let val _ = app addft l
--- 165,170 ----
(addvt(w, t); PURE(i,map rename vl, w, t, reduce e))
| SETTER(i,vl,e) => SETTER(i,map rename vl, reduce e)
! | RCC (k,l,p,vl,wtl,e) =>
! (app addvt wtl; RCC (k, l, p, map rename vl, wtl, reduce e))
| FIX(l,e) =>
let val _ = app addft l
Index: etasplit.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/etasplit.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** etasplit.sml 23 Mar 2002 21:14:39 -0000 1.5
--- etasplit.sml 10 Feb 2005 23:54:05 -0000 1.6
***************
*** 101,105 ****
| ARITH(_,vl,_,_,e) => (app use vl; pass1 e)
| PURE(_,vl,_,_,e) => (app use vl; pass1 e)
! | RCC(_,_,_,vl,_,_,e) => (app use vl; pass1 e)
| APP(f, vl) => (call f; app use vl)
| FIX(l, e) =>
--- 101,105 ----
| ARITH(_,vl,_,_,e) => (app use vl; pass1 e)
| PURE(_,vl,_,_,e) => (app use vl; pass1 e)
! | RCC(_,_,_,vl,_,e) => (app use vl; pass1 e)
| APP(f, vl) => (call f; app use vl)
| FIX(l, e) =>
***************
*** 130,134 ****
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, reduce e)
| SETTER(i,vl,e) => SETTER(i, vl, reduce e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k, l, p, vl, w, t, reduce e)
| (e as APP(f,vl)) =>
(case alias f
--- 130,134 ----
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, reduce e)
| SETTER(i,vl,e) => SETTER(i, vl, reduce e)
! | RCC(k,l,p,vl,wtl,e) => RCC(k, l, p, vl, wtl, reduce e)
| (e as APP(f,vl)) =>
(case alias f
Index: expand.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/expand.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** expand.sml 22 May 2003 22:46:27 -0000 1.6
--- expand.sml 10 Feb 2005 23:54:05 -0000 1.7
***************
*** 261,265 ****
(notereal w; prim(level,vl,e))
| PURE(_,vl,w,_,e) => (noteother w; prim(level,vl,e))
! | RCC(k,l,p,vl,w,t,e) => (noteother w; prim(level,vl,e)) (* ? *)
--- 261,266 ----
(notereal w; prim(level,vl,e))
| PURE(_,vl,w,_,e) => (noteother w; prim(level,vl,e))
! | RCC(k,l,p,vl,wtl,e) =>
! (app (noteother o #1) wtl; prim(level,vl,e)) (* ? *)
***************
*** 312,316 ****
| PURE(i,vl,w,t,e) => PURE(i, map use vl, def w, t, g e)
| SETTER(i,vl,e) => SETTER(i, map use vl, g e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k, l, p, map use vl, def w, t, g e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i, map use vl, def c, g e1, g e2)
--- 313,318 ----
| PURE(i,vl,w,t,e) => PURE(i, map use vl, def w, t, g e)
| SETTER(i,vl,e) => SETTER(i, map use vl, g e)
! | RCC(k,l,p,vl,wtl,e) =>
! RCC(k, l, p, map use vl, map (fn (w, t) => (def w, t)) wtl, g e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i, map use vl, def c, g e1, g e2)
***************
*** 482,486 ****
PURE(_,_,_,_,e) |
SETTER(_,_,e) |
! RCC(_,_,_,_,_,_,e)) => pass2(d+2,u,e)
| BRANCH(i,vl,c,e1,e2) => (pass2(d+2,u,e1);
pass2(d+2,u,e2))
--- 484,488 ----
PURE(_,_,_,_,e) |
SETTER(_,_,e) |
! RCC(_,_,_,_,_,e)) => pass2(d+2,u,e)
| BRANCH(i,vl,c,e1,e2) => (pass2(d+2,u,e1);
pass2(d+2,u,e2))
***************
*** 527,531 ****
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, gamma e)
| SETTER(i,vl,e) => SETTER(i, vl, gamma e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k, l, p, vl, w, t, gamma e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i, vl, c,gamma e1, gamma e2)
--- 529,533 ----
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, gamma e)
| SETTER(i,vl,e) => SETTER(i, vl, gamma e)
! | RCC(k,l,p,vl,wtl,e) => RCC(k, l, p, vl, wtl, gamma e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i, vl, c,gamma e1, gamma e2)
***************
*** 556,560 ****
| PURE(i,vl,w,t,e) => PURE(i,vl,w,t,beta e)
| SETTER(i,vl,e) => SETTER(i,vl,beta e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k,l,p,vl,w,t,beta e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c,beta e1,beta e2)
--- 558,562 ----
| PURE(i,vl,w,t,e) => PURE(i,vl,w,t,beta e)
| SETTER(i,vl,e) => SETTER(i,vl,beta e)
! | RCC(k,l,p,vl,wtl,e) => RCC(k,l,p,vl,wtl,beta e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c,beta e1,beta e2)
Index: flatten.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/flatten.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** flatten.sml 23 Mar 2002 21:14:39 -0000 1.5
--- flatten.sml 10 Feb 2005 23:54:05 -0000 1.6
***************
*** 157,161 ****
| f(ARITH(_,_,_,_,e)) = f e
| f(PURE(_,_,_,_,e)) = f e
! | f(RCC(_,_,_,_,_,_,e)) = f e
| f(SWITCH(_,_,el)) = not(List.exists (not o findFetch(v,k)) el)
| f _ = false
--- 157,161 ----
| f(ARITH(_,_,_,_,e)) = f e
| f(PURE(_,_,_,_,e)) = f e
! | f(RCC(_,_,_,_,_,e)) = f e
| f(SWITCH(_,_,el)) = not(List.exists (not o findFetch(v,k)) el)
| f _ = false
***************
*** 206,210 ****
| ARITH(i,vl,w,_,e) => (app escape vl; pass1 e)
| PURE(i,vl,w,_,e) => (app escape vl; pass1 e)
! | RCC(_,_,_,vl,w,_,e) => (app escape vl; pass1 e)
| APP(VAR f, vl) =>
let fun loop (t::r,vl0 as (VAR v)::vl,n) =
--- 206,210 ----
| ARITH(i,vl,w,_,e) => (app escape vl; pass1 e)
| PURE(i,vl,w,_,e) => (app escape vl; pass1 e)
! | RCC(_,_,_,vl,wtl,e) => (app escape vl; pass1 e)
| APP(VAR f, vl) =>
let fun loop (t::r,vl0 as (VAR v)::vl,n) =
***************
*** 244,248 ****
| ARITH(i,vl,w,t,e) => ARITH(i,vl,w,t,reduce e)
| PURE(i,vl,w,t,e) => PURE(i,vl,w,t,reduce e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k,l,p,vl,w,t,reduce e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c,reduce e1,reduce e2)
| APP(f as VAR fv, vl) =>
--- 244,248 ----
| ARITH(i,vl,w,t,e) => ARITH(i,vl,w,t,reduce e)
| PURE(i,vl,w,t,e) => PURE(i,vl,w,t,reduce e)
! | RCC(k,l,p,vl,wtl,e) => RCC(k,l,p,vl,wtl,reduce e)
| BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c,reduce e1,reduce e2)
| APP(f as VAR fv, vl) =>
Index: infcnv.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/infcnv.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** infcnv.sml 28 Aug 2003 21:59:07 -0000 1.2
--- infcnv.sml 10 Feb 2005 23:54:05 -0000 1.3
***************
*** 100,105 ****
| cexp (C.PURE (p, xl, v, t, e)) =
C.PURE (p, xl, v, t, cexp e)
! | cexp (C.RCC (k, s, p, xl, v, t, e)) =
! C.RCC (k, s, p, xl, v, t, cexp e)
and function (fk, f, vl, tl, e) = (fk, f, vl, tl, cexp e)
--- 100,105 ----
| cexp (C.PURE (p, xl, v, t, e)) =
C.PURE (p, xl, v, t, cexp e)
! | cexp (C.RCC (k, s, p, xl, vtl, e)) =
! C.RCC (k, s, p, xl, vtl, cexp e)
and function (fk, f, vl, tl, e) = (fk, f, vl, tl, cexp e)
Index: uncurry.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cpsopt/uncurry.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** uncurry.sml 23 Mar 2002 21:14:39 -0000 1.5
--- uncurry.sml 10 Feb 2005 23:54:05 -0000 1.6
***************
*** 33,37 ****
ARITH(_,vl,_,_,e) |
PURE(_,vl,_,_,e) |
! RCC(_,_,_,vl,_,_,e)) => any vl orelse g e
| BRANCH(_,vl,c,e1,e2) => any vl orelse g e1 orelse g e2
| FIX(fl, e) => List.exists (g o #5) fl orelse g e
--- 33,37 ----
ARITH(_,vl,_,_,e) |
PURE(_,vl,_,_,e) |
! RCC(_,_,_,vl,_,e)) => any vl orelse g e
| BRANCH(_,vl,c,e1,e2) => any vl orelse g e1 orelse g e2
| FIX(fl, e) => List.exists (g o #5) fl orelse g e
***************
*** 104,108 ****
| ARITH(i,vl,w,t,e) => ARITH(i, vl, w, t, reduce e)
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, reduce e)
! | RCC(k,l,p,vl,w,t,e) => RCC(k, l, p, vl, w, t, reduce e)
| SETTER(i,vl,e) => SETTER(i, vl, reduce e)
| FIX(l,e) =>
--- 104,108 ----
| ARITH(i,vl,w,t,e) => ARITH(i, vl, w, t, reduce e)
| PURE(i,vl,w,t,e) => PURE(i, vl, w, t, reduce e)
! | RCC(k,l,p,vl,wtl,e) => RCC(k, l, p, vl, wtl, reduce e)
| SETTER(i,vl,e) => SETTER(i, vl, reduce e)
| FIX(l,e) =>
-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click