CVS: sml-dist/src/compiler/FLINT/plambda chkplexp.sml, 1.9.10.2, 1.9.10.3

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

Modified Files:
      Tag: primop-branch-2
	chkplexp.sml 
Log Message:
debugging plambda type checking

Index: chkplexp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/chkplexp.sml,v
retrieving revision 1.9.10.2
retrieving revision 1.9.10.3
diff -C2 -d -r1.9.10.2 -r1.9.10.3
*** chkplexp.sml	18 Aug 2006 23:54:34 -0000	1.9.10.2
--- chkplexp.sml	21 Aug 2006 23:07:07 -0000	1.9.10.3
***************
*** 116,120 ****
    (case lt_inst_chk(lt, ts, kenv) 
      of [b] => b 
!      | _ => bug "unexpected ase in ltAppChk")
  
  (** utility functions for type checking *)
--- 116,120 ----
    (case lt_inst_chk(lt, ts, kenv) 
      of [b] => b 
!      | _ => bug "unexpected arg in ltAppChk")
  
  (** utility functions for type checking *)
***************
*** 217,223 ****
         (case le
           of VAR v => 
!               (let val lty = LT.ltLookup(venv, v, d) 
!                 in ltyChk kenv lty; lty  (* no -- move this out and kcheck result *)
!                end
                 handle LT.ltUnbound => 
                  (say ("** Lvar ** " ^ (LV.lvarName(v)) ^ " is unbound *** \n");
--- 217,221 ----
         (case le
           of VAR v => 
!               (LT.ltLookup(venv, v, d) 
                 handle LT.ltUnbound => 
                  (say ("** Lvar ** " ^ (LV.lvarName(v)) ^ " is unbound *** \n");
***************
*** 229,244 ****
            | PRIM(p, t, ts) =>
               (* kind check t and ts *)
!               (ltyChkenv t; map (tycChk kenv) ts;
                 ltTyApp le "PRIM" (t, ts, kenv))
  
            | FN(v, t, e1) =>
!               let val _ = ltyChkenv t (* kind check *)
                    val venv' = LT.ltInsert(venv, v, t, d)
                    val res = check (kenv, venv', d) e1
                 in ltFun(t, res) (* handle both functions and functors *)
                end
  
            | FIX(vs, ts, es, eb) => 
!               let val _ = map ltyChkenv ts  (* kind check *)
                    fun h (env, v::r, x::z) = h(LT.ltInsert(env, v, x, d), r, z)
                      | h (env, [], []) = env
--- 227,243 ----
            | PRIM(p, t, ts) =>
               (* kind check t and ts *)
!               ((* ltyChkenv t; map (tycChk kenv) ts; *)
                 ltTyApp le "PRIM" (t, ts, kenv))
  
            | FN(v, t, e1) =>
!               let val _ = ltyChkenv t (* kind check bound variable type *)
                    val venv' = LT.ltInsert(venv, v, t, d)
                    val res = check (kenv, venv', d) e1
+ (*                  val _ = ltyChkenv res *)
                 in ltFun(t, res) (* handle both functions and functors *)
                end
  
            | FIX(vs, ts, es, eb) => 
!               let val _ = map ltyChkenv ts  (* kind check bound variable types *)
                    fun h (env, v::r, x::z) = h(LT.ltInsert(env, v, x, d), r, z)
                      | h (env, [], []) = env
***************
*** 247,250 ****
--- 246,250 ----
  
                    val nts = map (check (kenv, venv', d)) es
+ (*                   val _ = map ltyChkenv nts *)
                    val _ = app2(ltMatch le "FIX1", ts, nts)
  
***************
*** 252,259 ****
                end
  
!           | APP(e1, e2) => ltFnApp le "APP" (loop e1, loop e2)
  
            | LET(v, e1, e2) => 
!               let val venv' = LT.ltInsert(venv, v, loop e1, d)
                 in check (kenv, venv', d) e2
                end
--- 252,266 ----
                end
  
!           | APP(e1, e2) => 
!               let val top = loop e1
!                   val targ = loop e2
!               in (* ltyChkenv top; ltyChkenv targ; *)
!                  ltFnApp le "APP" (top, targ)
!               end
  
            | LET(v, e1, e2) => 
!               let val t1 = loop e1
! (*                  val _ = ltyChkenv t1 *)
!                   val venv' = LT.ltInsert(venv, v, t1, d)
                 in check (kenv, venv', d) e2
                end
***************
*** 262,269 ****
                let val kenv' = LT.tkInsert(kenv, ks)
                    val lt = check (kenv', venv, DI.next d) e
                 in LT.ltc_poly(ks, [lt])
                end
  
!           | TAPP(e, ts) => ltTyApp le "TAPP" (loop e, ts, kenv)
            | GENOP(dict, p, t, ts) => 
                ((* should type check dict also *)
--- 269,282 ----
                let val kenv' = LT.tkInsert(kenv, ks)
                    val lt = check (kenv', venv, DI.next d) e
+ (*                  val _ = ltyChkenv lt *)
                 in LT.ltc_poly(ks, [lt])
                end
  
!           | TAPP(e, ts) =>
!               let val lt = loop e
! (*                  val _ = ltyChkenv lt *)
!               in  ltTyApp le "TAPP" (lt, ts, kenv)
!               end
! 
            | GENOP(dict, p, t, ts) => 
                ((* should type check dict also *)
***************
*** 278,282 ****
--- 291,297 ----
            | CON((_, rep, lt), ts, e) =>   
                let val t1 = ltTyApp le "CON" (lt, ts, kenv)
+ (*                  val _ = ltyChkenv t1 *)
                    val t2 = loop e
+ (*                  val _ = ltyChkenv t2 *)
                 in ltFnApp le "CON-A" (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