CVS: sml-dist/src/compiler/FLINT/trans translate.sml, 1.33.4.2, 1.33.4.3 transtypes.sml, 1.5, 1.5.10.1
David MacQueen <[email protected]> Mon, 10 Jul 2006 15:27:15 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7775/src/compiler/FLINT/trans
Modified Files:
Tag: primop-branch-2
translate.sml transtypes.sml
Log Message:
further changes to primops, starting on translate.sml
Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.2
retrieving revision 1.33.4.3
diff -C2 -d -r1.33.4.2 -r1.33.4.3
*** translate.sml 7 Jul 2006 21:06:10 -0000 1.33.4.2
--- translate.sml 10 Jul 2006 22:27:13 -0000 1.33.4.3
***************
*** 346,351 ****
end
! (** converting a value of access+info into the lambda expression *)
! fun mkAccInfo (acc, info, getLty, nameOp) =
if extern acc then mkAccT(acc, getLty(), nameOp) else mkAcc (acc, nameOp)
--- 346,353 ----
end
! (** converting a value of access+prim into the lambda expression
! ** [KM???} But it is ignoring the prim argument!!!
! **)
! fun mkAccInfo (acc, prim, getLty, nameOp) =
if extern acc then mkAccT(acc, getLty(), nameOp) else mkAcc (acc, nameOp)
***************
*** 836,839 ****
--- 838,842 ----
* *
***************************************************************************)
+ (* [KM???] mkVar is calling mkAccInfo, which just drops the prim!!! *)
fun mkVar (v as V.VALvar{access, prim, typ, path}, d) =
mkAccInfo(access, prim, fn () => toLty d (!typ), getNameOp path)
***************
*** 877,881 ****
val rep' = mkRep(rep, lt, name)
val dc = (name, rep', lt)
! val ts' = map (toTyc d) ts
in if const then CON'(dc, ts', unitLexp)
else (case apOp
--- 880,884 ----
val rep' = mkRep(rep, lt, name)
val dc = (name, rep', lt)
! val ts' = map (toTyc d o T.VARty) ts
in if const then CON'(dc, ts', unitLexp)
else (case apOp
***************
*** 937,948 ****
val exp' = mkExp(exp, DI.next d)
! fun h ([], []) = ()
! | h (a::r, b::z) = (b := a; h(r, z))
! | h _ = bug "unexpected cases in mkPE"
(* [dbm, 6/22/06] Why do we need to restore the original
! contents of the uninstantiated meta type variables? *)
! val _ = h(savedtvs, boundtvs) (* recover *)
val len = length(boundtvs)
--- 940,954 ----
val exp' = mkExp(exp, DI.next d)
! (* restore tyvar states to that before translate *)
! fun restore ([], []) = ()
! | restore (a::r, b::z) = (b := a; restore(r, z))
! | restore _ = bug "unexpected cases in mkPE"
(* [dbm, 6/22/06] Why do we need to restore the original
! contents of the uninstantiated meta type variables?
! Only seems to be necessary if a given tyvar gets generalized
! in two different valbinds *)
! val _ = restore(savedtvs, boundtvs)
val len = length(boundtvs)
***************
*** 951,963 ****
and mkVBs (vbs, d) =
! let fun eqTvs ([], []) = true
! | eqTvs (a::r, (TP.VARty b)::s) = if (a=b) then eqTvs(r, s) else false
! | eqTvs _ = false
!
! fun g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
! exp as VARexp (ref (w as (V.VALvar _)), instys),
! boundtvs=tvs, ...}, b) =
! if eqTvs(tvs, instys) then LET(v, mkVar(w, d), b)
! else LET(v, mkPE(exp, d, tvs), b)
| g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
--- 957,981 ----
and mkVBs (vbs, d) =
! let fun g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
! exp as VARexp (ref (w as (V.VALvar{typ,prim,...})), instvs),
! boundtvs=btvs, ...}, b) =
! (* [dbm: 7/10/06] Originally, the mkVar and mkPE translations
! * were chosen based on whether btvs and instvs were the same
! * list of tyvars, which would be the case for all non-primop
! * variables, but also in the primop case whenever the rhs
! * variable environment type (!typ) was the same (equalTypeP)
! * to the intrinsic type of the primop (e.g. when they are
! * both monotypes). So in most cases, the mkVar translation
! * will be used, and this drops the primop information!!!
! * This seems definitely wrong. *)
! (case prim
! of PrimOpId.Prim name =>
! let val (primop,primopty) = PrimOpMap name
! in if TU.equalTypeP(!typ,primopty)
! then LET(v, mkVar(w, d), b)
! else LET(v, mkPE(exp, d, btvs), b)
! end
! | _ => LET(v, mkVar(w, d), b)
! (* when generalized variables = instantiation params *)
| g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
***************
*** 982,986 ****
exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =
let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)
! (* we no longer track type bindings at RVB anymore ! *)
val vt = toLty d ty
in (v::vlist, vt::tlist, ee::elist)
--- 1000,1004 ----
exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =
let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)
! (* [ZHONG?]we no longer track type bindings at RVB anymore ! *)
val vt = toLty d ty
in (v::vlist, vt::tlist, ee::elist)
***************
*** 1128,1132 ****
fun mkRules xs = map (fn (RULE(p, e)) => (fillPat(p, d), g e)) xs
! and g (VARexp (ref v, ts)) = mkVE(v, ts, d)
| g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)
--- 1146,1151 ----
fun mkRules xs = map (fn (RULE(p, e)) => (fillPat(p, d), g e)) xs
! and g (VARexp (ref v, ts)) =
! mkVE(v, map T.VARty ts, d)
| g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)
***************
*** 1183,1187 ****
| g (PACKexp(e, ty, tycs)) = g e
! (*
let val (nty, ks, tps) = TU.reformat(ty, tycs, d)
val ts = map (tpsTyc d) tps
--- 1202,1209 ----
| g (PACKexp(e, ty, tycs)) = g e
! (* [dbm, 7/10/06]: Does PACKexp do anything now? What was it doing before
! * this was commented out? This appears to be the only place reformat was called
! * Is it also the only place the FLINT PACK constructor is used? [KM???] *)
! (* (by who, when why?)
let val (nty, ks, tps) = TU.reformat(ty, tycs, d)
val ts = map (tpsTyc d) tps
Index: transtypes.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/transtypes.sml,v
retrieving revision 1.5
retrieving revision 1.5.10.1
diff -C2 -d -r1.5 -r1.5.10.1
*** transtypes.sml 13 Aug 2003 18:04:07 -0000 1.5
--- transtypes.sml 10 Jul 2006 22:27:13 -0000 1.5.10.1
***************
*** 263,273 ****
and h (INSTANTIATED t) = g t
! | h (TV_MARK m) = let
! val (depth, num) = findLBOUND m
! in
! LT.tcc_var(DI.calc(d, depth), num)
! end
| h (OPEN _) = LT.tcc_void
! | h _ = LT.tcc_void (* ZHONG? *)
and g (VARty tv) = (* h(!tv) *) lookTv tv
--- 263,276 ----
and h (INSTANTIATED t) = g t
! | h (TV_MARK m) =
! let val (depth, num) = findLBOUND m
! in
! LT.tcc_var(DI.calc(d, depth), num)
! end
! | h (UBOUND _) = LT.tcc_void
! (* dbm: should this have been converted to a TV_MARK before
! * being passed to toTyc? *)
| h (OPEN _) = LT.tcc_void
! | h _ = bug "toTyc:h" (* LITERAL and SCHEME should not occur *)
and g (VARty tv) = (* h(!tv) *) lookTv tv
-------------------------------------------------------------------------
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