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 1981, Tue Jul 18 02:03:32 2006 UTC revision 1983, Tue Jul 18 14:15:36 2006 UTC
# Line 863  Line 863 
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) =>                  of SOME(_, tvs) =>
866                     (print ("tvs length "^ (Int.toString (length tvs)) ^"\n");                     ((*print ("tvs length "^ (Int.toString (length tvs)) ^"\n");
867                      complain EM.WARN "mkVE ->matchInstTypes -> pruneTyvar " (fn ppstrm => PPVal.ppDebugVar (fn x => "") ppstrm env e);                      complain EM.WARN "mkVE ->matchInstTypes -> pruneTyvar " (fn ppstrm => PPVal.ppDebugVar (fn x => "") ppstrm env e);
868                      map TU.pruneTyvar tvs)                      if (length tvs) = 1 then complain EM.WARN "mkVE ->matchInstTypes -> pruneTyvar " (fn ppstrm => PPType.ppType env ppstrm (TP.VARty (hd tvs))) else ();
869                        *)map TU.pruneTyvar tvs)
870                   | NONE => (complain EM.COMPLAIN "matchInstTypes"                   | NONE => (complain EM.COMPLAIN "matchInstTypes"
871                                (fn ppstrm =>                                (fn ppstrm =>
872                                      (PP.newline ppstrm;                                      (PP.newline ppstrm;
# Line 882  Line 883 
883                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly occty));                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly occty));
884                                       PP.newline ppstrm;                                       PP.newline ppstrm;
885                                       PP.string ppstrm "instpoly intrinsicType: ";                                       PP.string ppstrm "instpoly intrinsicType: ";
886                                       let val inst = (#1 (TU.instantiatePoly intrinsicType))                                       PPType.ppType env ppstrm (#1 (TU.instantiatePoly intrinsicType))));
                                      in PPType.ppType env ppstrm inst  
                                      end));  
887                              bug "primop intrinsic type doesn't match occurrence type")                              bug "primop intrinsic type doesn't match occurrence type")
888            val _ = print "mkVE: after matchInstTypes\n"            val _ = print "mkVE: after matchInstTypes\n"
889         in case (primop, intrinsicParams)         in case (primop, intrinsicParams)
# Line 1437  Line 1436 
1436  (** the list of things being exported from the current compilation unit *)  (** the list of things being exported from the current compilation unit *)
1437  val exportLexp = SRECORD (map VAR exportLvars)  val exportLexp = SRECORD (map VAR exportLvars)
1438    
1439    val _ = print "pre-mkDec\n"
1440  (** translating the ML absyn into the PLambda expression *)  (** translating the ML absyn into the PLambda expression *)
1441  val body = mkDec (rootdec, DI.top) exportLexp  val body = mkDec (rootdec, DI.top) exportLexp
1442    val _ = print "post-mkDec\n"
1443    
1444  (** add bindings for intinf constants *)  (** add bindings for intinf constants *)
1445  val body = wrapII body  val body = wrapII body

Legend:
Removed from v.1981  
changed lines
  Added in v.1983

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