CVS: sml-dist/src/compiler/FLINT/trans translate.sml, 1.33.4.21, 1.33.4.22
David MacQueen <[email protected]> Wed, 23 Aug 2006 16:44:20 -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-serv811/src/compiler/FLINT/trans
Modified Files:
Tag: primop-branch-2
translate.sml
Log Message:
debugging kind check error
Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.21
retrieving revision 1.33.4.22
diff -C2 -d -r1.33.4.21 -r1.33.4.22
*** translate.sml 22 Aug 2006 22:54:10 -0000 1.33.4.21
--- translate.sml 23 Aug 2006 23:44:17 -0000 1.33.4.22
***************
*** 49,53 ****
****************************************************************************)
! val debugging = ref true
fun bug msg = EM.impossible("Translate: " ^ msg)
val say = Control.Print.say
--- 49,53 ----
****************************************************************************)
! val debugging = ref false
fun bug msg = EM.impossible("Translate: " ^ msg)
val say = Control.Print.say
***************
*** 117,121 ****
fun mkv () = mkvN NONE
! val kindCh = LT.tkTycGen ()
(** generate the set of ML-to-FLINT type translation functions *)
--- 117,121 ----
fun mkv () = mkvN NONE
! val kindCh = LtyKindChk.tcKindCheckGen ()
(** generate the set of ML-to-FLINT type translation functions *)
***************
*** 400,409 ****
| fill (VECTORpat(pats,ty)) = VECTORpat(map fill pats, ty)
| fill (ORpat(p1, p2)) = ORpat(fill p1, fill p2)
! | fill (CONpat(TP.DATACON{name, const, typ, rep, sign, lazyp}, ts)) =
CONpat(TP.DATACON{name=name, const=const, typ=typ, lazyp=lazyp,
! sign=sign, rep=mkRep(rep, toDconLty d typ, name)}, ts)
! | fill (APPpat(TP.DATACON{name, const, typ, rep, sign, lazyp}, ts, pat)) =
! APPpat(TP.DATACON{name=name, const=const, typ=typ, sign=sign, lazyp=lazyp,
! rep=mkRep(rep, toDconLty d typ, name)}, ts, fill pat)
| fill xp = xp
--- 400,412 ----
| fill (VECTORpat(pats,ty)) = VECTORpat(map fill pats, ty)
| fill (ORpat(p1, p2)) = ORpat(fill p1, fill p2)
! | fill (CONpat(TP.DATACON{name,const,typ,rep,sign,lazyp}, ts)) =
CONpat(TP.DATACON{name=name, const=const, typ=typ, lazyp=lazyp,
! sign=sign,rep=mkRep(rep,toDconLty d typ,name)},
! ts)
! | fill (APPpat(TP.DATACON{name,const,typ,rep,sign,lazyp}, ts, pat)) =
! APPpat(TP.DATACON{name=name, const=const, typ=typ,
! sign=sign, lazyp=lazyp,
! rep=mkRep(rep, toDconLty d typ, name)},
! ts, fill pat)
| fill xp = xp
***************
*** 866,869 ****
--- 869,873 ----
case ts
of [] => !typ
+ (* ASSERT: !typ is not a POLYty *)
| _ => TU.applyPoly(!typ, ts)
val (primop,intrinsicType) =
***************
*** 874,901 ****
val intrinsicParams =
(* compute intrinsic instantiation params of intrinsicType *)
! case ((TU.matchInstTypes(occty, intrinsicType)) : (TP.tyvar list * TP.tyvar list) option )
of SOME(_, tvs) =>
! ((*print ("tvs length "^ (Int.toString (length tvs)) ^"\n");
! complain EM.WARN "mkVE ->matchInstTypes -> pruneTyvar " (fn ppstrm => PPVal.ppDebugVar (fn x => "") ppstrm env e);
! if (length tvs) = 1 then complain EM.WARN "mkVE ->matchInstTypes -> pruneTyvar " (fn ppstrm => PPType.ppType env ppstrm (TP.VARty (hd tvs))) else ();
! *)map TU.pruneTyvar tvs)
! | NONE => (complain EM.COMPLAIN "matchInstTypes"
! (fn ppstrm =>
! (PP.newline ppstrm;
! PP.string ppstrm "VALvar: ";
! PPVal.ppVar ppstrm e;
! PP.newline ppstrm;
! PP.string ppstrm "occtypes: ";
! PPType.ppType env ppstrm occty;
! PP.newline ppstrm;
! PP.string ppstrm "intrinsicType: ";
! PPType.ppType env ppstrm intrinsicType;
! PP.newline ppstrm;
! PP.string ppstrm "instpoly occ: ";
! PPType.ppType env ppstrm (#1 (TU.instantiatePoly occty));
! PP.newline ppstrm;
! PP.string ppstrm "instpoly intrinsicType: ";
! PPType.ppType env ppstrm (#1 (TU.instantiatePoly intrinsicType))));
! bug "primop intrinsic type doesn't match occurrence type")
val _ = debugmsg "<<mkVE: after matchInstTypes"
in case (primop, intrinsicParams)
--- 878,919 ----
val intrinsicParams =
(* compute intrinsic instantiation params of intrinsicType *)
! case (TU.matchInstTypes(occty, intrinsicType)
! : (TP.tyvar list * TP.tyvar list) option )
of SOME(_, tvs) =>
! (if !debugging then
! complain EM.WARN
! "mkVE ->matchInstTypes -> pruneTyvar"
! (fn ppstrm =>
! (PP.string ppstrm
! ("tvs length: " ^ Int.toString (length tvs));
! PP.newline ppstrm;
! PPVal.ppDebugVar
! (fn x => "") ppstrm env e;
! if (length tvs) = 1
! then PPType.ppType env ppstrm (TP.VARty (hd tvs))
! else ()))
! else ();
! map TU.pruneTyvar tvs)
! | NONE =>
! (complain EM.COMPLAIN
! "mkVE:primop intrinsic type doesn't match occurrence type"
! (fn ppstrm =>
! (PP.string ppstrm "VALvar: ";
! PPVal.ppVar ppstrm e;
! PP.newline ppstrm;
! PP.string ppstrm "occtypes: ";
! PPType.ppType env ppstrm occty;
! PP.newline ppstrm;
! PP.string ppstrm "intrinsicType: ";
! PPType.ppType env ppstrm intrinsicType;
! PP.newline ppstrm;
! PP.string ppstrm "instpoly occ: ";
! PPType.ppType env ppstrm
! (#1 (TU.instantiatePoly occty));
! PP.newline ppstrm;
! PP.string ppstrm "instpoly intrinsicType: ";
! PPType.ppType env ppstrm
! (#1 (TU.instantiatePoly intrinsicType))));
! bug "mkVE -- NONE")
val _ = debugmsg "<<mkVE: after matchInstTypes"
in case (primop, intrinsicParams)
***************
*** 1462,1465 ****
--- 1480,1484 ----
(** type check body (including kind check) **)
+ val _ = complain EM.WARN ">>translate typecheck" EM.nullErrorBody
val _ = print "**** Translate: typechecking plexp ****\n"
val _ = PPLexp.printLexp plexp
-------------------------------------------------------------------------
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