CVS: sml-dist/src/compiler/FLINT/trans matchcomp.sml, 1.7, 1.7.4.1 mccommon.sml, 1.3.10.1, 1.3.10.2 primopmap.sml, 1.1.2.1, 1.1.2.2 translate.sml, 1.33.4.4, 1.33.4.5

David MacQueen <[email protected]> Tue, 11 Jul 2006 16:00:44 -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-serv3556/FLINT/trans

Modified Files:
      Tag: primop-branch-2
	matchcomp.sml mccommon.sml primopmap.sml translate.sml 
Log Message:
further primop hacking -- getting close to compile

Index: matchcomp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/matchcomp.sml,v
retrieving revision 1.7
retrieving revision 1.7.4.1
diff -C2 -d -r1.7 -r1.7.4.1
*** matchcomp.sml	11 Nov 2004 06:15:33 -0000	1.7
--- matchcomp.sml	11 Jul 2006 23:00:41 -0000	1.7.4.1
***************
*** 1125,1129 ****
            of DATApcon (dc, ts) => 
                 let val newvar = mkv()
!                    val nts = map toTyc ts
                     val nenv = (DELTAPATH(pcon, path), newvar)::env
                  in (DATAcon (mkDcon dc, nts, newvar), nenv)
--- 1125,1129 ----
            of DATApcon (dc, ts) => 
                 let val newvar = mkv()
!                    val nts = map (toTyc o TP.VARty) ts
                     val nenv = (DELTAPATH(pcon, path), newvar)::env
                  in (DATAcon (mkDcon dc, nts, newvar), nenv)

Index: mccommon.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/mccommon.sml,v
retrieving revision 1.3.10.1
retrieving revision 1.3.10.2
diff -C2 -d -r1.3.10.1 -r1.3.10.2
*** mccommon.sml	28 Jun 2006 00:02:59 -0000	1.3.10.1
--- mccommon.sml	11 Jul 2006 23:00:41 -0000	1.3.10.2
***************
*** 16,20 ****
    | RECORDsimp of (label * simp) list
  
! type dconinfo = datacon * ty option
  
  datatype pcon 
--- 16,20 ----
    | RECORDsimp of (label * simp) list
  
! type dconinfo = datacon * tyvar list
  
  datatype pcon 
***************
*** 106,110 ****
  end (* toplevel local *)
  end (* structure MCCommon *)
- 
- 
- 
--- 106,107 ----

Index: primopmap.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/Attic/primopmap.sml,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** primopmap.sml	6 Jul 2006 23:01:06 -0000	1.1.2.1
--- primopmap.sml	11 Jul 2006 23:00:41 -0000	1.1.2.2
***************
*** 14,18 ****
  signature PRIMOP_MAP =
  sig 
!   val primopMap : string -> Primop.primop * Types.ty
  end (* signature PRIMOP_MAP *)
  
--- 14,18 ----
  signature PRIMOP_MAP =
  sig 
!   val primopMap : string -> (PrimOp.primop * Types.ty) option
  end (* signature PRIMOP_MAP *)
  
***************
*** 21,31 ****
  struct
  
- local
- 
    structure T = Types
    structure BT = BasicTypes
    structure P = PrimOp
  
! in
  
  (**************************************************************************
--- 21,37 ----
  struct
  
    structure T = Types
    structure BT = BasicTypes
    structure P = PrimOp
  
! structure StringKey : ORD_KEY =
! struct
!   type ord_key = string
!   val compare = String.compare
! end
! 
! structure RBMap = RedBlackMapFn(StringKey)
! 
! fun bug msg = ErrorMsg.impossible("PrimOpMap: " ^ msg)
  
  (**************************************************************************
***************
*** 220,225 ****
  val rccType = p3(ar(tu[w32,v1,v2],v3))
  
- in
- 
  (*
   * I made an effort to eliminate the cases where type info for primops
--- 226,229 ----
***************
*** 230,240 ****
   *)
  
- structure StringKey : ORD_KEY =
- struct
-   type ord_key = string
-   val compare = String.compare
- end
- 
- structure RBMap = RedBlackMapFn(StringKey)
  
  val empty = RBMap.empty
--- 234,237 ----
***************
*** 350,358 ****
         ("test_32_31_i",  (P.TEST(32,31),  	i32_i)) :-:
  
!        ("testu_31_31",   (P.TESTU(31,31),       w_i))) :-:
  
!        ("testu_32_31",   (P.TESTU(32,31),       w32_i))) :-:
  
!        ("testu_32_32",   (P.TESTU(32,32),   	w32_i32))) :-:
  
         ("copy_32_32_ii", (P.COPY(32,32),   	i32_i32)) :-:
--- 347,355 ----
         ("test_32_31_i",  (P.TEST(32,31),  	i32_i)) :-:
  
!        ("testu_31_31",   (P.TESTU(31,31),       w_i)) :-:
  
!        ("testu_32_31",   (P.TESTU(32,31),       w32_i)) :-:
  
!        ("testu_32_32",   (P.TESTU(32,32),   	w32_i32)) :-:
  
         ("copy_32_32_ii", (P.COPY(32,32),   	i32_i32)) :-:
***************
*** 392,408 ****
  
         (* conversion primops involving intinf *)
!        ("test_inf_31",   (P.TEST_INF 31,         inf_i)   :-:
         ("test_inf_32",   (P.TEST_INF 32,         inf_i32)) :-:
         ("test_inf_64",   (P.TEST_INF 64,         inf_i64)) :-:
!        ("copy_8_inf",    (P.COPY_INF 8,          w8_inf)  :-:
!        ("copy_8_inf_w",  (P.COPY_INF 8,          w8_inf)  :-:
!        ("copy_31_inf_w", (P.COPY_INF 31,         w_inf)   :-:
         ("copy_32_inf_w", (P.COPY_INF 32,         w32_inf)) :-:
         ("copy_64_inf_w", (P.COPY_INF 64,         w64_inf)) :-:
!        ("copy_31_inf_i", (P.COPY_INF 31,         i_inf)   :-:
         ("copy_32_inf_i", (P.COPY_INF 32,         i32_inf)) :-:
         ("copy_64_inf_i", (P.COPY_INF 64,         i64_inf)) :-:
!        ("extend_8_inf",  (P.EXTEND_INF 8,        w8_inf)  :-:
!        ("extend_8_inf_w",  (P.EXTEND_INF 8,      w8_inf)  :-:
         ("extend_31_inf_w", (P.EXTEND_INF 31,     w_inf)) :-:
         ("extend_32_inf_w", (P.EXTEND_INF 32,     w32_inf)) :-:
--- 389,405 ----
  
         (* conversion primops involving intinf *)
!        ("test_inf_31",   (P.TEST_INF 31,         inf_i))   :-:
         ("test_inf_32",   (P.TEST_INF 32,         inf_i32)) :-:
         ("test_inf_64",   (P.TEST_INF 64,         inf_i64)) :-:
!        ("copy_8_inf",    (P.COPY_INF 8,          w8_inf))  :-:
!        ("copy_8_inf_w",  (P.COPY_INF 8,          w8_inf))  :-:
!        ("copy_31_inf_w", (P.COPY_INF 31,         w_inf))   :-:
         ("copy_32_inf_w", (P.COPY_INF 32,         w32_inf)) :-:
         ("copy_64_inf_w", (P.COPY_INF 64,         w64_inf)) :-:
!        ("copy_31_inf_i", (P.COPY_INF 31,         i_inf))   :-:
         ("copy_32_inf_i", (P.COPY_INF 32,         i32_inf)) :-:
         ("copy_64_inf_i", (P.COPY_INF 64,         i64_inf)) :-:
!        ("extend_8_inf",  (P.EXTEND_INF 8,        w8_inf))  :-:
!        ("extend_8_inf_w",  (P.EXTEND_INF 8,      w8_inf))  :-:
         ("extend_31_inf_w", (P.EXTEND_INF 31,     w_inf)) :-:
         ("extend_32_inf_w", (P.EXTEND_INF 32,     w32_inf)) :-:
***************
*** 411,415 ****
         ("extend_32_inf_i", (P.EXTEND_INF 32,     i32_inf)) :-:
         ("extend_64_inf_i", (P.EXTEND_INF 64,     i64_inf)) :-:
!        ("trunc_inf_8",   (P.TRUNC_INF 8,         inf_w8)  :-:
         ("trunc_inf_31",  (P.TRUNC_INF 31,        inf_w)) :-:
         ("trunc_inf_32",  (P.TRUNC_INF 32,        inf_w32)) :-:
--- 408,412 ----
         ("extend_32_inf_i", (P.EXTEND_INF 32,     i32_inf)) :-:
         ("extend_64_inf_i", (P.EXTEND_INF 64,     i64_inf)) :-:
!        ("trunc_inf_8",   (P.TRUNC_INF 8,         inf_w8))  :-:
         ("trunc_inf_31",  (P.TRUNC_INF 31,        inf_w)) :-:
         ("trunc_inf_32",  (P.TRUNC_INF 32,        inf_w32)) :-:
***************
*** 705,708 ****
--- 702,706 ----
             * rawupdatexxx writes to the record.
             *) 
+ 
         ("rawrecord",    (P.RAW_RECORD { fblock = false }, i_x)) :-:
         ("rawrecord64",  (P.RAW_RECORD { fblock = true }, i_x)) :-:
***************
*** 724,732 ****
         ("rawupdatei32", (P.RAW_STORE (P.INT 32), xw32i32_u)) :-:
         ("rawupdatef32", (P.RAW_STORE (P.FLOAT 32), xw32f64_u)) :-:
!        ("rawupdatef64", (P.RAW_STORE (P.FLOAT 64), xw32f64_u)) 
! 
! end (* local *)
  
  fun primopMap name = RBMap.find(primops,name)
  
  end (* structure PrimOpMap *)
--- 722,735 ----
         ("rawupdatei32", (P.RAW_STORE (P.INT 32), xw32i32_u)) :-:
         ("rawupdatef32", (P.RAW_STORE (P.FLOAT 32), xw32f64_u)) :-:
!        ("rawupdatef64", (P.RAW_STORE (P.FLOAT 64), xw32f64_u))
  
  fun primopMap name = RBMap.find(primops,name)
  
+ (* Not needed now, delete later...
+ fun primopIntrinsicType name =
+     case PrimopMap.primopMap p
+       of SOME(_,ty) => ty
+        | NONE => bug "unknown primop"
+ *)
+ 
  end (* structure PrimOpMap *)

Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.4
retrieving revision 1.33.4.5
diff -C2 -d -r1.33.4.4 -r1.33.4.5
*** translate.sml	11 Jul 2006 15:10:15 -0000	1.33.4.4
--- translate.sml	11 Jul 2006 23:00:41 -0000	1.33.4.5
***************
*** 843,878 ****
    | mkVar _ = bug "unexpected vars in mkVar"
  
! fun mkVE (v, ts, d) = let
!     fun otherwise () =
! 	case ts of
! 	    [] => mkVar (v, d)
! 	  | _ => TAPP(mkVar(v, d), map (toTyc d) ts)
! in
!     case v of
! 	V.VALvar { prim, ... } =>
! 	case prim
! 	 of PrimOpId.Prim p => 
!             let val ts = (* compute intrinsic instantiation params *) []
!             in (case (p, ts)
! 		of (PO.POLYEQL, [t]) => eqGen(typ, t, toTcLt d)
! 		| (PO.POLYNEQ, [t]) =>
! 		  composeNOT(eqGen(typ, t, toTcLt d), toLty d t)
! 		| (PO.INLMKARRAY, [t]) => 
!                   let val dict = 
! 			  {default = coreAcc "mkNormArray",
! 			   table = [([LT.tcc_real], coreAcc "mkRealArray")]}
!                   in GENOP (dict, p, toLty d typ, map (toTyc d) ts)
!                   end
! 		| (PO.RAW_CCALL NONE, [a, b, c]) =>
! 		  let val i = SOME (CProto.decode cproto_conv
! 						  { fun_ty = a, encoding = b })
! 			      handle CProto.BadEncoding => NONE
! 		  in PRIM (PO.RAW_CCALL i, toLty d typ, map (toTyc d) ts)
! 		  end
! 		| _ => transPrim(p, (toLty d typ), map (toTyc d) ts))
!             end
! 	  |  PrimOpId.NonPrim => otherwise ()
!       | _ => otherwise ()
! end
  
  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) = 
--- 843,894 ----
    | mkVar _ = bug "unexpected vars in mkVar"
  
! (* mkVE : V.var * type list * depth -> lexp 
!  * This translates a variable, which might be bound to a primop.
!  * In the case of a primop variable, this function reconstructs the
!  * type parameters of instantiation of the intrinsic primop type relative
!  * to the variable occurrence type *)
! fun mkVE (V.VALvar { typ, prim = PrimOpId.Prim p, ... }, ts, d) =
!       let val occty = (* compute the occurrence type of the variable *)
!               case ts
!                 of [] => !typ
!                  | _ => TU.applyPoly(!typ, ts)
!           val (primop,intrinsicType) =
!               case PrimopMap.primopMap p
!                of SOME(p,t) => (p,t)
!                 | NONE => bug "mkVE: unrecognized primop name"
!           val intrinsicParams =
!               (* compute intrinsic instantiation params of intrinsicType *)
!               case TU.matchInstTypes(occty,intrinsicType)
!                 of SOME(_,tvs) => map TU.pruneTyvar tvs
!                  | NONE => bug "primop intrinsic type does't match occurence type"
!        in case (primop, intrinsicParams)
!             of (PO.POLYEQL, [t]) => eqGen(intrinsicType, t, toTcLt d)
!              | (PO.POLYNEQ, [t]) =>
!                composeNOT(eqGen(intrinsicType, t, toTcLt d), toLty d t)
!              | (PO.INLMKARRAY, [t]) => 
!                let val dict = 
!                        {default = coreAcc "mkNormArray",
!                         table = [([LT.tcc_real], coreAcc "mkRealArray")]}
!                 in GENOP (dict, primop, toLty d intrinsicType,
!                          map (toTyc d) intrinsicParams)
!                end
!              | (PO.RAW_CCALL NONE, [a, b, c]) =>
!                let val i = SOME (CProto.decode cproto_conv
!                                    { fun_ty = a, encoding = b })
!                            handle CProto.BadEncoding => NONE
!                in PRIM (PO.RAW_CCALL i, toLty d intrinsicType,
!                         map (toTyc d) intrinsicParams)
!                end
!              | _ => transPrim(primop, (toLty d intrinsicType),
!                               map (toTyc d) intrinsicParams)
!       end
!   | mkVE (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))
!                  (* dbm: when does this second case occur? *)
!   | mkVE _ = bug "non VALvar passed to mkVE"
! 
  
  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) = 
***************
*** 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
--- 896,900 ----
        val rep' = mkRep(rep, lt, name)
        val dc = (name, rep', lt)
!       val ts' = map (toTyc d o TP.VARty) ts
     in if const then CON'(dc, ts', unitLexp)
        else (case apOp
***************
*** 917,944 ****
   * Translating core absyn declarations into lambda expressions:            *
   *                                                                         *
!  *    val mkVBs  : Absyn.vb list * depth -> Lambda.lexp -> Lambda.lexp     *
!  *    val mkRVBs : Absyn.rvb list * depth -> Lambda.lexp -> Lambda.lexp    *
!  *    val mkEBs  : Absyn.eb list * depth -> Lambda.lexp -> Lambda.lexp     *
   *                                                                         *
   ***************************************************************************)
  fun mkPE (exp, d, []) = mkExp(exp, d)
    | mkPE (exp, d, boundtvs) = 
        let val savedtvs = map ! boundtvs
  
!           fun g (i, []) = ()
!             | g (i, (tv as ref (TP.OPEN _))::rest) = let
! 		  val m = markLBOUND (d, i);
! 	      in
! 		  tv := TP.TV_MARK m;
! 		  g (i+1, rest)
! 	      end
!             | g (i, (tv as ref (TP.TV_MARK _))::res) =
!                    bug ("unexpected tyvar TV_MARK in mkPE")
!             | g _ = bug "unexpected tyvar INSTANTIATED in mkPE"
  
-           val _ = g(0, boundtvs) (* assign the TV_MARK tyvars *)
            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))
--- 933,969 ----
   * Translating core absyn declarations into lambda expressions:            *
   *                                                                         *
!  *    val mkVBs  : Absyn.vb list * depth -> PLambda.lexp -> PLambda.lexp     *
!  *    val mkRVBs : Absyn.rvb list * depth -> PLambda.lexp -> PLambda.lexp    *
!  *    val mkEBs  : Absyn.eb list * depth -> PLambda.lexp -> PLambda.lexp     *
   *                                                                         *
   ***************************************************************************)
+ 
+ (* mkPE : Absyn.exp * depth * Types.tyvar list -> PLambda.lexp
+  * translate an expression with potential type parameters *)
  fun mkPE (exp, d, []) = mkExp(exp, d)
    | mkPE (exp, d, boundtvs) = 
        let val savedtvs = map ! boundtvs
+             (* save original contents of boundtvs for later restoration
+              * by the restore function below *)
  
!           fun setbtvs (i, []) = ()
!             | 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
!             | setbtvs (i, (tv as ref (TP.TV_MARK _))::res) =
!                 bug ("unexpected tyvar TV_MARK in mkPE")
!             | setbtvs _ = bug "unexpected tyvar INSTANTIATED in mkPE"
! 
!           val _ = setbtvs(0, boundtvs)
!             (* assign TV_MARKs to the boundtvs to mark them as type
!              * parameter variables during translation of exp *)
  
            val exp' = mkExp(exp, DI.next d)
+             (* increase the depth to indicate that the expression is
+              * going to be wrapped by a type abstraction (TFN) *)
  
!           (* restore tyvar states to that before the translation *)
            fun restore ([], []) = ()
              | restore (a::r, b::z) = (b := a; restore(r, z))
***************
*** 948,952 ****
               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)
--- 973,978 ----
               contents of the uninstantiated meta type variables? 
               Only seems to be necessary if a given tyvar gets generalized
!              in two different valbinds. We assume that this does not
!              happen (Single Generalization Conjecture) *)
  
            val _ = restore(savedtvs, boundtvs)
***************
*** 957,963 ****
  
  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
--- 983,989 ----
  
  and mkVBs (vbs, d) =
!   let fun mkVB (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
!                    exp as VARexp (ref (w as (V.VALvar{typ,prim,...})), instvs),
!                    boundtvs=btvs, ...}, b: lexp) = 
              (* [dbm: 7/10/06] Originally, the mkVar and mkPE translations
               * were chosen based on whether btvs and instvs were the same
***************
*** 971,1010 ****
              (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, ...}),
!                 exp, boundtvs=tvs, ...}, b) = LET(v, mkPE(exp, d, tvs), b)
  
!         | g (VB{pat=CONSTRAINTpat(VARpat(V.VALvar{access=DA.LVAR v, ...}),_),
!                 exp, boundtvs=tvs, ...}, b) = LET(v, mkPE(exp, d, tvs), b)
  
!         | g (VB{pat, exp, boundtvs=tvs, ...}, b) =
!               let val ee = mkPE(exp, d, tvs)
!                   val rules = [(fillPat(pat, d), b), (WILDpat, unitLexp)]
!                   val rootv = mkv()
!                   fun finish x = LET(rootv, ee, x)
!                in MC.bindCompile(env, rules, finish, rootv, toTcLt d, complain,
! 				 genintinfswitch)
!               end
!    in fold g vbs
!   end
  
  and mkRVBs (rvbs, d) =
!   let fun g (RVB{var=V.VALvar{access=DA.LVAR v, typ=ref ty, ...},
!                  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)
!                end
!         | g _ = bug "unexpected valrec bindings in mkRVBs"
  
!       val (vlist, tlist, elist) = foldr g ([], [], []) rvbs
  
     in fn b => FIX(vlist, tlist, elist, b)
--- 997,1040 ----
              (case prim
                of PrimOpId.Prim name =>
!                   (case PrimOpMap.primopMap name
!                      of SOME(primop,primopty) =>
!                         if TU.equalTypeP(!typ,primopty)
!                         then LET(v, mkVar(w, d), b)
!                         else LET(v, mkPE(exp, d, btvs), b)
!                       | NONE => bug "mkVBs: unknown primop name")
                 | _ => LET(v, mkVar(w, d), b))
                   (* when generalized variables = instantiation params *)
  
!         | mkVB (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
!                    exp, boundtvs=btvs, ...}, b) =
!             LET(v, mkPE(exp, d, btvs), b)
  
!         | mkVB (VB{pat=CONSTRAINTpat(VARpat(V.VALvar{access=DA.LVAR v, ...}),_),
!                    exp, boundtvs=tvs, ...}, b) =
!             LET(v, mkPE(exp, d, tvs), b)
  
!         | mkVB (VB{pat, exp, boundtvs=tvs, ...}, b) =
!             let val ee = mkPE(exp, d, tvs)
!                 val rules = [(fillPat(pat, d), b), (WILDpat, unitLexp)]
!                 val rootv = mkv()
!                 fun finish x = LET(rootv, ee, x)
!              in MC.bindCompile(env, rules, finish, rootv, toTcLt d, complain,
! 			       genintinfswitch)
!             end
! 
!    in fold mkVB vbs
!   end (* mkVBs *)
  
  and mkRVBs (rvbs, d) =
!   let fun mkRVB (RVB{var=V.VALvar{access=DA.LVAR v, typ=ref ty, ...},
!                      exp, boundtvs=btvs, ...}, (vlist, tlist, elist)) = 
!             let val ee = mkExp(exp, d) (* was mkPE(exp, d, btvs) *)
!                 (* [ZHONG?] we no longer track type bindings at RVB anymore ! *)
!                 val vt = toLty d ty
!             in (v::vlist, vt::tlist, ee::elist)
!             end
!         | mkRVB _ = bug "unexpected valrec bindings in mkRVBs"
  
!       val (vlist, tlist, elist) = foldr mkRVB ([], [], []) rvbs
  
     in fn b => FIX(vlist, tlist, elist, b)
***************
*** 1034,1041 ****
   * Translating module exprs and decls into lambda expressions:             *
   *                                                                         *
!  *    val mkStrexp : Absyn.strexp * depth -> Lambda.lexp                   *
!  *    val mkFctexp : Absyn.fctexp * depth -> Lambda.lexp                   *
!  *    val mkStrbs  : Absyn.strb list * depth -> Lambda.lexp -> Lambda.lexp *
!  *    val mkFctbs  : Absyn.fctb list * depth -> Lambda.lexp -> Lambda.lexp *
   *                                                                         *
   ***************************************************************************)
--- 1064,1071 ----
   * Translating module exprs and decls into lambda expressions:             *
   *                                                                         *
!  *    val mkStrexp : Absyn.strexp * depth -> PLambda.lexp                   *
!  *    val mkFctexp : Absyn.fctexp * depth -> PLambda.lexp                   *
!  *    val mkStrbs  : Absyn.strb list * depth -> PLambda.lexp -> PLambda.lexp *
!  *    val mkFctbs  : Absyn.fctb list * depth -> PLambda.lexp -> PLambda.lexp *
   *                                                                         *
   ***************************************************************************)
***************
*** 1107,1112 ****
   * Translating absyn decls and exprs into lambda expression:               *
   *                                                                         *
!  *    val mkExp : A.exp * DI.depth -> L.lexp                               *
!  *    val mkDec : A.dec * DI.depth -> L.lexp -> L.lexp                     *
   *                                                                         *
   ***************************************************************************)
--- 1137,1142 ----
   * Translating absyn decls and exprs into lambda expression:               *
   *                                                                         *
!  *    val mkExp : A.exp * DI.depth -> PLambda.lexp                         *
!  *    val mkDec : A.dec * DI.depth -> PLambda.lexp -> PLambda.lexp         *
   *                                                                         *
   ***************************************************************************)
***************
*** 1147,1151 ****
  
        and g (VARexp (ref v, ts)) = 
!             mkVE(v, map T.VARty ts, d)
  
          | g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)
--- 1177,1181 ----
  
        and g (VARexp (ref v, ts)) = 
!             mkVE(v, map TP.VARty ts, d)
  
          | g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)
***************
*** 1205,1209 ****
   * 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
--- 1235,1239 ----
   * 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???] *)
! (* (commented out by whom, when why?)
               let val (nty, ks, tps) = TU.reformat(ty, tycs, d)
                   val ts = map (tpsTyc d) tps



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