CVS: sml-dist/src/compiler/FLINT/trans translate.sml, 1.33.4.30, 1.33.4.31

Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9099/src/compiler/FLINT/trans

Modified Files:
      Tag: primop-branch-2
	translate.sml 
Log Message:
debugging -- prim precision conversion types do not match in translate.sml inl_infPrec

Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.30
retrieving revision 1.33.4.31
diff -C2 -d -r1.33.4.30 -r1.33.4.31
*** translate.sml	5 Sep 2006 14:38:20 -0000	1.33.4.30
--- translate.sml	22 Sep 2006 19:07:06 -0000	1.33.4.31
***************
*** 603,606 ****
--- 603,617 ----
  end
  
+ (** inl_infPrec : string * string * PrimOp.primop * Lty.lty * bool -> PLambda.lexp
+ 
+     Precision converting translation using a conversion
+     primitive named in the second argument. 
+ 
+     Examples: 
+ 	     inl_infPrec ("EXTEND_INF", "finToInf", p, lt, false) 
+              inl_infPrec ("COPY", "finToInf", p, lt, false) 
+ 
+ 	system/smlnj/init/core-intinf.sml:51:    val finToInf  : int32 * bool -> intinf
+  *)
  fun inl_infPrec (what, corename, p, lt, is_from_inf) = let
      val (orig_arg_lt, res_lt) =
***************
*** 612,623 ****
  		       else (LT.ltc_int32, orig_arg_lt))
      val new_arg_lt = LT.ltc_tuple [orig_arg_lt, extra_arg_lt]
!     val new_lt = LT.ltc_parrow (new_arg_lt, res_lt)
      val x = mkv ()
! in
      FN (x, orig_arg_lt,
  	APP (PRIM (p, new_lt, []),
  	     RECORD [VAR x, coreAcc corename]))
  end
  
  fun transPrim (prim, lt, ts) = 
    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))
--- 623,653 ----
  		       else (LT.ltc_int32, orig_arg_lt))
      val new_arg_lt = LT.ltc_tuple [orig_arg_lt, extra_arg_lt]
!     val new_lt = LT.ltc_parrow (new_arg_lt, res_lt )
      val x = mkv ()
!     (** Begin DEBUG edits *)
!     val y = mkv ()	
!     (** val coreOcc = (if corename = "finToInf" then
! 			FN(y, LT.ltc_int32 (** Where should this type come from *), 
! 			   APP(coreAcc corename, RECORD [VAR y,
! 				falseLexp 
! 				(** Apply to CoreBasicType falseDcon ...  *) ]))
! 		   else coreAcc corename) *)
!     (** End DEBUG edits *)
!     val e = 	
      FN (x, orig_arg_lt,
  	APP (PRIM (p, new_lt, []),
  	     RECORD [VAR x, coreAcc corename]))
+      val _ = print ("### inl_infPrec ### corename " ^ corename ^ "\n")
+     val _ = with_pp (fn ppstrm => PPLexp.ppLexp 20 ppstrm e)
+     val _ = print "### end inl_infPrec ###\n" 
+     in
+     e	
  end
  
+ (** transPrim : PrimOp.primop * Lty.lty * Lty.tyc list 
+ 	
+    Translate Absyn primop to PLambda form using given 
+    intrinsic PLambda type and type parameters   
+  *)
  fun transPrim (prim, lt, ts) = 
    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))
***************
*** 809,814 ****
  	    inl_infPrec ("EXTEND_INF", "finToInf", p, lt, false)
  	| g (p as PO.COPY_INF prec) =
! 	    inl_infPrec ("COPY", "finToInf", p, lt, false)
! 
  	(* default handling for all other primops *)
          | g p = PRIM(p, lt, ts) 
--- 839,843 ----
  	    inl_infPrec ("EXTEND_INF", "finToInf", p, lt, false)
  	| g (p as PO.COPY_INF prec) =
! 	    inl_infPrec ("COPY", "finToInf", p, lt, false) 
  	(* default handling for all other primops *)
          | g p = PRIM(p, lt, ts) 
***************
*** 941,945 ****
                          map (toTyc d) intrinsicParams)
                 end
!              | _ => transPrim(primop, (toLty d intrinsicType),
                                map (toTyc d) intrinsicParams)
        end
--- 970,976 ----
                          map (toTyc d) intrinsicParams)
                 end
!              | _ => (** where do these intrinsicType originate? 
! 			A: PrimOpTypeMap *)
! 		    transPrim(primop, (toLty d intrinsicType),
                                map (toTyc d) intrinsicParams)
        end
***************
*** 1512,1515 ****
--- 1543,1547 ----
          else print "**** Translate: finished typechecking plexp ****\n"
  
+ 
  fun prGen (flag,printE) s e =
    if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e) else ()


-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV