CVS: sml-dist/src/compiler/ElabData/types typesutil.sig, 1.2.20.4, 1.2.20.5 typesutil.sml, 1.3.2.8, 1.3.2.9

Update of /cvsroot/smlnj/sml-dist/src/compiler/ElabData/types
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7775/src/compiler/ElabData/types

Modified Files:
      Tag: primop-branch-2
	typesutil.sig typesutil.sml 
Log Message:
further changes to primops, starting on translate.sml

Index: typesutil.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/ElabData/types/typesutil.sig,v
retrieving revision 1.2.20.4
retrieving revision 1.2.20.5
diff -C2 -d -r1.2.20.4 -r1.2.20.5
*** typesutil.sig	7 Jul 2006 21:32:42 -0000	1.2.20.4
--- typesutil.sig	10 Jul 2006 22:27:12 -0000	1.2.20.5
***************
*** 36,42 ****
--- 36,44 ----
    val mapTypeFull: (Types.tycon -> Types.tycon) -> Types.ty -> Types.ty
    val applyTyfun : Types.tyfun * Types.ty list -> Types.ty
+   val applyPoly : Types.ty * Types.ty list -> Types.ty
    val reduceType : Types.ty -> Types.ty
    val headReduceType : Types.ty -> Types.ty
    val equalType  : Types.ty * Types.ty -> bool
+   val equalTypeP  : Types.ty * Types.ty -> bool
    val equalTycon : Types.tycon * Types.tycon -> bool
  

Index: typesutil.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/ElabData/types/typesutil.sml,v
retrieving revision 1.3.2.8
retrieving revision 1.3.2.9
diff -C2 -d -r1.3.2.8 -r1.3.2.9
*** typesutil.sml	7 Jul 2006 21:32:42 -0000	1.3.2.8
--- typesutil.sml	10 Jul 2006 22:27:12 -0000	1.3.2.9
***************
*** 190,194 ****
        handle SHARE => x :: (shareMap f l)
  
! (*** This function should be merged with instantiatePoly soon --zsh ***)
  fun applyTyfun(TYFUN{arity,body},args) =
    let fun subst(IBOUND n) = List.nth(args,n)
--- 190,195 ----
        handle SHARE => x :: (shareMap f l)
  
! (*** This function should be merged with instantiatePoly soon --zsh
!      dbm: don't agree! ***)
  fun applyTyfun(TYFUN{arity,body},args) =
    let fun subst(IBOUND n) = List.nth(args,n)
***************
*** 203,206 ****
--- 204,211 ----
    end
  
+ fun applyPoly(POLYty{tyfun,...}, args) =
+     applyTyfun(tyfun, args)
+   | applyPoly _ = bug "TypesUtil.applyPoly"
+ 
  fun mapTypeFull f =
      let fun mapTy ty =
***************
*** 255,258 ****
--- 260,270 ----
      end
  
+ fun equalTypeP(POLYty{sign=s1,tyfun=TYFUN{body=b1,...}},
+                POLYty{sign=s2,tyfun=TYFUN{body=b2,...}}) =
+     if s1 = s2 then equalType(b1,b2) else false
+   | equalTypeP(POLYty _, t2) = false
+   | equalTypeP(t1, POLYty _) = false
+   | equalTypeP(t1,t2) = equalType(t1,t2)
+ 
  local
    (* making dummy argument lists to be used in equalTycon *)
***************
*** 522,567 ****
      end handle CompareTypes => false
  
- (* matchTypes -- one-way matching of actual to spec type; yields 
- 		 list of instantiation metavariables
-    Parameters:
- 	spec -- specification type 
- 	actual -- actual type 
-    Returns:
-         (specGenericTvs, -- spec metavariables that are generalized 
- 			    in the match
- 	 actParamTvs) -- metavariables in actual type that are instantiations
- 			of spec metavariables in match
-    Invariant: specGenericTvs are always instantiated but 
- 	      actInstTvs are never generalized (because they are only
- 	      meaningful in this function and are immediately generalized 
- 	      away. 
-    Comments: compareTypes does pruning so there is no need to prune in
-              this function or anywhere else that uses compareTypes or
- 	     matchTypes. 
- 
-    matchTypes is used in SigMatch for matching structures (matchStr1) only
- 
-    dbm:This doesn't work. After instantiating spec and actual, have to do
-      a one-way match of spec (specinst) against (more general) actual (actinst),
-      and this match should instantiate the tyvars in actParamTvs to capture
-      the parameters that instantiate actual to produce specinst.
-  *)
- (*
- fun matchTypes (specTy, actualTy) =
-     (* If specTy is an instance of actualTy, 
-        then match, otherwise give up. *)
-     if compareTypes(specTy, actualTy) then
- 	(* compareTypes should have already determined that the 
- 	   two types match. *)
- 	let
- 	    val (actinst, actParamTvs) = instantiatePoly actualTy
-             val (specinst, specGenericTvs) = instantiatePoly specTy
- 	in 
- 	    (* These metavariable lists may be empty if either actualTy
- 	       or specTy are monomorphic *)
- 	    (specGenericTvs, actParamTvs)
- 	end
-     else ([], [])
- *)
  (* matchInstTypes: ty * ty -> (tyvar list * tyvar list) option
   * The first argument is a spec type (e.g. from a signature spec),
--- 534,537 ----



-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642