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 1979, Thu Jul 13 22:35:51 2006 UTC revision 1980, Tue Jul 18 01:10:33 2006 UTC
# Line 858  Line 858 
858                case (PrimOpMap.primopMap p, PrimOpTypeMap.primopTypeMap p)                case (PrimOpMap.primopMap p, PrimOpTypeMap.primopTypeMap p)
859                 of (SOME p, SOME t) => (p,t)                 of (SOME p, SOME t) => (p,t)
860                  | _ => bug "mkVE: unrecognized primop name"                  | _ => bug "mkVE: unrecognized primop name"
861              val _ = print "mkVE: before matchInstTypes\n"
862            val intrinsicParams =            val intrinsicParams =
863                (* compute intrinsic instantiation params of intrinsicType *)                (* compute intrinsic instantiation params of intrinsicType *)
864                case ((TU.matchInstTypes(occty, intrinsicType)) : (TP.tyvar list * TP.tyvar list) option )                case ((TU.matchInstTypes(occty, intrinsicType)) : (TP.tyvar list * TP.tyvar list) option )
865                  of SOME(_, tvs) => map TU.pruneTyvar tvs                  of SOME(_, tvs) => (print ("tvs length "^ (Int.toString (length tvs)) ^"\n"); map TU.pruneTyvar tvs)
866                   | NONE => (complain EM.COMPLAIN "matchInstTypes"                   | NONE => (complain EM.COMPLAIN "matchInstTypes"
867                                (fn ppstrm =>                                (fn ppstrm =>
868                                      (PP.newline ppstrm;                                      (PP.newline ppstrm;
# Line 878  Line 879 
879                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly occty));                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly occty));
880                                       PP.newline ppstrm;                                       PP.newline ppstrm;
881                                       PP.string ppstrm "instpoly intrinsicType: ";                                       PP.string ppstrm "instpoly intrinsicType: ";
882                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly intrinsicType))));                                       let val inst = (#1 (TU.instantiatePoly intrinsicType))
883                              bug "primop intrinsic type doesn't match occurence type")                                       in PPType.ppType env ppstrm inst
884                                         end));
885                                bug "primop intrinsic type doesn't match occurrence type")
886              val _ = print "mkVE: after matchInstTypes\n"
887         in case (primop, intrinsicParams)         in case (primop, intrinsicParams)
888              of (PO.POLYEQL, [t]) => eqGen(intrinsicType, t, toTcLt d)              of (PO.POLYEQL, [t]) => eqGen(intrinsicType, t, toTcLt d)
889               | (PO.POLYNEQ, [t]) =>               | (PO.POLYNEQ, [t]) =>
# Line 1160  Line 1164 
1164   *                                                                         *   *                                                                         *
1165   ***************************************************************************)   ***************************************************************************)
1166  and mkDec (dec, d) =  and mkDec (dec, d) =
1167    let fun g (VALdec vbs) = mkVBs(vbs, d)    let fun g (VALdec vbs) = (print "VALdec"; mkVBs(vbs, d))
1168          | g (VALRECdec rvbs) = mkRVBs(rvbs, d)          | g (VALRECdec rvbs) = (print "VALRECdec"; mkRVBs(rvbs, d))
1169          | g (ABSTYPEdec{body,...}) = g body          | g (ABSTYPEdec{body,...}) = g body
1170          | g (EXCEPTIONdec ebs) = mkEBs(ebs, d)          | g (EXCEPTIONdec ebs) = (print "EXCEPTIONdec"; mkEBs(ebs, d))
1171          | g (STRdec sbs) = mkStrbs(sbs, d)          | g (STRdec sbs) = (print "STRdec"; mkStrbs(sbs, d))
1172          | g (ABSdec sbs) = mkStrbs(sbs, d)          | g (ABSdec sbs) = (print "ABSdec"; mkStrbs(sbs, d))
1173          | g (FCTdec fbs) = mkFctbs(fbs, d)          | g (FCTdec fbs) = (print "FCTdec"; mkFctbs(fbs, d))
1174          | g (LOCALdec(ld, vd)) = (g ld) o (g vd)          | g (LOCALdec(ld, vd)) = (g ld) o (g vd)
1175          | g (SEQdec ds) =  foldr (op o) ident (map g ds)          | g (SEQdec ds) =  foldr (op o) ident (map g ds)
1176          | g (MARKdec(x, reg)) =          | g (MARKdec(x, reg)) =
# Line 1195  Line 1199 
1199        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
1200    
1201        and g (VARexp (ref v, ts)) =        and g (VARexp (ref v, ts)) =
1202              mkVE(v, map TP.VARty ts, d)              (print "mkExp VARexp\n"; mkVE(v, map TP.VARty ts, d))
1203    
1204          | g (CONexp (dc, ts)) = (let val _ = print "mkExp CONexp: "          | g (CONexp (dc, ts)) = (let val _ = print "mkExp CONexp: "
1205                                       val c = mkCE(dc, ts, NONE, d)                                       val c = mkCE(dc, ts, NONE, d)
# Line 1206  Line 1210 
1210                                                   val _ = PPLexp.printLexp c                                                   val _ = PPLexp.printLexp c
1211                                               in c end)                                               in c end)
1212          | g (INTexp (s, t)) =          | g (INTexp (s, t)) =
1213              (print "mkExp INTexp\n";
1214               ((if TU.equalType (t, BT.intTy) then INT (LN.int s)               ((if TU.equalType (t, BT.intTy) then INT (LN.int s)
1215                 else if TU.equalType (t, BT.int32Ty) then INT32 (LN.int32 s)                 else if TU.equalType (t, BT.int32Ty) then INT32 (LN.int32 s)
1216                 else if TU.equalType (t, BT.intinfTy) then VAR (getII s)                 else if TU.equalType (t, BT.intinfTy) then VAR (getII s)
# Line 1214  Line 1219 
1219                     in RECORD [WORD32 hi, WORD32 lo]                     in RECORD [WORD32 hi, WORD32 lo]
1220                     end                     end
1221                 else bug "translate INTexp")                 else bug "translate INTexp")
1222                handle Overflow => (repErr "int constant too large"; INT 0))                handle Overflow => (repErr "int constant too large"; INT 0)))
1223    
1224          | g (WORDexp(s, t)) =          | g (WORDexp(s, t)) =
1225              (print "WORDexp\n";
1226               ((if TU.equalType (t, BT.wordTy) then WORD (LN.word s)               ((if TU.equalType (t, BT.wordTy) then WORD (LN.word s)
1227                 else if TU.equalType (t, BT.word8Ty) then WORD (LN.word8 s)                 else if TU.equalType (t, BT.word8Ty) then WORD (LN.word8 s)
1228                 else if TU.equalType (t, BT.word32Ty) then WORD32 (LN.word32 s)                 else if TU.equalType (t, BT.word32Ty) then WORD32 (LN.word32 s)
# Line 1225  Line 1231 
1231                     in RECORD [WORD32 hi, WORD32 lo]                     in RECORD [WORD32 hi, WORD32 lo]
1232                     end                     end
1233                 else (ppType t; bug "translate WORDexp"))                 else (ppType t; bug "translate WORDexp"))
1234                 handle Overflow => (repErr "word constant too large"; INT 0))                 handle Overflow => (repErr "word constant too large"; INT 0)))
1235    
1236          | g (REALexp s) = REAL s          | g (REALexp s) = REAL s
1237          | g (STRINGexp s) = STRING s          | g (STRINGexp s) = STRING s

Legend:
Removed from v.1979  
changed lines
  Added in v.1980

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