CVS: sml-dist/src/compiler/FLINT/trans translate.sml, 1.33.4.25, 1.33.4.26 transtypes.sml, 1.5.10.11, 1.5.10.12

Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv3562/src/compiler/FLINT/trans

Modified Files:
      Tag: primop-branch-2
	translate.sml transtypes.sml 
Log Message:
added further debugging instrumentation

Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.25
retrieving revision 1.33.4.26
diff -C2 -d -r1.33.4.25 -r1.33.4.26
*** translate.sml	28 Aug 2006 05:12:11 -0000	1.33.4.25
--- translate.sml	28 Aug 2006 22:57:54 -0000	1.33.4.26
***************
*** 49,53 ****
   ****************************************************************************)
  
! val debugging = ref false
  fun bug msg = EM.impossible("Translate: " ^ msg)
  val say = Control.Print.say
--- 49,53 ----
   ****************************************************************************)
  
! val debugging = ref true
  fun bug msg = EM.impossible("Translate: " ^ msg)
  val say = Control.Print.say
***************
*** 58,61 ****
--- 58,63 ----
  val ppDepth = Control.Print.printDepth
  
+ val with_pp = PP.with_default_pp
+ 
  fun ppType ty =
      ElabDebug.withInternals
***************
*** 941,947 ****
                                map (toTyc d) intrinsicParams)
        end
!   | mkVE (v as V.VALvar{typ, prim = PrimOpId.NonPrim, ... }, ts, d) =
      (* non primop variable *)
!       (case ts
           of [] => mkVar (v, d)
            | _ => TAPP(mkVar(v, d), map (toTyc d) ts))
--- 943,956 ----
                                map (toTyc d) intrinsicParams)
        end
!   | mkVE (v as V.VALvar{typ, prim = PrimOpId.NonPrim, path, ...}, ts, d) =
      (* non primop variable *)
!       (if !debugging
!        then (print "### mkVE nonprimop\n";
!              print (SymPath.toString path); print "\n";
!              ppType (!typ); print "\n";
!              print "|ts| = "; print (Int.toString(length ts)); print "\n";
!              app ppType ts; print "\n")
!        else ();
!        case ts
           of [] => mkVar (v, d)
            | _ => TAPP(mkVar(v, d), map (toTyc d) ts))
***************
*** 1008,1012 ****
              | setbtvs (i, (tv as ref (TP.OPEN _))::rest) =
  		let val m = markLBOUND (d, i)
! 	         in tv := TP.TV_MARK m;
  		    setbtvs (i+1, rest)
  	        end
--- 1017,1021 ----
              | setbtvs (i, (tv as ref (TP.OPEN _))::rest) =
  		let val m = markLBOUND (d, i)
! 	         in tv := TP.TV_MARK (d,i);
  		    setbtvs (i+1, rest)
  	        end
***************
*** 1486,1491 ****
  val _ = print "**** Translate: typechecking plexp ****\n"
  (* val _ = PPLexp.printLexp plexp *)
! val _ = ChkPlexp.checkLtyTop(plexp,0)
! val _ = print "**** Translate: finished typechecking plexp ****\n"
  
  fun prGen (flag,printE) s e =
--- 1495,1504 ----
  val _ = print "**** Translate: typechecking plexp ****\n"
  (* val _ = PPLexp.printLexp plexp *)
! val ltyerrors = ChkPlexp.checkLtyTop(plexp,0)
! val _ = if ltyerrors
!         then (print "**** Translate: checkLty failed ****\n";
!               with_pp(fn ppstm => (PPLexp.ppLexp 5 ppstm plexp));
!               complain EM.WARN "checkLty" EM.nullErrorBody)
!         else print "**** Translate: finished typechecking plexp ****\n"
  
  fun prGen (flag,printE) s e =

Index: transtypes.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/transtypes.sml,v
retrieving revision 1.5.10.11
retrieving revision 1.5.10.12
diff -C2 -d -r1.5.10.11 -r1.5.10.12
*** transtypes.sml	28 Aug 2006 05:12:11 -0000	1.5.10.11
--- transtypes.sml	28 Aug 2006 22:57:54 -0000	1.5.10.12
***************
*** 268,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 _) = (print "#### toTyc UBOUND!\n"; LT.tcc_void)
              (* dbm: should this have been converted to a TV_MARK before
--- 268,276 ----
  
        and h (INSTANTIATED t) = g t
!         | h (TV_MARK(depth,num)) =
! (*            let val (depth, num) = findLBOUND m
!             in *)
                  LT.tcc_var(DI.calc(d, depth), num)
! (*            end *)
          | h (UBOUND _) = (print "#### toTyc UBOUND!\n"; LT.tcc_void)
              (* dbm: should this have been converted to a TV_MARK before


-------------------------------------------------------------------------
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