CVS: sml-dist/src/compiler/FLINT/kernel lty.sml, 1.1.2.13, 1.1.2.14 ltykernel.sml, 1.18.12.18, 1.18.12.19
George Kuan <[email protected]> Mon, 21 Aug 2006 13:38:39 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv23398/src/compiler/FLINT/kernel
Modified Files:
Tag: primop-branch-2
lty.sml ltykernel.sml
Log Message:
fixed TC_IND/normalized AX_FLAG bug
Index: lty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sml,v
retrieving revision 1.1.2.13
retrieving revision 1.1.2.14
diff -C2 -d -r1.1.2.13 -r1.1.2.14
*** lty.sml 18 Aug 2006 23:43:02 -0000 1.1.2.13
--- lty.sml 21 Aug 2006 20:38:36 -0000 1.1.2.14
***************
*** 455,462 ****
(** checking if a tyc or an lty is in the normal form *)
! fun tcp_norm ((ref(_, _, AX_REG(b,_,_))) : tyc) = b
! | tcp_norm _ = false
! fun ltp_norm ((ref(_, _, AX_REG(b,_,_))) : lty) = b
| ltp_norm _ = false
--- 455,466 ----
(** checking if a tyc or an lty is in the normal form *)
! fun tcp_norm ((ref(_, TC_IND _, AX_REG(true,_,_))) : tyc) = bug "TC_IND is norm?!"
! | tcp_norm ((ref(_, _, AX_REG(b,_,_))) : tyc) = b
! | tcp_norm _ = false
! fun ltp_norm ((ref(_, LT_TYC (ref (_,TC_IND _, _)), AX_REG(true,_,_))) : lty) =
! bug "LT_TYC (TC_IND ) is norm?!"
! | ltp_norm ((ref(_, LT_IND _, AX_REG(true,_,_))) : lty) = bug "LT_IND is norm?!"
! | ltp_norm ((ref(_, _, AX_REG(b,_,_))) : lty) = b
| ltp_norm _ = false
***************
*** 604,610 ****
(** testing the "pointer" equality on normalized tkind, tyc, and lty *)
fun tk_eq (x: tkind, y) = (x = y)
- fun tc_eq (x: tyc, y) = (x = y)
- fun lt_eq (x: lty, y) = (x = y)
(** utility functions for updating tycs and ltys *)
--- 608,683 ----
(** testing the "pointer" equality on normalized tkind, tyc, and lty *)
fun tk_eq (x: tkind, y) = (x = y)
+ local
+ fun stripIND tyc =
+ (case tc_outX tyc
+ of (TC_IND(new,_)) => stripIND new
+ | _ => tyc)
+ fun verify(ref(_, TC_IND _, AX_REG(true,_,_))) = bug "TC_IND is norm?!"
+ | verify _ = ()
+ in
+ fun tc_eq (x: tyc, y) = (verify x; verify y; x = y)
+ end
+
+ local
+ fun verify(ref(_, LT_IND _, AX_REG(true,_,_))) = bug "LT_IND is norm?!"
+ | verify(ref(_, LT_TYC(ref(_,TC_IND _,_)), AX_REG(true,_,_))) = bug "LT_TYC (TC_IND) is norm?!"
+ | verify(ref(_, _, AX_REG(true, _, _))) = ()
+ | verify(ref(_, _, AX_REG(false, _, _))) = bug "Non-normalized (AX_REG false).\n"
+ | verify(ref(_, _, AX_NO)) = bug "Non-normalized (AX_NO)\n"
+ in
+ fun lt_eq (x: lty, y) =
+ (verify x; verify y;
+ if not (x = y) then
+ ((case (lt_outX x, lt_outX y)
+ of (LT_TYC tyc1, LT_TYC tyc2) =>
+ (x = y)
+ | _ => x = y))
+ else (x = y) )
+ end (*
+ (case (tc_outX tyc1, tc_outX tyc2)
+ of (TC_PRIM pt1, TC_PRIM pt2) =>
+ print "PRIM\n"
+ | (TC_FN _, _) =>
+ print "FN\n"
+ | (TC_FIX _, _) => print "FIX\n"
+ | (TC_VAR _, _) => print "VAR\n"
+ | (TC_NVAR _, _) => print "NVAR\n"
+ | (TC_APP _, _) => print "APP\n"
+ | (TC_SEQ _, _) => print "SEQ\n" | (TC_PROJ _, _) => print "PROJ\n"
+ | (TC_SUM _, _) => print "SUM\n"
+ | (TC_TUPLE _, _) => print "TUPLE\n"
+ | (TC_ARROW _, _) => print "ARROW\n"
+ | (TC_PARROW _, _) => print "PARROW\n"
+ | (TC_BOX _, _) => print "BOX\n"
+ | (TC_ABS _, _) => print "ABS\n"
+ | (TC_TOKEN _, _) => print "TOKEN\n"
+ | (TC_CONT _, _) => print "CONT\n"
+ | (TC_IND _, _) => print "IND\n"
+ | (TC_ENV _, _) => print "ENV\n"
+ | (TC_PRIM _, tyc2') =>
+ (print "unmatched PRIM\n";
+ case tyc2'
+ of (TC_FN _) =>
+ print "FN\n"
+ | (TC_FIX _) => print "FIX\n"
+ | (TC_VAR _) => print "VAR\n"
+ | (TC_NVAR _) => print "NVAR\n"
+ | (TC_APP _) => print "APP\n"
+ | (TC_SEQ _) => print "SEQ\n"
+ | (TC_PROJ _) => print "PROJ\n"
+ | (TC_SUM _) => print "SUM\n"
+ | (TC_TUPLE _) => print "TUPLE\n"
+ | (TC_ARROW _) => print "ARROW\n"
+ | (TC_PARROW _) => print "PARROW\n"
+ | (TC_BOX _) => print "BOX\n"
+ | (TC_ABS _) => print "ABS\n"
+ | (TC_TOKEN _) => print "TOKEN\n"
+ | (TC_CONT _) => print "CONT\n"
+ | (TC_IND _) => print "IND\n"
+ | (TC_ENV _) => print "ENV\n"
+ | (TC_PRIM _) => print "PRIM\n")
+ )); x = y)
+ else (x = y) *)
(** utility functions for updating tycs and ltys *)
Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.18
retrieving revision 1.18.12.19
diff -C2 -d -r1.18.12.18 -r1.18.12.19
*** ltykernel.sml 17 Aug 2006 23:13:14 -0000 1.18.12.18
--- ltykernel.sml 21 Aug 2006 20:38:36 -0000 1.18.12.19
***************
*** 869,876 ****
fun lt_eqv(x : lty, y) =
let val seq = lt_eqv_gen (lt_eqv, tc_eqv)
! in if ((ltp_norm x) andalso (ltp_norm y)) then lt_eq(x,y)
else (let val t1 = lt_whnm x
val t2 = lt_whnm y
! in if (ltp_norm t1) andalso (ltp_norm t2) then lt_eq(x, y)
else seq(t1, t2)
end)
--- 869,876 ----
fun lt_eqv(x : lty, y) =
let val seq = lt_eqv_gen (lt_eqv, tc_eqv)
! in if ((ltp_norm x) andalso (ltp_norm y)) then (if not (lt_eq(x,y)) then (print "norm first\n"; lt_eq(x,y)) else true)
else (let val t1 = lt_whnm x
val t2 = lt_whnm y
! in if (ltp_norm t1) andalso (ltp_norm t2) then lt_eq(t1, t2)
else seq(t1, t2)
end)
-------------------------------------------------------------------------
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