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 733, Fri Nov 17 05:13:45 2000 UTC revision 1344, Wed Aug 13 18:04:08 2003 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 * Access.lvar list    val transDec : { rootdec: Absyn.dec,
9                   * StaticEnv.staticEnv * CompBasic.compInfo                     exportLvars: Access.lvar list,
10                       env: StaticEnv.staticEnv,
11                       cproto_conv: string,
12                       compInfo: Absyn.dec CompInfo.compInfo }
13                   -> {flint: FLINT.prog,                   -> {flint: FLINT.prog,
14                       imports: (PersStamps.persstamp                       imports: (PersStamps.persstamp
15                                 * CompBasic.importTree) list}                                 * ImportTree.importTree) list}
16    
17  end (* signature TRANSLATE *)  end (* signature TRANSLATE *)
18    
# Line 21  Line 24 
24        structure DA = Access        structure DA = Access
25        structure DI = DebIndex        structure DI = DebIndex
26        structure EM = ErrorMsg        structure EM = ErrorMsg
       structure CB = CompBasic  
27        structure II = InlInfo        structure II = InlInfo
28        structure LT = PLambdaType        structure LT = PLambdaType
29        structure M  = Modules        structure M  = Modules
# Line 65  Line 67 
67  (** old-style fold for cases where it is partially applied *)  (** old-style fold for cases where it is partially applied *)
68  fun fold f l init = foldr f init l  fun fold f l init = foldr f init l
69    
 (*  
  * MAJOR CLEANUP REQUIRED ! The function mkv is currently directly taken  
  * from the LambdaVar module; I think it should be taken from the  
  * "compInfo". Similarly, should we replace all mkLvar in the backend  
  * with the mkv in "compInfo" ? (ZHONG)  
  *)  
 val mkv = LambdaVar.mkLvar  
 fun mkvN NONE = mkv()  
   | mkvN (SOME s) = LambdaVar.namedLvar s  
   
70  (** sorting the record fields for record types and record expressions *)  (** sorting the record fields for record types and record expressions *)
71  fun elemgtr ((LABEL{number=x,...},_),(LABEL{number=y,...},_)) = (x>y)  fun elemgtr ((LABEL{number=x,...},_),(LABEL{number=y,...},_)) = (x>y)
72  fun sorted x = ListMergeSort.sorted elemgtr x  fun sorted x = ListMergeSort.sorted elemgtr x
# Line 95  Line 87 
87   *                 * StaticEnv.staticEnv * CompBasic.compInfo               *   *                 * StaticEnv.staticEnv * CompBasic.compInfo               *
88   *                 -> {flint: FLINT.prog,                                   *   *                 -> {flint: FLINT.prog,                                   *
89   *                     imports: (PersStamps.persstamp                       *   *                     imports: (PersStamps.persstamp                       *
90   *                               * CompBasic.importTree) list}              *   *                               * ImportTree.importTree) list}             *
91   ****************************************************************************)   ****************************************************************************)
92    
93  fun transDec (rootdec, exportLvars, env,  fun transDec
94                compInfo as {errorMatch,error,...}: CB.compInfo) =          { rootdec, exportLvars, env, cproto_conv,
95             compInfo as {errorMatch,error,...}: Absyn.dec CompInfo.compInfo } =
96  let  let
97    
98    (* We take mkLvar from compInfo.  This should answer Zhong's question... *)
99    (*
100    (*
101     * MAJOR CLEANUP REQUIRED ! The function mkv is currently directly taken
102     * from the LambdaVar module; I think it should be taken from the
103     * "compInfo". Similarly, should we replace all mkLvar in the backend
104     * with the mkv in "compInfo" ? (ZHONG)
105     *)
106    val mkv = LambdaVar.mkLvar
107    fun mkvN NONE = mkv()
108      | mkvN (SOME s) = LambdaVar.namedLvar s
109    *)
110    
111    val mkvN = #mkLvar compInfo
112    fun mkv () = mkvN NONE
113    
114  (** generate the set of ML-to-FLINT type translation functions *)  (** generate the set of ML-to-FLINT type translation functions *)
115  val {tpsKnd, tpsTyc, toTyc, toLty, strLty, fctLty} = TT.genTT()  val {tpsKnd, tpsTyc, toTyc, toLty, strLty, fctLty, markLBOUND} =
116        TT.genTT()
117  fun toTcLt d = (toTyc d, toLty d)  fun toTcLt d = (toTyc d, toLty d)
118    
119  (** translating the typ field in DATACON into lty; constant datacons  (** translating the typ field in DATACON into lty; constant datacons
# Line 282  Line 292 
292   * clean up this is to put all the core constructors and primitives into   * clean up this is to put all the core constructors and primitives into
293   * the primitive environment. (ZHONG)   * the primitive environment. (ZHONG)
294   *)   *)
295    exception NoCore
296    
297  fun coreExn id =  fun coreExn id =
298    ((case coreLookup(id, env)      (case CoreAccess.getCon' (fn () => raise NoCore) (env, id) of
299       of V.CON(TP.DATACON{name, rep as DA.EXN _, typ, ...}) =>           TP.DATACON { name, rep as DA.EXN _, typ, ... } =>
300            let val nt = toDconLty DI.top typ            let val nt = toDconLty DI.top typ
301                val nrep = mkRep(rep, nt, name)                val nrep = mkRep(rep, nt, name)
302             in CON'((name, nrep, nt), [], unitLexp)             in CON'((name, nrep, nt), [], unitLexp)
303            end            end
304        | _ => bug "coreExn in translate")        | _ => bug "coreExn in translate")
305     handle NoCore => (say "WARNING: no Core access \n"; INT 0))      handle NoCore => (say "WARNING: no Core access\n"; INT 0)
306    
307  and coreAcc id =  and coreAcc id =
308    ((case coreLookup(id, env)      (case CoreAccess.getVar' (fn () => raise NoCore) (env, id) of
309       of V.VAL(V.VALvar{access, typ, path, ...}) =>           V.VALvar { access, typ, path, ... } =>
310             mkAccT(access, toLty DI.top (!typ), getNameOp path)             mkAccT(access, toLty DI.top (!typ), getNameOp path)
311        | _ => bug "coreAcc in translate")        | _ => bug "coreAcc in translate")
312     handle NoCore => (say "WARNING: no Core access \n"; INT 0))      handle NoCore => (say "WARNING: no Core access\n"; INT 0)
   
313    
314  (** expands the flex record pattern and convert the EXN access pat *)  (** expands the flex record pattern and convert the EXN access pat *)
315  (** internalize the conrep's access, always exceptions *)  (** internalize the conrep's access, always exceptions *)
# Line 339  Line 350 
350                               (typ := t; labels)                               (typ := t; labels)
351                    | find _ = (complain EM.COMPLAIN "unresolved flexible record"                    | find _ = (complain EM.COMPLAIN "unresolved flexible record"
352                                (fn ppstrm =>                                (fn ppstrm =>
353                                      (PP.add_newline ppstrm;                                      (PP.newline ppstrm;
354                                       PP.add_string ppstrm "pattern: ";                                       PP.string ppstrm "pattern: ";
355                                       PPAbsyn.ppPat env ppstrm                                       PPAbsyn.ppPat env ppstrm
356                                          (pat,!Control.Print.printDepth)));                                          (pat,!Control.Print.printDepth)));
357                                 raise DontBother)                                 raise DontBother)
# Line 407  Line 418 
418  val lt_int = LT.ltc_int  val lt_int = LT.ltc_int
419  val lt_int32 = LT.ltc_int32  val lt_int32 = LT.ltc_int32
420  val lt_bool = LT.ltc_bool  val lt_bool = LT.ltc_bool
421    val lt_unit = LT.ltc_unit
422    
423  val lt_ipair = lt_tup [lt_int, lt_int]  val lt_ipair = lt_tup [lt_int, lt_int]
424  val lt_icmp = lt_arw (lt_ipair, lt_bool)  val lt_icmp = lt_arw (lt_ipair, lt_bool)
425  val lt_ineg = lt_arw (lt_int, lt_int)  val lt_ineg = lt_arw (lt_int, lt_int)
426  val lt_intop = lt_arw (lt_ipair, lt_int)  val lt_intop = lt_arw (lt_ipair, lt_int)
427    val lt_u_u = lt_arw (lt_unit, lt_unit)
428    
429  val boolsign = BT.boolsign  val boolsign = BT.boolsign
430  val (trueDcon', falseDcon') =  val (trueDcon', falseDcon') =
# Line 433  Line 446 
446     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))
447    end    end
448    
 fun intOp p = PRIM(p, lt_intop, [])  
449  fun cmpOp p = PRIM(p, lt_icmp, [])  fun cmpOp p = PRIM(p, lt_icmp, [])
450  fun inegOp p = PRIM(p, lt_ineg, [])  fun inegOp p = PRIM(p, lt_ineg, [])
451    
 fun ADD(b,c) = APP(intOp(PO.IADD), RECORD[b, c])  
 fun SUB(b,c) = APP(intOp(PO.ISUB), RECORD[b, c])  
 fun MUL(b,c) = APP(intOp(PO.IMUL), RECORD[b, c])  
 fun DIV(b,c) = APP(intOp(PO.IDIV), RECORD[b, c])  
452  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}
453    
454  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])
# Line 490  Line 498 
498                            RECORD [vw, vcnt])))))                            RECORD [vw, vcnt])))))
499    end    end
500    
501    fun inlops nk = let
502        val (lt_arg, zero, overflow) =
503            case nk of
504                PO.INT 31 => (LT.ltc_int, INT 0, true)
505              | PO.UINT 31 => (LT.ltc_int, WORD 0w0, false)
506              | PO.INT 32 => (LT.ltc_int32, INT32 0, true)
507              | PO.UINT 32 => (LT.ltc_int32, WORD32 0w0, false)
508              | PO.FLOAT 64 => (LT.ltc_real, REAL "0.0", false)
509              | _ => bug "inlops: bad numkind"
510        val lt_argpair = lt_tup [lt_arg, lt_arg]
511        val lt_cmp = lt_arw (lt_argpair, lt_bool)
512        val lt_neg = lt_arw (lt_arg, lt_arg)
513        val less = PRIM (PO.CMP { oper = PO.<, kind = nk }, lt_cmp, [])
514        val greater = PRIM (PO.CMP { oper = PO.>, kind = nk }, lt_cmp, [])
515        val negate =
516            PRIM (PO.ARITH { oper = PO.~, overflow = overflow, kind = nk },
517                  lt_neg, [])
518    in
519        { lt_arg = lt_arg, lt_argpair = lt_argpair, lt_cmp = lt_cmp,
520          less = less, greater = greater,
521          zero = zero, negate = negate }
522    end
523    
524    fun inlminmax (nk, ismax) = let
525        val { lt_argpair, less, greater, lt_cmp, ... } = inlops nk
526        val x = mkv () and y = mkv () and z = mkv ()
527        val cmpop = if ismax then greater else less
528        val elsebranch =
529            case nk of
530                PO.FLOAT _ => let
531                    (* testing for NaN *)
532                    val fequal =
533                        PRIM (PO.CMP { oper = PO.EQL, kind = nk }, lt_cmp, [])
534                in
535                    COND (APP (fequal, RECORD [VAR y, VAR y]), VAR y, VAR x)
536                end
537              | _ => VAR y
538    in
539        FN (z, lt_argpair,
540            LET (x, SELECT (0, VAR z),
541                 LET (y, SELECT (1, VAR z),
542                      COND (APP (cmpop, RECORD [VAR x, VAR y]),
543                            VAR x, elsebranch))))
544    end
545    
546    fun inlabs nk = let
547        val { lt_arg, greater, zero, negate, ... } = inlops nk
548        val x = mkv ()
549    in
550        FN (x, lt_arg,
551            COND (APP (greater, RECORD [VAR x, zero]),
552                  VAR x, APP (negate, VAR x)))
553    end
554    
555  fun transPrim (prim, lt, ts) =  fun transPrim (prim, lt, ts) =
556    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))
# Line 500  Line 561 
561                 in inlineShift(rshiftOp, k, clear)                 in inlineShift(rshiftOp, k, clear)
562                end                end
563    
564          | g (PO.INLDIV) =          | g (PO.INLMIN nk) = inlminmax (nk, false)
565                let val a = mkv() and b = mkv() and z = mkv()          | g (PO.INLMAX nk) = inlminmax (nk, true)
566                 in FN(z, lt_ipair,          | g (PO.INLABS nk) = inlabs nk
567                      LET(a, SELECT(0, VAR z),  
                       LET(b, SELECT(1, VAR z),  
                         COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),  
                           COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),  
                                DIV(VAR a, VAR b),  
                                SUB(DIV(ADD(VAR a, INT 1), VAR b), INT 1)),  
                           COND(APP(cmpOp(PO.IGT), RECORD[VAR a, INT 0]),  
                                SUB(DIV(SUB(VAR a, INT 1), VAR b), INT 1),  
                                DIV(VAR a, VAR b))))))  
               end  
   
         | g (PO.INLMOD) =  
               let val a = mkv() and b = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(a,SELECT(0, VAR z),  
                       LET(b,SELECT(1,VAR z),  
                         COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),  
                           COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),  
                                SUB(VAR a, MUL(DIV(VAR a, VAR b), VAR b)),  
                                ADD(SUB(VAR a,MUL(DIV(ADD(VAR a,INT 1), VAR b),  
                                                  VAR b)), VAR b)),  
                           COND(APP(cmpOp(PO.IGT), RECORD[VAR a,INT 0]),  
                                ADD(SUB(VAR a,MUL(DIV(SUB(VAR a,INT 1), VAR b),  
                                                  VAR b)), VAR b),  
                                COND(APP(cmpOp(PO.IEQL),RECORD[VAR a,  
                                                          INT ~1073741824]),  
                                     COND(APP(cmpOp(PO.IEQL),  
                                              RECORD[VAR b,INT 0]),  
                                          INT 0,  
                                          SUB(VAR a, MUL(DIV(VAR a, VAR b),  
                                                     VAR b))),  
                                     SUB(VAR a, MUL(DIV(VAR a, VAR b),  
                                                    VAR b))))))))  
               end  
   
         | g (PO.INLREM) =  
               let val a = mkv() and b = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(a, SELECT(0,VAR z),  
                       LET(b, SELECT(1,VAR z),  
                           SUB(VAR a, MUL(DIV(VAR a,VAR b),VAR b)))))  
               end  
   
         | g (PO.INLMIN) =  
               let val x = mkv() and y = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(x, SELECT(0,VAR z),  
                        LET(y, SELECT(1,VAR z),  
                          COND(APP(cmpOp(PO.ILT), RECORD[VAR x,VAR y]),  
                               VAR x, VAR y))))  
               end  
         | g (PO.INLMAX) =  
               let val x = mkv() and y = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(x, SELECT(0,VAR z),  
                        LET(y, SELECT(1,VAR z),  
                          COND(APP(cmpOp(PO.IGT), RECORD[VAR x,VAR y]),  
                               VAR x, VAR y))))  
               end  
         | g (PO.INLABS) =  
               let val x = mkv()  
                in FN(x, lt_int,  
                      COND(APP(cmpOp(PO.IGT), RECORD[VAR x,INT 0]),  
                           VAR x, APP(inegOp(PO.INEG), VAR x)))  
               end  
568          | g (PO.INLNOT) =          | g (PO.INLNOT) =
569                let val x = mkv()                let val x = mkv()
570                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))
# Line 595  Line 592 
592                    val x = mkv()                    val x = mkv()
593                 in FN(x, argt, SELECT(0,VAR x))                 in FN(x, argt, SELECT(0,VAR x))
594                end                end
595            | g (PO.INLIGNORE) =
596              let val argt =
597                      case ts of [a] => lt_tyc a
598                               | _ => bug "unexpected type for INLIGNORE"
599              in FN (mkv (), argt, unitLexp)
600              end
601    
602          | g (PO.INLSUBSCRIPTV) =          | g (PO.INLSUBSCRIPTV) =
603                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)
# Line 736  Line 739 
739        mkAccInfo(access, info, fn () => toLty d (!typ), getNameOp path)        mkAccInfo(access, info, fn () => toLty d (!typ), getNameOp path)
740    | mkVar _ = bug "unexpected vars in mkVar"    | mkVar _ = bug "unexpected vars in mkVar"
741    
742  fun mkVE (v as V.VALvar {info=II.INL_PRIM(p, SOME typ), ...}, ts, d) =  fun mkVE (v, ts, d) = let
743        (case (p, ts)      fun otherwise () =
744          of (PO.POLYEQL, [t]) => eqGen(typ, t, toTcLt d)          case ts of
745           | (PO.POLYNEQ, [t]) => composeNOT(eqGen(typ, t, toTcLt d), toLty d t)              [] => mkVar (v, d)
746              | _ => TAPP(mkVar(v, d), map (toTyc d) ts)
747    in
748        case v of
749            V.VALvar { info, ... } =>
750            II.match info
751               { inl_prim = fn (p, typ) =>
752                 (case (p, ts) of
753                      (PO.POLYEQL, [t]) => eqGen(typ, t, toTcLt d)
754                    | (PO.POLYNEQ, [t]) =>
755                      composeNOT(eqGen(typ, t, toTcLt d), toLty d t)
756           | (PO.INLMKARRAY, [t]) =>           | (PO.INLMKARRAY, [t]) =>
757                  let val dict =                  let val dict =
758                        {default = coreAcc "mkNormArray",                        {default = coreAcc "mkNormArray",
759                         table = [([LT.tcc_real], coreAcc "mkRealArray")]}                         table = [([LT.tcc_real], coreAcc "mkRealArray")]}
760                   in GENOP (dict, p, toLty d typ, map (toTyc d) ts)                   in GENOP (dict, p, toLty d typ, map (toTyc d) ts)
761                  end                  end
762           | _ => transPrim(p, (toLty d typ), map (toTyc d) ts))                  | (PO.RAW_CCALL NONE, [a, b, c]) =>
763                      let val i = SOME (CProto.decode cproto_conv
764    | mkVE (v as V.VALvar {info=II.INL_PRIM(p, NONE), typ, ...}, ts, d) =                                                    { fun_ty = a, encoding = b })
765        (case ts of [] => transPrim(p, (toLty d (!typ)), [])                                handle CProto.BadEncoding => NONE
766                  | [x] =>                    in PRIM (PO.RAW_CCALL i, toLty d typ, map (toTyc d) ts)
767                     (* a temporary hack to resolve the boot/built-in.sml file *)                    end
768                     (let val lt = toLty d (!typ)                  | _ => transPrim(p, (toLty d typ), map (toTyc d) ts)),
769                          val nt = toLty d x               inl_str = fn _ => otherwise (),
770                       in if LT.lt_eqv(LT.ltc_top, lt)               inl_no = fn () => otherwise () }
771                          then transPrim(p, nt, [])        | _ => otherwise ()
772                          else bug "unexpected primop in mkVE"  end
                     end)  
                 | _ => bug "unexpected poly primops in mkVE")  
   
   | mkVE (v, [], d) = mkVar(v, d)  
   | mkVE (v, ts, d) = TAPP(mkVar(v, d), map (toTyc d) ts)  
773    
774  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =  fun mkCE (TP.DATACON{const, rep, name, typ, ...}, ts, apOp, d) =
775    let val lt = toDconLty d typ    let val lt = toDconLty d typ
# Line 814  Line 822 
822        let val savedtvs = map ! boundtvs        let val savedtvs = map ! boundtvs
823    
824            fun g (i, []) = ()            fun g (i, []) = ()
825              | g (i, (tv as ref (TP.OPEN _))::rest) =              | g (i, (tv as ref (TP.OPEN _))::rest) = let
826                     (tv := TP.LBOUND{depth=d, num=i}; g(i+1,rest))                    val m = markLBOUND (d, i);
827              | g (i, (tv as ref (TP.LBOUND _))::res) =                in
828                     bug ("unexpected tyvar LBOUND in mkPE")                    tv := TP.TV_MARK m;
829                      g (i+1, rest)
830                  end
831                | g (i, (tv as ref (TP.TV_MARK _))::res) =
832                       bug ("unexpected tyvar TV_MARK in mkPE")
833              | g _ = bug "unexpected tyvar INSTANTIATED in mkPE"              | g _ = bug "unexpected tyvar INSTANTIATED in mkPE"
834    
835            val _ = g(0, boundtvs) (* assign the LBOUND tyvars *)            val _ = g(0, boundtvs) (* assign the TV_MARK tyvars *)
836            val exp' = mkExp(exp, DI.next d)            val exp' = mkExp(exp, DI.next d)
837    
838            fun h ([], []) = ()            fun h ([], []) = ()
# Line 1103  Line 1115 
1115                   else MC.bindCompile (env, l', f, rootv, toTcLt d, complain)                   else MC.bindCompile (env, l', f, rootv, toTcLt d, complain)
1116               end               end
1117    
1118            | g (IFexp { test, thenCase, elseCase }) =
1119                COND (g test, g thenCase, g elseCase)
1120    
1121            | g (ANDALSOexp (e1, e2)) =
1122                COND (g e1, g e2, falseLexp)
1123    
1124            | g (ORELSEexp (e1, e2)) =
1125                COND (g e1, trueLexp, g e2)
1126    
1127            | g (WHILEexp { test, expr }) =
1128                let val fv = mkv ()
1129                    val body =
1130                        FN (mkv (), lt_unit,
1131                            COND (g test,
1132                                  LET (mkv (), g expr, APP (VAR fv, unitLexp)),
1133                                  unitLexp))
1134                in
1135                    FIX ([fv], [lt_u_u], [body], APP (VAR fv, unitLexp))
1136                end
1137    
1138          | g (LETexp (dc, e)) = mkDec (dc, d) (g e)          | g (LETexp (dc, e)) = mkDec (dc, d) (g e)
1139    
1140          | g e =          | g e =
1141               EM.impossibleWithBody "untranslateable expression"               EM.impossibleWithBody "untranslateable expression"
1142                (fn ppstrm => (PP.add_string ppstrm " expression: ";                (fn ppstrm => (PP.string ppstrm " expression: ";
1143                              PPAbsyn.ppExp (env,NONE) ppstrm (e, !ppDepth)))                              PPAbsyn.ppExp (env,NONE) ppstrm (e, !ppDepth)))
1144    
1145     in g exp     in g exp
# Line 1118  Line 1150 
1150  fun wrapPidInfo (body, pidinfos) =  fun wrapPidInfo (body, pidinfos) =
1151    let val imports =    let val imports =
1152          let fun p2itree (ANON xl) =          let fun p2itree (ANON xl) =
1153                    CB.ITNODE (map (fn (i,z) => (i, p2itree z)) xl)                    ImportTree.ITNODE (map (fn (i,z) => (i, p2itree z)) xl)
1154                | p2itree (NAMED _) = CB.ITNODE []                | p2itree (NAMED _) = ImportTree.ITNODE []
1155           in map (fn (p, pi) => (p, p2itree pi)) pidinfos           in map (fn (p, pi) => (p, p2itree pi)) pidinfos
1156          end          end
1157  (*  (*
1158        val _ = let val _ = say "\n ****************** \n"        val _ = let val _ = say "\n ****************** \n"
1159                    val _ = say "\n the current import tree is :\n"                    val _ = say "\n the current import tree is :\n"
1160                    fun tree (CB.ITNODE []) = ["\n"]                    fun tree (ImportTree.ITNODE []) = ["\n"]
1161                      | tree (CB.ITNODE xl) =                      | tree (ImportTree.ITNODE xl) =
1162                          foldr (fn ((i, x), z) =>                          foldr (fn ((i, x), z) =>
1163                            let val ts = tree x                            let val ts = tree x
1164                                val u = (Int.toString i)  ^ "   "                                val u = (Int.toString i)  ^ "   "
# Line 1188  Line 1220 
1220    
1221  end (* top-level local *)  end (* top-level local *)
1222  end (* structure Translate *)  end (* structure Translate *)
   
   

Legend:
Removed from v.733  
changed lines
  Added in v.1344

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