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

sml/branches/SMLNJ/src/compiler/FLINT/trans/translate.sml revision 93, Tue May 12 21:56:22 1998 UTC sml/trunk/src/compiler/FLINT/trans/translate.sml revision 102, Thu May 14 05:53:10 1998 UTC
# Line 8  Line 8 
8    val transDec : Absyn.dec * Access.lvar list    val transDec : Absyn.dec * Access.lvar list
9                   * StaticEnv.staticEnv * CompBasic.compInfo                   * StaticEnv.staticEnv * CompBasic.compInfo
10                   -> {flint: FLINT.prog,                   -> {flint: FLINT.prog,
11                       imports: PersStamps.persstamp list}                       imports: (PersStamps.persstamp
12                                   * CompBasic.importTree) list}
13    
14  end (* signature TRANSLATE *)  end (* signature TRANSLATE *)
15    
# Line 28  Line 29 
29        structure PO = PrimOp        structure PO = PrimOp
30        structure PP = PrettyPrint        structure PP = PrettyPrint
31        structure S  = Symbol        structure S  = Symbol
32          structure SP = SymPath
33        structure LN = LiteralToNum        structure LN = LiteralToNum
34        structure TT = TransTypes        structure TT = TransTypes
35        structure TP = Types        structure TP = Types
# Line 56  Line 58 
58  fun ident x = x  fun ident x = x
59  val unitLexp = RECORD []  val unitLexp = RECORD []
60    
61    fun getNameOp p = if SP.null p then NONE else SOME(SP.last p)
62    
63  type pid = PersStamps.persstamp  type pid = PersStamps.persstamp
64    
65  (** old-style fold for cases where it is partially applied *)  (** old-style fold for cases where it is partially applied *)
# Line 68  Line 72 
72   * with the mkv in "compInfo" ? (ZHONG)   * with the mkv in "compInfo" ? (ZHONG)
73   *)   *)
74  val mkv = LambdaVar.mkLvar  val mkv = LambdaVar.mkLvar
75    fun mkvN NONE = mkv()
76      | mkvN (SOME s) = LambdaVar.namedLvar s
77    
78  (** sorting the record fields for record types and record expressions *)  (** sorting the record fields for record types and record expressions *)
79  fun elemgtr ((LABEL{number=x,...},_),(LABEL{number=y,...},_)) = (x>y)  fun elemgtr ((LABEL{number=x,...},_),(LABEL{number=y,...},_)) = (x>y)
80  fun sorted x = Sort.sorted elemgtr x  fun sorted x = Sort.sorted elemgtr x
81  fun sortrec x = Sort.sort elemgtr x  fun sortrec x = Sort.sort elemgtr x
82    
83    (** check if an access is external *)
84    fun extern (DA.EXTERN _) = true
85      | extern (DA.PATH(a, _)) = extern a
86      | extern _ = false
87    
88  (** an exception raised if coreEnv is not available *)  (** an exception raised if coreEnv is not available *)
89  exception NoCore  exception NoCore
90    
91  (****************************************************************************  (****************************************************************************
92   *                          MAIN FUNCTION                                   *   *                          MAIN FUNCTION                                   *
93   *                                                                          *   *                                                                          *
94   *  val transDec: Absyn.dec * Lambda.lexp * StaticEnv.staticEnv             *   *  val transDec : Absyn.dec * Access.lvar list                             *
95   *                * ElabUtil.compInfo                                       *   *                 * StaticEnv.staticEnv * CompBasic.compInfo               *
96   *                -> {genLambda : Lambda.lexp option list -> Lambda.lexp,   *   *                 -> {flint: FLINT.prog,                                   *
97   *                    importPids : PersStamps.persstamp list}               *   *                     imports: (PersStamps.persstamp                       *
98   *                                                                          *   *                               * CompBasic.importTree) list}              *
99   ****************************************************************************)   ****************************************************************************)
100    
101  fun transDec (rootdec, exportLvars, env,  fun transDec (rootdec, exportLvars, env,
# Line 153  Line 164 
164    
165  end (* markexn-local *)  end (* markexn-local *)
166    
167  (**************** a temporary fix for the exportFn bug ****************)  (***************************************************************************
168     *          SHARING AND LIFTING OF STRUCTURE IMPORTS AND ACCESSES          *
169     ***************************************************************************)
170    
171  exception HASHTABLE  exception HASHTABLE
172  type key = int  type key = int
173    
174  (** hashkey of accesspath + accesspath + encoding of typ params + resvar *)  (** hashkey of accesspath + accesspath + resvar *)
175  type info = (key * int list * tyc * lvar)  type info = (key * int list * lvar)
176  val hashtable : info list Intmap.intmap = Intmap.new(32,HASHTABLE)  val hashtable : info list Intmap.intmap = Intmap.new(32,HASHTABLE)
177  fun hashkey l = foldr (fn (x,y) => ((x * 10 + y) mod 1019)) 0 l  fun hashkey l = foldr (fn (x,y) => ((x * 10 + y) mod 1019)) 0 l
178    
179  fun toHt NONE = LT.tcc_void  fun buildHdr v =
   | toHt (SOME(ts)) = LT.tcc_tuple ts  
   
 fun fromHt x = if LT.tc_eqv(x, LT.tcc_void) then NONE else SOME(LT.tcd_tuple x)  
   
 fun buildHdr(v) =  
180    let val info = Intmap.map hashtable v    let val info = Intmap.map hashtable v
181        fun h((_, l, tsEnc, w), hdr) =        fun h((_, l, w), hdr) =
182               let val le = foldl (fn (k,e) => SELECT(k,e)) (VAR v) l               let val le = foldl (fn (k,e) => SELECT(k,e)) (VAR v) l
183                   val be = case (fromHt tsEnc)                in fn e => hdr(LET(w, le, e))
                            of NONE => le  
                             | SOME ts => TAPP(le, ts)  
               in fn e => hdr(LET(w, be, e))  
184               end               end
185     in foldr h ident info     in foldr h ident info
186    end handle _ => ident    end handle _ => ident
187    
188  fun lookbind(v, l, tsOp) =  fun bindvar (v, [], _) =  v
189      | bindvar (v, l, nameOp) =
190    let val info = (Intmap.map hashtable v) handle _ => []    let val info = (Intmap.map hashtable v) handle _ => []
191        val key = hashkey l        val key = hashkey l
192        val tsEnc = toHt tsOp            fun h [] =
193                    let val u = mkvN nameOp
194        fun h [] = (let val u = mkv()                   in Intmap.add hashtable (v,(key,l,u)::info); u
195                     in Intmap.add hashtable (v,(key,l,tsEnc,u)::info); u                  end
196                    end)              | h((k',l',w)::r) =
197          | h((k',l', t', w)::r) =                  if (k' = key) then (if (l'=l) then w else h r) else h r
              if ((k' = key) andalso LT.tc_eqv(t', tsEnc))  
              then (if (l'=l) then w else h r) else h r  
198     in h info     in h info
199    end    end
200    
201  fun bindvar(v, [], NONE) = v  datatype pidInfo = ANON of (int * pidInfo) list
202    | bindvar(v, l, tsOp) = lookbind(v, l, tsOp)                   | NAMED of lvar * lty * (int * pidInfo) list
203    
204    fun mkPidInfo (t, l, nameOp) =
205      let val v = mkvN nameOp
206          fun h [] = NAMED(v, t, [])
207            | h (a::r) = ANON [(a, h r)]
208       in (h l, v)
209      end
210    
211    fun mergePidInfo (pi, t, l, nameOp) =
212      let fun h (z as NAMED(v,_,_), []) = (z, v)
213            | h (ANON xl, [])  =
214                  let val v = mkvN nameOp
215                   in (NAMED(v, t, xl), v)
216                  end
217            | h (z, a::r) =
218                  let val (xl, mknode) =
219                        case z of ANON c => (c, ANON)
220                                | NAMED (v,tt,c) => (c, fn x => NAMED(v,tt,x))
221    
222                      fun dump ((np, v), z, y) =
223                            let val nz = (a, np)::z
224                             in (mknode((rev y) @ nz), v)
225                            end
226    
227                      fun look ([], y) = dump(mkPidInfo(t, r, nameOp), [], y)
228                        | look (u as ((x as (i,pi))::z), y) =
229                            if i < a then look(z, x::y)
230                            else if i = a then dump(h(pi, r), z, y)
231                                 else dump(mkPidInfo(t, r, nameOp), u, y)
232    
233                   in look(xl, [])
234                  end
235       in h(pi, l)
236      end (* end of mergePidInfo *)
237    
238  (** a map that stores information about external references *)  (** a map that stores information about external references *)
239  val persmap = ref (Map.empty : (lvar * LT.lty) Map.map)  val persmap = ref (Map.empty : pidInfo Map.map)
240    
241  fun mkPid (pid, t, l) =  fun mkPid (pid, t, l, nameOp) =
242    (let val (var, t0) = Map.lookup (!persmap) pid    (let val pinfo = Map.lookup (!persmap) pid
243      in (persmap := Map.add(Map.delete(pid, !persmap),         val (npinfo, var) = mergePidInfo (pinfo, t, l, nameOp)
244                             pid, (var, LT.lt_merge(t0, t))));      in persmap := Map.add(Map.delete(pid, !persmap), pid, npinfo); var
        bindvar(var, l, (* tsOp *) NONE)  
245     end handle Map.MapF =>     end handle Map.MapF =>
246           let val nv = mkv()           let val (pinfo, var) = mkPidInfo (t, l, nameOp)
247            in (persmap := Map.add(!persmap, pid, (nv, t));            in persmap := Map.add(!persmap, pid, pinfo); var
               bindvar(nv, l, (* tsOp *) NONE))  
248           end)           end)
249    
250  (** converting an access w. type into a lambda expression *)  (** converting an access w. type into a lambda expression *)
251  fun mkAccT (p, t) =  fun mkAccT (p, t, nameOp) =
252    let fun h(DA.LVAR v, l) = bindvar(v, l, NONE)    let fun h(DA.LVAR v, l) = bindvar(v, l, nameOp)
253          | h(DA.EXTERN pid, l) =          | h(DA.EXTERN pid, l) = mkPid(pid, t, l, nameOp)
              (let val nt = foldr (fn (k,b) => LT.ltc_pst[(k,b)]) t l  
                in mkPid(pid, nt, l)  
               end)  
254          | h(DA.PATH(a,i), l) = h(a, i::l)          | h(DA.PATH(a,i), l) = h(a, i::l)
255          | h _ = bug "unexpected access in mkAccT"          | h _ = bug "unexpected access in mkAccT"
256     in VAR (h(p, []))     in VAR (h(p, []))
257    end (* new def for mkAccT *)    end (* new def for mkAccT *)
258    
259  (** converting an access into a lambda expression *)  (** converting an access into a lambda expression *)
260  fun mkAcc p =  fun mkAcc (p, nameOp) =
261    let fun h(DA.LVAR v, l) = bindvar(v, l, NONE)    let fun h(DA.LVAR v, l) = bindvar(v, l, nameOp)
262          | h(DA.PATH(a,i), l) = h(a, i::l)          | h(DA.PATH(a,i), l) = h(a, i::l)
263          | h _ = bug "unexpected access in mkAcc"          | h _ = bug "unexpected access in mkAcc"
264     in VAR (h(p, []))     in VAR (h(p, []))
# Line 242  Line 276 
276    ((case coreLookup(id, coreEnv)    ((case coreLookup(id, coreEnv)
277       of V.CON(TP.DATACON{name, rep as DA.EXN _, typ, ...}) =>       of V.CON(TP.DATACON{name, rep as DA.EXN _, typ, ...}) =>
278            let val nt = toDconLty DI.top typ            let val nt = toDconLty DI.top typ
279                val nrep = mkRep(rep, nt)                val nrep = mkRep(rep, nt, name)
280             in CON'((name, nrep, nt), [], unitLexp)             in CON'((name, nrep, nt), [], unitLexp)
281            end            end
282        | _ => bug "coreExn in translate")        | _ => bug "coreExn in translate")
# Line 250  Line 284 
284    
285  and coreAcc id =  and coreAcc id =
286    ((case coreLookup(id, coreEnv)    ((case coreLookup(id, coreEnv)
287       of V.VAL(V.VALvar{access, typ, ...}) =>       of V.VAL(V.VALvar{access, typ, path, ...}) =>
288             mkAccT(access, toLty DI.top (!typ))             mkAccT(access, toLty DI.top (!typ), getNameOp path)
289        | _ => bug "coreAcc in translate")        | _ => bug "coreAcc in translate")
290     handle NoCore => (say "WARNING: no Core access \n"; INT 0))     handle NoCore => (say "WARNING: no Core access \n"; INT 0))
291    
292    
293  (** expands the flex record pattern and convert the EXN access pat *)  (** expands the flex record pattern and convert the EXN access pat *)
294  (** internalize the conrep's access, always exceptions *)  (** internalize the conrep's access, always exceptions *)
295  and mkRep (rep, lt) =  and mkRep (rep, lt, name) =
296    let fun g (DA.LVAR v, l, t)  = bindvar(v, l, NONE)    let fun g (DA.LVAR v, l, t)  = bindvar(v, l, SOME name)
297          | g (DA.PATH(a, i), l, t) = g(a, i::l, LT.ltc_pst [(i, t)])          | g (DA.PATH(a, i), l, t) = g(a, i::l, t)
298          | g (DA.EXTERN p, l, t) = mkPid(p, t, l)          | g (DA.EXTERN p, l, t) = mkPid(p, t, l, SOME name)
299          | g _ = bug "unexpected access in mkRep"          | g _ = bug "unexpected access in mkRep"
300    
301     in case rep     in case rep
# Line 277  Line 311 
311          | _ => rep          | _ => rep
312    end    end
313    
 (** converting a non-value-carrying exn into a lambda expression *)  
 fun mkExnAcc acc = mkAccT (acc, LT.ltc_exn)  
   
314  (** converting a value of access+info into the lambda expression *)  (** converting a value of access+info into the lambda expression *)
315  fun mkAccInfo (acc, info, getLty) =  fun mkAccInfo (acc, info, getLty, nameOp) =
316    let fun extern (DA.EXTERN _) = true    if extern acc then mkAccT(acc, getLty(), nameOp) else mkAcc (acc, nameOp)
         | extern (DA.PATH(a, _)) = extern a  
         | extern _ = false  
   
    in if extern acc then mkAccT(acc, getLty()) else mkAcc acc  
   end  
317    
318  fun fillPat(pat, d) =  fun fillPat(pat, d) =
319    let fun fill (CONSTRAINTpat (p,t)) = fill p    let fun fill (CONSTRAINTpat (p,t)) = fill p
# Line 325  Line 351 
351          | fill (ORpat(p1, p2)) = ORpat(fill p1, fill p2)          | fill (ORpat(p1, p2)) = ORpat(fill p1, fill p2)
352          | fill (CONpat(TP.DATACON{name, const, typ, rep, sign}, ts)) =          | fill (CONpat(TP.DATACON{name, const, typ, rep, sign}, ts)) =
353              CONpat(TP.DATACON{name=name, const=const, typ=typ,              CONpat(TP.DATACON{name=name, const=const, typ=typ,
354                          sign=sign, rep=mkRep(rep, toDconLty d typ)}, ts)                          sign=sign, rep=mkRep(rep, toDconLty d typ, name)}, ts)
355          | fill (APPpat(TP.DATACON{name, const, typ, rep, sign}, ts, pat)) =          | fill (APPpat(TP.DATACON{name, const, typ, rep, sign}, ts, pat)) =
356              APPpat(TP.DATACON{name=name, const=const, typ=typ, sign=sign,              APPpat(TP.DATACON{name=name, const=const, typ=typ, sign=sign,
357                         rep=mkRep(rep, toDconLty d typ)}, ts, fill pat)                         rep=mkRep(rep, toDconLty d typ, name)}, ts, fill pat)
358          | fill xp = xp          | fill xp = xp
359    
360     in fill pat     in fill pat
# Line 693  Line 719 
719   *   val mkBnd : DI.depth -> B.binding -> L.lexp                           *   *   val mkBnd : DI.depth -> B.binding -> L.lexp                           *
720   *                                                                         *   *                                                                         *
721   ***************************************************************************)   ***************************************************************************)
722  fun mkVar (v as V.VALvar{access, info, typ, ...}, d) =  fun mkVar (v as V.VALvar{access, info, typ, path}, d) =
723        mkAccInfo(access, info, fn () => toLty d (!typ))        mkAccInfo(access, info, fn () => toLty d (!typ), getNameOp path)
724    | mkVar _ = bug "unexpected vars in mkVar"    | mkVar _ = bug "unexpected vars in mkVar"
725    
726  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) =
# Line 726  Line 752 
752    
753  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =
754    let val lt = toDconLty d typ    let val lt = toDconLty d typ
755        val rep' = mkRep(rep, lt)        val rep' = mkRep(rep, lt, name)
756        val dc = (name, rep', lt)        val dc = (name, rep', lt)
757        val ts' = map (toTyc d) ts        val ts' = map (toTyc d) ts
758     in if const then CON'(dc, ts', unitLexp)     in if const then CON'(dc, ts', unitLexp)
# Line 740  Line 766 
766    end    end
767    
768  fun mkStr (s as M.STR{access, info, ...}, d) =  fun mkStr (s as M.STR{access, info, ...}, d) =
769        mkAccInfo(access, info, fn () => strLty(s, d, compInfo))        mkAccInfo(access, info, fn () => strLty(s, d, compInfo), NONE)
770    | mkStr _ = bug "unexpected structures in mkStr"    | mkStr _ = bug "unexpected structures in mkStr"
771    
772  fun mkFct (f as M.FCT{access, info, ...}, d) =  fun mkFct (f as M.FCT{access, info, ...}, d) =
773        mkAccInfo(access, info, fn () => fctLty(f, d, compInfo))        mkAccInfo(access, info, fn () => fctLty(f, d, compInfo), NONE)
774    | mkFct _ = bug "unexpected functors in mkFct"    | mkFct _ = bug "unexpected functors in mkFct"
775    
776  fun mkBnd d =  fun mkBnd d =
777    let fun g (B.VALbind v) = mkVar(v, d)    let fun g (B.VALbind v) = mkVar(v, d)
778          | g (B.STRbind s) = mkStr(s, d)          | g (B.STRbind s) = mkStr(s, d)
779          | g (B.FCTbind f) = mkFct(f, d)          | g (B.FCTbind f) = mkFct(f, d)
780          | g (B.CONbind (TP.DATACON{rep=(DA.EXN acc), typ, ...})) =          | g (B.CONbind (TP.DATACON{rep=(DA.EXN acc), name, typ, ...})) =
781                let val nt = toDconLty d typ                let val nt = toDconLty d typ
782                    val (argt,_) = LT.ltd_parrow nt                    val (argt,_) = LT.ltd_parrow nt
783                 in mkAccT (acc, LT.ltc_etag argt)                 in mkAccT (acc, LT.ltc_etag argt, SOME name)
784                end                end
785          | g _ = bug "unexpected bindings in mkBnd"          | g _ = bug "unexpected bindings in mkBnd"
786     in g     in g
# Line 843  Line 869 
869                    val (argt, _) = LT.ltd_parrow nt                    val (argt, _) = LT.ltd_parrow nt
870                 in LET(v, ETAG(mkExp(ident, d), argt), b)                 in LET(v, ETAG(mkExp(ident, d), argt), b)
871                end                end
872          | g (EBdef {exn=TP.DATACON{rep=DA.EXN(DA.LVAR v), typ, ...},          | g (EBdef {exn=TP.DATACON{rep=DA.EXN(DA.LVAR v), typ, name, ...},
873                      edef=TP.DATACON{rep=DA.EXN(acc), ...}}, b) =                      edef=TP.DATACON{rep=DA.EXN(acc), ...}}, b) =
874                let val nt = toDconLty d typ                let val nt = toDconLty d typ
875                    val (argt, _) = LT.ltd_parrow nt                    val (argt, _) = LT.ltd_parrow nt
876                 in LET(v, mkAccT(acc, LT.ltc_etag argt), b)                 in LET(v, mkAccT(acc, LT.ltc_etag argt, SOME name), b)
877                end                end
878          | g _ = bug "unexpected exn bindings in mkEBs"          | g _ = bug "unexpected exn bindings in mkEBs"
879    
# Line 942  Line 968 
968                let val f = withRegion reg g x                let val f = withRegion reg g x
969                 in fn y => withRegion reg f y                 in fn y => withRegion reg f y
970                end                end
971            | g (OPENdec xs) =
972                  let (* special hack to make the import tree simpler *)
973                      fun mkos (_, s as M.STR{access=acc, ...}) =
974                            if extern acc then
975                              let val _ = mkAccT(acc, strLty(s, d, compInfo), NONE)
976                               in ()
977                              end
978                            else ()
979                        | mkos _ = ()
980                   in app mkos xs; ident
981                  end
982          | g _ = ident          | g _ = ident
983     in g dec     in g dec
984    end    end
# Line 1056  Line 1093 
1093    end    end
1094    
1095    
1096    (* wrapPidInfo: lexp * (pid * pidInfo) list -> lexp * importTree *)
1097    fun wrapPidInfo (body, pidinfos) =
1098      let val imports =
1099            let fun p2itree (ANON xl) =
1100                      CB.ITNODE (map (fn (i,z) => (i, p2itree z)) xl)
1101                  | p2itree (NAMED _) = CB.ITNODE []
1102             in map (fn (p, pi) => (p, p2itree pi)) pidinfos
1103            end
1104  (*  (*
1105   * closeLexp `closes' over all free (EXTERN) variables [`inlining' version]        val _ = let val _ = say "\n ****************** \n"
1106   *  - make sure that all operations on various imparative data structures                    val _ = say "\n the current import tree is :\n"
1107   *    are carried out NOW and not later when the result function is called.                    fun tree (CB.ITNODE []) = ["\n"]
1108   *)                      | tree (CB.ITNODE xl) =
1109  fun closeLexp body =                          foldr (fn ((i, x), z) =>
1110    let (* free variable + pid + inferred lty *)                            let val ts = tree x
1111        val l: (pid * (lvar * LT.lty)) list = Map.members (!persmap)                                val u = (Int.toString i)  ^ "   "
1112                               in (map (fn y => (u ^ y)) ts) @ z
1113        (* the name of the `main' argument *)                            end) [] xl
1114        val imports = mkv ()                    fun pp (p, n) =
1115        val impVar = VAR (imports)                      (say ("Pid " ^ (PersStamps.toHex p) ^ "\n");
1116        val impLty = LT.ltc_str (map (fn (_, (_, lt)) => lt) l)                       app say (tree n))
1117                   in app pp imports; say "\n ****************** \n"
       fun h ((_, (lvar, lt)) :: rest, i, lexp) =  
             let val hdr = buildHdr lvar  
                 val bindexp = LET(lvar, SELECT(i, impVar), hdr lexp)  
              in h (rest, i + 1, bindexp)  
1118              end              end
1119          | h ([], _, lexp) = FN (imports, impLty, lexp)  *)
1120          val plexp =
1121        val plexp = h(l, 0, body)          let fun get ((_, ANON xl), z) = foldl get z xl
1122     in {flint = FlintNM.norm plexp, imports = (map #1 l)}                | get ((_, u as NAMED (_,t,_)), (n,cs,ts)) =
1123                      (n+1, (n,u)::cs, t::ts)
1124    
1125                (* get the fringe information *)
1126                val getp = fn ((_, pi), z) => get((0, pi), z)
1127                val (finfos, lts) =
1128                  let val (_, fx, lx) = foldl getp (0,[],[]) pidinfos
1129                   in (rev fx, rev lx)
1130                  end
1131    
1132                (* do the selection of all import variables *)
1133                fun mksel (u, xl, be) =
1134                  let fun g ((i, pi), be) =
1135                        let val (v, xs) = case pi of ANON z => (mkv(), z)
1136                                                   | NAMED(v,_,z) => (v, z)
1137                         in LET(v, SELECT(i, u), mksel(VAR v, xs, be))
1138                        end
1139                   in foldr g be xl
1140                  end
1141                val impvar = mkv()
1142                val implty = LT.ltc_str lts
1143                val nbody = mksel (VAR impvar, finfos, body)
1144             in FN(impvar, implty, nbody)
1145    end    end
1146       in (plexp, imports)
1147      end (* function wrapPidInfo *)
1148    
1149    (** the list of things being exported from the current compilation unit *)
1150  val exportLexp = SRECORD (map VAR exportLvars)  val exportLexp = SRECORD (map VAR exportLvars)
1151    
1152  in closeLexp (mkDec (rootdec, DI.top) exportLexp)  (** translating the ML absyn into the PLambda expression *)
1153    val body = mkDec (rootdec, DI.top) exportLexp
1154    
1155    (** wrapping up the body with the imported variables *)
1156    val (plexp, imports) = wrapPidInfo (body, Map.members (!persmap))
1157    
1158    fun prGen (flag,printE) s e =
1159      if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e) else ()
1160    val _ = prGen(Control.CG.printFlint, PPLexp.printLexp) "Translate" plexp
1161    
1162    (** normalizing the plambda expression into FLINT *)
1163    val flint = FlintNM.norm plexp
1164    
1165    in {flint = flint, imports = imports}
1166  end (* function transDec *)  end (* function transDec *)
1167    
1168  end (* top-level local *)  end (* top-level local *)

Legend:
Removed from v.93  
changed lines
  Added in v.102

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