Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/primop-branch-2/src/compiler/FLINT/trans/translate.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-2/src/compiler/FLINT/trans/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1961, Fri Jul 7 21:06:11 2006 UTC revision 1967, Mon Jul 10 22:27:13 2006 UTC
# Line 345  Line 345 
345          | _ => rep          | _ => rep
346    end    end
347    
348  (** converting a value of access+info into the lambda expression *)  (** converting a value of access+prim into the lambda expression
349  fun mkAccInfo (acc, info, getLty, nameOp) =   ** [KM???} But it is ignoring the prim argument!!!
350     **)
351    fun mkAccInfo (acc, prim, getLty, nameOp) =
352    if extern acc then mkAccT(acc, getLty(), nameOp) else mkAcc (acc, nameOp)    if extern acc then mkAccT(acc, getLty(), nameOp) else mkAcc (acc, nameOp)
353    
354  fun fillPat(pat, d) =  fun fillPat(pat, d) =
# Line 835  Line 837 
837   *   val mkBnd : DI.depth -> B.binding -> L.lexp                           *   *   val mkBnd : DI.depth -> B.binding -> L.lexp                           *
838   *                                                                         *   *                                                                         *
839   ***************************************************************************)   ***************************************************************************)
840    (* [KM???] mkVar is calling mkAccInfo, which just drops the prim!!! *)
841  fun mkVar (v as V.VALvar{access, prim, typ, path}, d) =  fun mkVar (v as V.VALvar{access, prim, typ, path}, d) =
842        mkAccInfo(access, prim, fn () => toLty d (!typ), getNameOp path)        mkAccInfo(access, prim, fn () => toLty d (!typ), getNameOp path)
843    | mkVar _ = bug "unexpected vars in mkVar"    | mkVar _ = bug "unexpected vars in mkVar"
# Line 876  Line 879 
879    let val lt = toDconLty d typ    let val lt = toDconLty d typ
880        val rep' = mkRep(rep, lt, name)        val rep' = mkRep(rep, lt, name)
881        val dc = (name, rep', lt)        val dc = (name, rep', lt)
882        val ts' = map (toTyc d) ts        val ts' = map (toTyc d o T.VARty) ts
883     in if const then CON'(dc, ts', unitLexp)     in if const then CON'(dc, ts', unitLexp)
884        else (case apOp        else (case apOp
885               of SOME le => CON'(dc, ts', le)               of SOME le => CON'(dc, ts', le)
# Line 936  Line 939 
939            val _ = g(0, boundtvs) (* assign the TV_MARK tyvars *)            val _ = g(0, boundtvs) (* assign the TV_MARK tyvars *)
940            val exp' = mkExp(exp, DI.next d)            val exp' = mkExp(exp, DI.next d)
941    
942            fun h ([], []) = ()            (* restore tyvar states to that before translate *)
943              | h (a::r, b::z) = (b := a; h(r, z))            fun restore ([], []) = ()
944              | h _ = bug "unexpected cases in mkPE"              | restore (a::r, b::z) = (b := a; restore(r, z))
945                | restore _ = bug "unexpected cases in mkPE"
946    
947            (* [dbm, 6/22/06] Why do we need to restore the original            (* [dbm, 6/22/06] Why do we need to restore the original
948               contents of the uninstantiated meta type variables? *)               contents of the uninstantiated meta type variables?
949                 Only seems to be necessary if a given tyvar gets generalized
950                 in two different valbinds *)
951    
952            val _ = h(savedtvs, boundtvs)  (* recover *)            val _ = restore(savedtvs, boundtvs)
953            val len = length(boundtvs)            val len = length(boundtvs)
954    
955         in TFN(LT.tkc_arg(len), exp')         in TFN(LT.tkc_arg(len), exp')
956        end        end
957    
958  and mkVBs (vbs, d) =  and mkVBs (vbs, d) =
959    let fun eqTvs ([], []) = true    let fun g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
960          | eqTvs (a::r, (TP.VARty b)::s) = if (a=b) then eqTvs(r, s) else false                  exp as VARexp (ref (w as (V.VALvar{typ,prim,...})), instvs),
961          | eqTvs _ = false                  boundtvs=btvs, ...}, b) =
962                (* [dbm: 7/10/06] Originally, the mkVar and mkPE translations
963        fun g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),               * were chosen based on whether btvs and instvs were the same
964                  exp as VARexp (ref (w as (V.VALvar _)), instys),               * list of tyvars, which would be the case for all non-primop
965                  boundtvs=tvs, ...}, b) =               * variables, but also in the primop case whenever the rhs
966                if eqTvs(tvs, instys) then LET(v, mkVar(w, d), b)               * variable environment type (!typ) was the same (equalTypeP)
967                else LET(v, mkPE(exp, d, tvs), b)               * to the intrinsic type of the primop (e.g. when they are
968                 * both monotypes).  So in most cases, the mkVar translation
969                 * will be used, and this drops the primop information!!!
970                 * This seems definitely wrong. *)
971                (case prim
972                  of PrimOpId.Prim name =>
973                       let val (primop,primopty) = PrimOpMap name
974                       in if TU.equalTypeP(!typ,primopty)
975                          then LET(v, mkVar(w, d), b)
976                          else LET(v, mkPE(exp, d, btvs), b)
977                       end
978                   | _ => LET(v, mkVar(w, d), b)
979                     (* when generalized variables = instantiation params *)
980    
981          | g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),          | g (VB{pat=VARpat(V.VALvar{access=DA.LVAR v, ...}),
982                  exp, boundtvs=tvs, ...}, b) = LET(v, mkPE(exp, d, tvs), b)                  exp, boundtvs=tvs, ...}, b) = LET(v, mkPE(exp, d, tvs), b)
# Line 981  Line 999 
999    let fun g (RVB{var=V.VALvar{access=DA.LVAR v, typ=ref ty, ...},    let fun g (RVB{var=V.VALvar{access=DA.LVAR v, typ=ref ty, ...},
1000                   exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =                   exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =
1001                 let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)                 let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)
1002                         (* we no longer track type bindings at RVB anymore ! *)                     (* [ZHONG?]we no longer track type bindings at RVB anymore ! *)
1003                     val vt = toLty d ty                     val vt = toLty d ty
1004                  in (v::vlist, vt::tlist, ee::elist)                  in (v::vlist, vt::tlist, ee::elist)
1005                 end                 end
# Line 1127  Line 1145 
1145    
1146        fun mkRules xs = map (fn (RULE(p, e)) => (fillPat(p, d), g e)) xs        fun mkRules xs = map (fn (RULE(p, e)) => (fillPat(p, d), g e)) xs
1147    
1148        and g (VARexp (ref v, ts)) = mkVE(v, ts, d)        and g (VARexp (ref v, ts)) =
1149                mkVE(v, map T.VARty ts, d)
1150    
1151          | g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)          | g (CONexp (dc, ts)) = mkCE(dc, ts, NONE, d)
1152          | g (APPexp (CONexp(dc, ts), e2)) = mkCE(dc, ts, SOME(g e2), d)          | g (APPexp (CONexp(dc, ts), e2)) = mkCE(dc, ts, SOME(g e2), d)
# Line 1182  Line 1201 
1201               end               end
1202    
1203          | g (PACKexp(e, ty, tycs)) = g e          | g (PACKexp(e, ty, tycs)) = g e
1204  (*  (* [dbm, 7/10/06]: Does PACKexp do anything now? What was it doing before
1205     * this was commented out? This appears to be the only place reformat was called
1206     * Is it also the only place the FLINT PACK constructor is used? [KM???] *)
1207    (* (by who, when why?)
1208               let val (nty, ks, tps) = TU.reformat(ty, tycs, d)               let val (nty, ks, tps) = TU.reformat(ty, tycs, d)
1209                   val ts = map (tpsTyc d) tps                   val ts = map (tpsTyc d) tps
1210                   (** use of LtyEnv.tcAbs is a temporary hack (ZHONG) **)                   (** use of LtyEnv.tcAbs is a temporary hack (ZHONG) **)

Legend:
Removed from v.1961  
changed lines
  Added in v.1967

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0