CVS: sml-dist/src/compiler/FLINT/kernel lty.sml, 1.1.2.6, 1.1.2.7 ltykernel.sml, 1.18.12.16, 1.18.12.17
George Kuan <[email protected]> Thu, 17 Aug 2006 14:55:54 -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-serv26746/src/compiler/FLINT/kernel
Modified Files:
Tag: primop-branch-2
lty.sml ltykernel.sml
Log Message:
tycEnv representation change propagated through ltykernel.sml
Index: lty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sml,v
retrieving revision 1.1.2.6
retrieving revision 1.1.2.7
diff -C2 -d -r1.1.2.6 -r1.1.2.7
*** lty.sml 17 Aug 2006 21:08:37 -0000 1.1.2.6
--- lty.sml 17 Aug 2006 21:55:48 -0000 1.1.2.7
***************
*** 497,501 ****
created when pushing a closure (Env) through a lambda (r10);
j: the nesting level of the closure just before r10 is applied,
! i.e. the nesteing level of the abstraction relative to the
point where the closure was originally created;
ks: the kinds of the abstraction parameters *)
--- 497,501 ----
created when pushing a closure (Env) through a lambda (r10);
j: the nesting level of the closure just before r10 is applied,
! i.e. the nesting level of the abstraction relative to the
point where the closure was originally created;
ks: the kinds of the abstraction parameters *)
Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.16
retrieving revision 1.18.12.17
diff -C2 -d -r1.18.12.16 -r1.18.12.17
*** ltykernel.sml 15 Aug 2006 23:01:32 -0000 1.18.12.16
--- ltykernel.sml 17 Aug 2006 21:55:48 -0000 1.18.12.17
***************
*** 65,78 ****
fun tcc_env(x, ol, nl, tenv) =
(let fun checkTCVAR tyc = case (tc_outX tyc) of
! TC_VAR(i,j) => (case tcLookup(i,tenv)
! of (SOME ts, _) => if j >= length ts
! then (print "tcc_env TC_VAR ";
! print (Int.toString j);
! print " ts length ";
! print (Int.toString (length ts));
! raise Fail "Bad TC_ENV TC_VAR")
! else ()
| _ => ())
! | TC_ENV(tc, _, _, _) => (print "TC_ENV("; checkTCVAR(tc); print ")\n")
| _ => () (* print ("tcc_env OTHER " ^ tci_print tci ^"\n") *)
in checkTCVAR(x);
--- 65,83 ----
fun tcc_env(x, ol, nl, tenv) =
(let fun checkTCVAR tyc = case (tc_outX tyc) of
! TC_VAR(i,j) => (case teLookup(tenv, i)
! of SOME(Beta(j, tcs, _)) =>
! if j >= length tcs
! then (print "tcc_env TC_VAR ";
! print (Int.toString j);
! print "B tcs length ";
! print (Int.toString (length tcs));
! raise Fail "Bad TC_ENV TC_VAR")
! else ()
! | SOME(Lamb(j)) =>
! print "TC_VAR referencing LAMB"
| _ => ())
! | TC_ENV(tc, _, _, _) => (print "TC_ENV(";
! checkTCVAR(tc);
! print ")\n")
| _ => () (* print ("tcc_env OTHER " ^ tci_print tci ^"\n") *)
in checkTCVAR(x);
***************
*** 260,277 ****
in (case tc_outX x
of TC_VAR (n,k) =>
! if (n <= ol) then (* i is bound in tenv *)
! (case lookupTycEnv(tenv, i)
! of (NONE, nl') => tcc_var(nl - nl', k) (* rule r5 *)
! | (SOME ts, n) =>
let val y = List.nth(ts, k)
handle Subscript =>
(with_pp(fn s =>
! let val {break,newline,openHVBox,openHOVBox,closeBox,
! pps, ppi} = PU.en_pp s
in openHVBox 0;
pps "***Debugging***"; newline();
! pps "tc_lzrd arg: "; PPLty.ppTyc (!dp) s t; newline();
! pps "n = "; ppi n; pps ", k = "; ppi k; newline();
! pps "length(ts) = : "; ppi (length ts); newline();
pps "ts elements: "; break{nsp=2,offset=2};
openHOVBox 2;
--- 265,286 ----
in (case tc_outX x
of TC_VAR (n,k) =>
! if (n <= ol) then (* n is bound in tenv *)
! (case teLookup(tenv, n)
! of SOME(Lamb(nl', _)) =>
! tcc_var(nl - nl', k) (* rule r5 *)
! | SOME(Beta(nl', ts, _)) =>
let val y = List.nth(ts, k)
handle Subscript =>
(with_pp(fn s =>
! let val {break,newline,openHVBox,openHOVBox,
! closeBox, pps, ppi} = PU.en_pp s
in openHVBox 0;
pps "***Debugging***"; newline();
! pps "tc_lzrd arg: "; PPLty.ppTyc (!dp) s t;
! newline();
! pps "n = "; ppi n; pps ", k = "; ppi k;
! newline();
! pps "length(ts) = : "; ppi (length ts);
! newline();
pps "ts elements: "; break{nsp=2,offset=2};
openHOVBox 2;
***************
*** 282,292 ****
end);
raise tcUnbound2)
! in h(y, 0, nl - nl', emptyTycEnv) (* rule r6 *)
! end)
else tcc_var(n-ol+nl, k) (* rule r4 *)
| TC_NVAR _ => x
| TC_PRIM _ => x (* rule r7 *)
| TC_FN (ks, tc) =>
! let val tenv' = tcInsert(tenv, (NONE, nl))
in tcc_fn(ks,
tcc_env(tc, ol+1, nl+1, tenv')
--- 291,305 ----
end);
raise tcUnbound2)
! in h(y, 0, nl - nl', teEmpty) (* rule r6 *)
! end
! (* Could not find TV(n,_) in tenv
! and ol = length tenv invariant
! failed! *)
! | NONE => raise tcUnbound)
else tcc_var(n-ol+nl, k) (* rule r4 *)
| TC_NVAR _ => x
| TC_PRIM _ => x (* rule r7 *)
| TC_FN (ks, tc) =>
! let val tenv' = teCons(Lamb(nl, ks), tenv)
in tcc_fn(ks,
tcc_env(tc, ol+1, nl+1, tenv')
***************
*** 334,338 ****
| LT_FCT (ts1, ts2) => ltc_fct(map prop ts1, map prop ts2)
| LT_POLY (ks, ts) =>
! let val tenv' = tcInsert(tenv, (NONE, nl))
in ltc_poly(ks,
map (fn t => ltc_env(t, ol+1, nl+1, tenv')) ts)
--- 347,351 ----
| LT_FCT (ts1, ts2) => ltc_fct(map prop ts1, map prop ts2)
| LT_POLY (ks, ts) =>
! let val tenv' = teCons(Lamb (nl, ks), tenv)
in ltc_poly(ks,
map (fn t => ltc_env(t, ol+1, nl+1, tenv')) ts)
***************
*** 392,413 ****
of TC_APP(tc, tcs) =>
((* print "\ntc_whnm: TC_APP\n"; *)
! (let val tc' = tc_whnm tc handle Fail _ => raise Fail "TC_APP in tc_whnm 1"
in case (tc_outX tc')
of TC_FN(ks, b) =>
let fun base () =
! (b, 1, 0, tcInsert(initTycEnv,(SOME tcs, 0)))
val sp =
(case tc_outX b
of TC_ENV(b', ol', nl', te') =>
! (case splitTycEnv te'
! of SOME((NONE, n), te) =>
! if (n = nl'-1) andalso (ol' > 0)
! then (b', ol', n,
! tcInsert(te, (SOME tcs, n)))
! else base()
| _ => base())
| _ => base())
val res = tc_whnm(tcc_env sp)
! handle Fail _ => raise Fail "TC_APP in tc_whnm 2"
in tyc_upd(nt, res); res
end
--- 405,431 ----
of TC_APP(tc, tcs) =>
((* print "\ntc_whnm: TC_APP\n"; *)
! (let val tc' = tc_whnm tc
! handle Fail _ => raise Fail "TC_APP in tc_whnm 1"
in case (tc_outX tc')
of TC_FN(ks, b) =>
let fun base () =
! (b, 1, 0, teCons(Beta(0, tcs, ks), teEmpty))
val sp =
(case tc_outX b
of TC_ENV(b', ol', nl', te') =>
! (case teDest te'
! of SOME(Lamb(n, ks'), te) =>
! if (n = nl'-1) andalso (ol' > 0)
! then (b', ol', n,
! teCons(Beta(n, tcs, ks),
! te))
! (* Which ks correspond to
! this Beta? *)
! else base()
| _ => base())
| _ => base())
val res = tc_whnm(tcc_env sp)
! handle Fail _ =>
! raise Fail "TC_APP in tc_whnm 2"
in tyc_upd(nt, res); res
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