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/trunk/src/compiler/FLINT/trans/translate.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/trans/translate.sml

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

revision 24, Thu Mar 12 00:49:58 1998 UTC revision 45, Sun Mar 22 20:11:09 1998 UTC
# Line 5  Line 5 
5  sig  sig
6    
7    (* Invariant: transDec always applies to a top-level absyn declaration *)    (* Invariant: transDec always applies to a top-level absyn declaration *)
8    val transDec : Absyn.dec * Lambda.lvar list * StaticEnv.staticEnv *    val transDec : Absyn.dec * Access.lvar list
9                   ElabUtil.compInfo                   * StaticEnv.staticEnv * CompBasic.compInfo
10                   -> {genLambda: Lambda.lexp option list -> Lambda.lexp,                   -> {flint: FLINT.prog,
11                       importPids: PersStamps.persstamp list}                       imports: PersStamps.persstamp list}
12    
13  end (* signature TRANSLATE *)  end (* signature TRANSLATE *)
14    
# Line 20  Line 20 
20        structure DA = Access        structure DA = Access
21        structure DI = DebIndex        structure DI = DebIndex
22        structure EM = ErrorMsg        structure EM = ErrorMsg
23        structure EU = ElabUtil        structure CB = CompBasic
24        structure II = InlInfo        structure II = InlInfo
25        structure LT = PLambdaType        structure LT = PLambdaType
26        structure M  = Modules        structure M  = Modules
# Line 29  Line 29 
29        structure PP = PrettyPrint        structure PP = PrettyPrint
30        structure S  = Symbol        structure S  = Symbol
31        structure LN = LiteralToNum        structure LN = LiteralToNum
       structure TM = TransModules  
32        structure TT = TransTypes        structure TT = TransTypes
33        structure TP = Types        structure TP = Types
34        structure TU = TypesUtil        structure TU = TypesUtil
# Line 75  Line 74 
74  fun sorted x = Sort.sorted elemgtr x  fun sorted x = Sort.sorted elemgtr x
75  fun sortrec x = Sort.sort elemgtr x  fun sortrec x = Sort.sort elemgtr x
76    
77    (** an exception raised if coreEnv is not available *)
78    exception NoCore
79    
80    (****************************************************************************
81     *                          MAIN FUNCTION                                   *
82     *                                                                          *
83     *  val transDec: Absyn.dec * Lambda.lexp * StaticEnv.staticEnv             *
84     *                * ElabUtil.compInfo                                       *
85     *                -> {genLambda : Lambda.lexp option list -> Lambda.lexp,   *
86     *                    importPids : PersStamps.persstamp list}               *
87     *                                                                          *
88     ****************************************************************************)
89    
90    fun transDec (rootdec, exportLvars, env,
91                  compInfo as {coreEnv,errorMatch,error,...}: CB.compInfo) =
92    let
93    
94    (** generate the set of ML-to-FLINT type translation functions *)
95    val {tpsKnd, tpsTyc, toTyc, toLty, strLty, fctLty} = TT.genTT()
96    fun toTcLt d = (toTyc d, toLty d)
97    
98  (** translating the typ field in DATACON into lty; constant datacons  (** translating the typ field in DATACON into lty; constant datacons
99      will take ltc_unit as the argument *)      will take ltc_unit as the argument *)
100  fun toDconLty d ty =  fun toDconLty d ty =
101    (case ty    (case ty
102      of TP.POLYty{sign, tyfun=TP.TYFUN{arity, body}} =>      of TP.POLYty{sign, tyfun=TP.TYFUN{arity, body}} =>
103           if BT.isArrowType body then TT.toLty d ty           if BT.isArrowType body then toLty d ty
104           else TT.toLty d (TP.POLYty{sign=sign,           else toLty d (TP.POLYty{sign=sign,
105                                 tyfun=TP.TYFUN{arity=arity,                                 tyfun=TP.TYFUN{arity=arity,
106                                                body=BT.-->(BT.unitTy, body)}})                                                body=BT.-->(BT.unitTy, body)}})
107       | _ => if BT.isArrowType ty then TT.toLty d ty       | _ => if BT.isArrowType ty then toLty d ty
108              else TT.toLty d (BT.-->(BT.unitTy, ty)))              else toLty d (BT.-->(BT.unitTy, ty)))
   
 (** an exception raised if coreEnv is not available *)  
 exception NoCore  
109    
110  (** the special lookup functions for the Core environment *)  (** the special lookup functions for the Core environment *)
111  fun coreLookup(id, env) =  fun coreLookup(id, env) =
# Line 107  Line 124 
124            end            end
125    | CON' x = CON x    | CON' x = CON x
126    
 (****************************************************************************  
  *                          MAIN FUNCTION                                   *  
  *                                                                          *  
  *  val transDec: Absyn.dec * Lambda.lexp * StaticEnv.staticEnv             *  
  *                * ElabUtil.compInfo                                       *  
  *                -> {genLambda : Lambda.lexp option list -> Lambda.lexp,   *  
  *                    importPids : PersStamps.persstamp list}               *  
  *                                                                          *  
  ****************************************************************************)  
   
 fun transDec (rootdec, exportLvars, env,  
               compInfo as {coreEnv,errorMatch,error,...}: EU.compInfo) =  
 let  
   
127  (*  (*
128   * The following code implements the exception tracking and   * The following code implements the exception tracking and
129   * errormsg reporting.   * errormsg reporting.
# Line 248  Line 251 
251  and coreAcc id =  and coreAcc id =
252    ((case coreLookup(id, coreEnv)    ((case coreLookup(id, coreEnv)
253       of V.VAL(V.VALvar{access, typ, ...}) =>       of V.VAL(V.VALvar{access, typ, ...}) =>
254             mkAccT(access, TT.toLty DI.top (!typ))             mkAccT(access, toLty DI.top (!typ))
255        | _ => bug "coreAcc in translate")        | _ => bug "coreAcc in translate")
256     handle NoCore => (say "WARNING: no Core access \n"; INT 0))     handle NoCore => (say "WARNING: no Core access \n"; INT 0))
257    
# Line 331  Line 334 
334     in fill pat     in fill pat
335    end (* function fillPat *)    end (* function fillPat *)
336    
 (*  
 val fillPat = Stats.doPhase(Stats.makePhase "Compiler 047 4-fillPat") fillPat  
 *)  
   
337  (** The runtime polymorphic equality and string equality dictionary. *)  (** The runtime polymorphic equality and string equality dictionary. *)
338  val eqDict =  val eqDict =
339    let val strEqRef : lexp option ref = ref NONE    let val strEqRef : lexp option ref = ref NONE
# Line 636  Line 635 
635                            COND(APP(cmpOp(LESSU),                            COND(APP(cmpOp(LESSU),
636                                     RECORD[vi,APP(lenOp seqtc, va)]),                                     RECORD[vi,APP(lenOp seqtc, va)]),
637                                 APP(oper, RECORD[va,vi,vv]),                                 APP(oper, RECORD[va,vi,vv]),
638                                 mkRaise(coreExn "Subscript", lt_int))))))                                 mkRaise(coreExn "Subscript", LT.ltc_unit))))))
639                end                end
640    
641          | g (PO.NUMUPDATE{kind,checked=true}) =          | g (PO.NUMUPDATE{kind,checked=true}) =
# Line 658  Line 657 
657                            COND(APP(cmpOp(LESSU),                            COND(APP(cmpOp(LESSU),
658                                     RECORD[vi,APP(lenOp tc1, va)]),                                     RECORD[vi,APP(lenOp tc1, va)]),
659                                 APP(oper', RECORD[va,vi,vv]),                                 APP(oper', RECORD[va,vi,vv]),
660                                 mkRaise(coreExn "Subscript", lt_int))))))                                 mkRaise(coreExn "Subscript", LT.ltc_unit))))))
661                end                end
662    
663          | g (PO.ASSIGN) =          | g (PO.ASSIGN) =
# Line 695  Line 694 
694   *                                                                         *   *                                                                         *
695   ***************************************************************************)   ***************************************************************************)
696  fun mkVar (v as V.VALvar{access, info, typ, ...}, d) =  fun mkVar (v as V.VALvar{access, info, typ, ...}, d) =
697        mkAccInfo(access, info, fn () => TT.toLty d (!typ))        mkAccInfo(access, info, fn () => toLty d (!typ))
698    | mkVar _ = bug "unexpected vars in mkVar"    | mkVar _ = bug "unexpected vars in mkVar"
699    
700  fun mkVE (v as V.VALvar {info=II.INL_PRIM(p, SOME typ), ...}, ts, d) =  fun mkVE (v as V.VALvar {info=II.INL_PRIM(p, SOME typ), ...}, ts, d) =
701        (case (p, ts)        (case (p, ts)
702          of (PO.POLYEQL, [t]) => eqGen(typ, t, d)          of (PO.POLYEQL, [t]) => eqGen(typ, t, toTcLt d)
703           | (PO.POLYNEQ, [t]) => composeNOT(eqGen(typ, t, d), TT.toLty d t)           | (PO.POLYNEQ, [t]) => composeNOT(eqGen(typ, t, toTcLt d), toLty d t)
704           | (PO.INLMKARRAY, [t]) =>           | (PO.INLMKARRAY, [t]) =>
705                  let val dict =                  let val dict =
706                        {default = coreAcc "mkNormArray",                        {default = coreAcc "mkNormArray",
707                         table = [([LT.tcc_real], coreAcc "mkRealArray")]}                         table = [([LT.tcc_real], coreAcc "mkRealArray")]}
708                   in GENOP (dict, p, TT.toLty d typ, map (TT.toTyc d) ts)                   in GENOP (dict, p, toLty d typ, map (toTyc d) ts)
709                  end                  end
710           | _ => transPrim(p, (TT.toLty d typ), map (TT.toTyc d) ts))           | _ => transPrim(p, (toLty d typ), map (toTyc d) ts))
711    
712    | mkVE (v as V.VALvar {info=II.INL_PRIM(p, NONE), typ, ...}, ts, d) =    | mkVE (v as V.VALvar {info=II.INL_PRIM(p, NONE), typ, ...}, ts, d) =
713        (case ts of [] => transPrim(p, (TT.toLty d (!typ)), [])        (case ts of [] => transPrim(p, (toLty d (!typ)), [])
714                  | [x] =>                  | [x] =>
715                     (* a temporary hack to resolve the boot/built-in.sml file *)                     (* a temporary hack to resolve the boot/built-in.sml file *)
716                     (let val lt = TT.toLty d (!typ)                     (let val lt = toLty d (!typ)
717                          val nt = TT.toLty d x                          val nt = toLty d x
718                       in if LT.lt_eqv(LT.ltc_top, lt)                       in if LT.lt_eqv(LT.ltc_top, lt)
719                          then transPrim(p, nt, [])                          then transPrim(p, nt, [])
720                          else bug "unexpected primop in mkVE"                          else bug "unexpected primop in mkVE"
# Line 723  Line 722 
722                  | _ => bug "unexpected poly primops in mkVE")                  | _ => bug "unexpected poly primops in mkVE")
723    
724    | mkVE (v, [], d) = mkVar(v, d)    | mkVE (v, [], d) = mkVar(v, d)
725    | mkVE (v, ts, d) = TAPP(mkVar(v, d), map (TT.toTyc d) ts)    | mkVE (v, ts, d) = TAPP(mkVar(v, d), map (toTyc d) ts)
726    
727  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =
728    let val lt = toDconLty d typ    let val lt = toDconLty d typ
729        val rep' = mkRep(rep, lt)        val rep' = mkRep(rep, lt)
730        val dc = (name, rep', lt)        val dc = (name, rep', lt)
731        val ts' = map (TT.toTyc d) ts        val ts' = map (toTyc d) ts
732     in if const then CON'(dc, ts', unitLexp)     in if const then CON'(dc, ts', unitLexp)
733        else (case apOp        else (case apOp
734               of SOME le => CON'(dc, ts', le)               of SOME le => CON'(dc, ts', le)
# Line 741  Line 740 
740    end    end
741    
742  fun mkStr (s as M.STR{access, info, ...}, d) =  fun mkStr (s as M.STR{access, info, ...}, d) =
743        mkAccInfo(access, info, fn () => TM.strLty(s, d, compInfo))        mkAccInfo(access, info, fn () => strLty(s, d, compInfo))
744    | mkStr _ = bug "unexpected structures in mkStr"    | mkStr _ = bug "unexpected structures in mkStr"
745    
746  fun mkFct (f as M.FCT{access, info, ...}, d) =  fun mkFct (f as M.FCT{access, info, ...}, d) =
747        mkAccInfo(access, info, fn () => TM.fctLty(f, d, compInfo))        mkAccInfo(access, info, fn () => fctLty(f, d, compInfo))
748    | mkFct _ = bug "unexpected functors in mkFct"    | mkFct _ = bug "unexpected functors in mkFct"
749    
750  fun mkBnd d =  fun mkBnd d =
# Line 817  Line 816 
816                    val rules = [(fillPat(pat, d), b), (WILDpat, unitLexp)]                    val rules = [(fillPat(pat, d), b), (WILDpat, unitLexp)]
817                    val rootv = mkv()                    val rootv = mkv()
818                    fun finish x = LET(rootv, ee, x)                    fun finish x = LET(rootv, ee, x)
819                 in MC.bindCompile(env, rules, finish, rootv, d, complain)                 in MC.bindCompile(env, rules, finish, rootv, toTcLt d, complain)
820                end                end
821     in fold g vbs     in fold g vbs
822    end    end
# Line 827  Line 826 
826                   exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =                   exp, boundtvs=tvs, ...}, (vlist, tlist, elist)) =
827                 let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)                 let val ee = mkExp(exp, d) (* was mkPE(exp, d, tvs) *)
828                         (* we no longer track type bindings at RVB anymore ! *)                         (* we no longer track type bindings at RVB anymore ! *)
829                     val vt = TT.toLty d ty                     val vt = toLty d ty
830                  in (v::vlist, vt::tlist, ee::elist)                  in (v::vlist, vt::tlist, ee::elist)
831                 end                 end
832          | g _ = bug "unexpected valrec bindings in mkRVBs"          | g _ = bug "unexpected valrec bindings in mkRVBs"
# Line 871  Line 870 
870          | g (STRstr bs) = SRECORD (map (mkBnd d) bs)          | g (STRstr bs) = SRECORD (map (mkBnd d) bs)
871          | g (APPstr {oper, arg, argtycs}) =          | g (APPstr {oper, arg, argtycs}) =
872                let val e1 = mkFct(oper, d)                let val e1 = mkFct(oper, d)
873                    val tycs = map (TT.tpsTyc d) argtycs                    val tycs = map (tpsTyc d) argtycs
874                    val e2 = mkStr(arg, d)                    val e2 = mkStr(arg, d)
875                 in APP(TAPP(e1, tycs), e2)                 in APP(TAPP(e1, tycs), e2)
876                end                end
# Line 884  Line 883 
883  and mkFctexp (fe, d) =  and mkFctexp (fe, d) =
884    let fun g (VARfct f) = mkFct(f, d)    let fun g (VARfct f) = mkFct(f, d)
885          | g (FCTfct{param as M.STR{access=DA.LVAR v, ...}, argtycs, def}) =          | g (FCTfct{param as M.STR{access=DA.LVAR v, ...}, argtycs, def}) =
886                let val knds = map TT.tpsKnd argtycs                let val knds = map tpsKnd argtycs
887                    val nd = DI.next d                    val nd = DI.next d
888                    val body = mkStrexp (def, nd)                    val body = mkStrexp (def, nd)
889                    val hdr = buildHdr v                    val hdr = buildHdr v
890                    (* binding of all v's components *)                    (* binding of all v's components *)
891                 in TFN(knds, FN(v, TM.strLty(param, nd, compInfo), hdr body))                 in TFN(knds, FN(v, strLty(param, nd, compInfo), hdr body))
892                end                end
893          | g (LETfct (dec, b)) = mkDec (dec, d) (g b)          | g (LETfct (dec, b)) = mkDec (dec, d) (g b)
894          | g (MARKfct (b, reg)) = withRegion reg g b          | g (MARKfct (b, reg)) = withRegion reg g b
# Line 929  Line 928 
928   *    val mkDec : A.dec * DI.depth -> L.lexp -> L.lexp                     *   *    val mkDec : A.dec * DI.depth -> L.lexp -> L.lexp                     *
929   *                                                                         *   *                                                                         *
930   ***************************************************************************)   ***************************************************************************)
 (*  
 and mkDec x = Stats.doPhase(Stats.makePhase "Compiler 048 mkDec") mkDec0 x  
 and mkExp x = Stats.doPhase(Stats.makePhase "Compiler 049 mkExp") mkExp0 x  
 *)  
931  and mkDec (dec, d) =  and mkDec (dec, d) =
932    let fun g (VALdec vbs) = mkVBs(vbs, d)    let fun g (VALdec vbs) = mkVBs(vbs, d)
933          | g (VALRECdec rvbs) = mkRVBs(rvbs, d)          | g (VALRECdec rvbs) = mkRVBs(rvbs, d)
# Line 952  Line 947 
947    end    end
948    
949  and mkExp (exp, d) =  and mkExp (exp, d) =
950    let val tTyc = TT.toTyc d    let val tTyc = toTyc d
951        val tLty = TT.toLty d        val tLty = toLty d
952    
953        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
954    
# Line 984  Line 979 
979               (** NOTE: the above won't work for cross compiling to               (** NOTE: the above won't work for cross compiling to
980                         multi-byte characters **)                         multi-byte characters **)
981    
982          | g (RECORDexp []) = INT 0          | g (RECORDexp []) = unitLexp
983          | g (RECORDexp xs) =          | g (RECORDexp xs) =
984               if sorted xs then RECORD (map (fn (_,e) => g e) xs)               if sorted xs then RECORD (map (fn (_,e) => g e) xs)
985               else let val vars = map (fn (l,e) => (l,(g e, mkv()))) xs               else let val vars = map (fn (l,e) => (l,(g e, mkv()))) xs
# Line 1008  Line 1003 
1003          | g (PACKexp(e, ty, tycs)) = g e          | g (PACKexp(e, ty, tycs)) = g e
1004  (*  (*
1005               let val (nty, ks, tps) = TU.reformat(ty, tycs, d)               let val (nty, ks, tps) = TU.reformat(ty, tycs, d)
1006                   val ts = map (TT.tpsTyc d) tps                   val ts = map (tpsTyc d) tps
1007                   (** use of LtyEnv.tcAbs is a temporary hack (ZHONG) **)                   (** use of LtyEnv.tcAbs is a temporary hack (ZHONG) **)
1008                   val nts = ListPair.map LtyEnv.tcAbs (ts, ks)                   val nts = ListPair.map LtyEnv.tcAbs (ts, ks)
1009                   val nd = DI.next d                   val nd = DI.next d
1010                in case (ks, tps)                in case (ks, tps)
1011                    of ([], []) => g e                    of ([], []) => g e
1012                     | _ => PACK(LT.ltc_poly(ks, [TT.toLty nd nty]), ts, nts , g e)                     | _ => PACK(LT.ltc_poly(ks, [toLty nd nty]),
1013                                   ts, nts , g e)
1014               end               end
1015  *)  *)
1016          | g (SEQexp [e]) = g e          | g (SEQexp [e]) = g e
# Line 1029  Line 1025 
1025               let val rootv = mkv()               let val rootv = mkv()
1026                   fun f x = FN(rootv, tLty ty, x)                   fun f x = FN(rootv, tLty ty, x)
1027                   val l' = mkRules l                   val l' = mkRules l
1028                in HANDLE(g e, MC.handCompile(env, l', f, rootv, d, complain))                in HANDLE(g e, MC.handCompile(env, l', f,
1029                                                rootv, toTcLt d, complain))
1030               end               end
1031    
1032          | g (FNexp (l, ty)) =          | g (FNexp (l, ty)) =
1033               let val rootv = mkv()               let val rootv = mkv()
1034                   fun f x = FN(rootv, tLty ty, x)                   fun f x = FN(rootv, tLty ty, x)
1035                in MC.matchCompile (env, mkRules l, f, rootv, d, complain)                in MC.matchCompile (env, mkRules l, f, rootv, toTcLt d, complain)
1036               end               end
1037    
1038          | g (CASEexp (ee, l, isMatch)) =          | g (CASEexp (ee, l, isMatch)) =
# Line 1044  Line 1041 
1041                   fun f x = LET(rootv, ee', x)                   fun f x = LET(rootv, ee', x)
1042                   val l' = mkRules l                   val l' = mkRules l
1043                in if isMatch                in if isMatch
1044                   then MC.matchCompile (env, l', f, rootv, d, complain)                   then MC.matchCompile (env, l', f, rootv, toTcLt d, complain)
1045                   else MC.bindCompile (env, l', f, rootv, d, complain)                   else MC.bindCompile (env, l', f, rootv, toTcLt d, complain)
1046               end               end
1047    
1048          | g (LETexp (dc, e)) = mkDec (dc, d) (g e)          | g (LETexp (dc, e)) = mkDec (dc, d) (g e)
# Line 1063  Line 1060 
1060   * closeLexp `closes' over all free (EXTERN) variables [`inlining' version]   * closeLexp `closes' over all free (EXTERN) variables [`inlining' version]
1061   *  - make sure that all operations on various imparative data structures   *  - make sure that all operations on various imparative data structures
1062   *    are carried out NOW and not later when the result function is called.   *    are carried out NOW and not later when the result function is called.
  *  
  * val closeLexp : PLambda.lexp  
  *                  -> (Lambda.lexp option list -> Lambda.lexp) * pid list  
1063   *)   *)
1064  fun closeLexp body =  fun closeLexp body =
1065    let (* free variable + pid + inferred lty *)    let (* free variable + pid + inferred lty *)
# Line 1074  Line 1068 
1068        (* the name of the `main' argument *)        (* the name of the `main' argument *)
1069        val imports = mkv ()        val imports = mkv ()
1070        val impVar = VAR (imports)        val impVar = VAR (imports)
   
1071        val impLty = LT.ltc_str (map (fn (_, (_, lt)) => lt) l)        val impLty = LT.ltc_str (map (fn (_, (_, lt)) => lt) l)
1072    
1073        fun h (_ :: xs, (_, (lvar, lt)) :: rest, i, lexp) =        fun h ((_, (lvar, lt)) :: rest, i, lexp) =
1074              let val hdr = buildHdr lvar              let val hdr = buildHdr lvar
1075                  val bindexp = LET(lvar, SELECT(i, impVar), hdr lexp)                  val bindexp = LET(lvar, SELECT(i, impVar), hdr lexp)
1076               in h (xs, rest, i + 1, bindexp)               in h (rest, i + 1, bindexp)
             end  
         | h ([], [], _, lexp) = FN (imports, impLty, lexp)  
         | h _ = bug "unexpected arguments in close"  
   
       fun genLexp inls =  
         let val plexp = h(inls, l, 0, body)  
   
       val _ = if !Control.CG.printLambda  
               then (say "\n\n[After Translation into PLambda ...]\n\n";  
                     PPLexp.printLexp plexp)  
               else ()  
   
   
          in if !Control.CG.flinton then  
               let val flexp = (FlintNM.norm plexp)  
   
       val _ = if !Control.CG.printLambda  
               then (say "\n\n[After Translation into FLINT ...]\n\n";  
                     PPFlint.printFundec flexp)  
               else ()  
   
                in (Flint2Lambda.transFundec flexp)  
               end  
             else NormLexp.normLexp plexp  
1077          end          end
1078            | h ([], _, lexp) = FN (imports, impLty, lexp)
1079    
1080     in {genLambda = (fn inls => genLexp inls),        val plexp = h(l, 0, body)
1081         importPids = (map #1 l)}     in {flint = FlintNM.norm plexp, imports = (map #1 l)}
1082    end    end
1083    
1084  val exportLexp = SRECORD (map VAR exportLvars)  val exportLexp = SRECORD (map VAR exportLvars)
# Line 1119  Line 1089 
1089  end (* top-level local *)  end (* top-level local *)
1090  end (* structure Translate *)  end (* structure Translate *)
1091    
 (*  
  * $Log: translate.sml,v $  
  * Revision 1.9  1997/08/15  16:05:26  jhr  
  *   Bug fix to lift free structure references outside closures [zsh].  
  *  
  * Revision 1.8  1997/05/05  20:00:17  george  
  *   Change the term language into the quasi-A-normal form. Added a new round  
  *   of lambda contraction before and after type specialization and  
  *   representation analysis. Type specialization including minimum type  
  *   derivation is now turned on all the time. Real array is now implemented  
  *   as realArray. A more sophisticated partial boxing scheme is added and  
  *   used as the default.  
  *  
  * Revision 1.7  1997/04/18  15:49:04  george  
  *   Cosmetic changes on some constructor names. Changed the shape for  
  *   FIX type to potentially support shared dtsig. -- zsh  
  *  
  * Revision 1.6  1997/04/08  19:42:15  george  
  *   Fixed a bug in inlineShift operations. The test to determine if the  
  *   shift amount is within range should always an UINT 31 comparison --  
  *   regardless of the entity being shifted.  
  *  
  * Revision 1.5  1997/03/25  13:41:44  george  
  *   Fixing the coredump bug caused by duplicate top-level declarations.  
  *   For example, in almost any versions of SML/NJ, typing  
  *           val x = "" val x = 3  
  *   would lead to core dump. This is avoided by changing the "exportLexp"  
  *   field returned by the pickling function (pickle/picklemod.sml) into  
  *   a list of lambdavars, and then during the pretty-printing (print/ppdec.sml),  
  *   each variable declaration is checked to see if it is in the "exportLvars"  
  *   list, if true, it will be printed as usual, otherwise, the pretty-printer  
  *   will print the result as <hiddle-value>.  
  *                                              -- zsh  
  *  
  * Revision 1.4  1997/03/22  18:25:25  dbm  
  * Added temporary debugging code.  This could be cleaned out later.  
  *  
  * Revision 1.3  1997/02/26  21:54:48  george  
  *   Putting back the access-lifting code to avoid the "exportFn image blowup"  
  *   bug --- BUG 1142.  
  *  
  * Revision 1.1.1.1  1997/01/14  01:38:47  george  
  *   Version 109.24  
  *  
  *)  
   

Legend:
Removed from v.24  
changed lines
  Added in v.45

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