[MLton-commit] r6739

[Matthew Fluet]

Separate type operations in Prim.extractTargs.
----------------------------------------------------------------------

U   mlton/trunk/mlton/atoms/prim.fun
U   mlton/trunk/mlton/atoms/prim.sig
U   mlton/trunk/mlton/closure-convert/closure-convert.fun
U   mlton/trunk/mlton/elaborate/elaborate-core.fun
U   mlton/trunk/mlton/ssa/useless.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/atoms/prim.fun
===================================================================
--- mlton/trunk/mlton/atoms/prim.fun	2008-08-19 22:12:43 UTC (rev 6738)
+++ mlton/trunk/mlton/atoms/prim.fun	2008-08-19 22:12:52 UTC (rev 6739)
@@ -1399,12 +1399,12 @@
 
 fun ('a, 'b) extractTargs (prim: 'b t,
                            {args: 'a vector,
-                            deArray: 'a -> 'a,
-                            deArrow: 'a -> 'a * 'a,
-                            deRef: 'a -> 'a,
-                            deVector: 'a -> 'a,
-                            deWeak: 'a -> 'a,
-                            result: 'a}) =
+                            result: 'a,
+                            typeOps = {deArray: 'a -> 'a,
+                                       deArrow: 'a -> 'a * 'a,
+                                       deRef: 'a -> 'a,
+                                       deVector: 'a -> 'a,
+                                       deWeak: 'a -> 'a}}) =
    let
       val one = Vector.new1
       fun arg i = Vector.sub (args, i)

Modified: mlton/trunk/mlton/atoms/prim.sig
===================================================================
--- mlton/trunk/mlton/atoms/prim.sig	2008-08-19 22:12:43 UTC (rev 6738)
+++ mlton/trunk/mlton/atoms/prim.sig	2008-08-19 22:12:52 UTC (rev 6739)
@@ -249,12 +249,12 @@
       val equal: 'a t (* polymorphic equality *)
       val equals: 'a t * 'a t -> bool
       val extractTargs: 'a t * {args: 'b vector,
-                                deArray: 'b -> 'b,
-                                deArrow: 'b -> 'b * 'b,
-                                deRef: 'b -> 'b,
-                                deVector: 'b -> 'b,
-                                deWeak: 'b -> 'b,
-                                result: 'b} -> 'b vector
+                                result: 'b,
+                                typeOps: {deArray: 'b -> 'b,
+                                          deArrow: 'b -> 'b * 'b,
+                                          deRef: 'b -> 'b,
+                                          deVector: 'b -> 'b,
+                                          deWeak: 'b -> 'b}} -> 'b vector
       val ffi: 'a CFunction.t -> 'a t
       val ffiSymbol: {name: string, 
                       cty: CType.t option, 

Modified: mlton/trunk/mlton/closure-convert/closure-convert.fun
===================================================================
--- mlton/trunk/mlton/closure-convert/closure-convert.fun	2008-08-19 22:12:43 UTC (rev 6738)
+++ mlton/trunk/mlton/closure-convert/closure-convert.fun	2008-08-19 22:12:52 UTC (rev 6739)
@@ -1052,11 +1052,11 @@
                                       (prim,
                                        {args = Vector.map (args, varInfoType),
                                         result = ty,
-                                        deArray = Type.deArray,
-                                        deArrow = fn _ => Error.bug "ClosureConvert.convertPrimExp: deArrow",
-                                        deRef = Type.deRef,
-                                        deVector = Type.deVector,
-                                        deWeak = Type.deWeak}),
+                                        typeOps = {deArray = Type.deArray,
+                                                   deArrow = fn _ => Error.bug "ClosureConvert.convertPrimExp: deArrow",
+                                                   deRef = Type.deRef,
+                                                   deVector = Type.deVector,
+                                                   deWeak = Type.deWeak}}),
                                        Vector.map (args, convertVarInfo))
                                   end)
                         end

Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun	2008-08-19 22:12:43 UTC (rev 6738)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun	2008-08-19 22:12:52 UTC (rev 6739)
@@ -974,12 +974,12 @@
    let
       val targs = Prim.extractTargs (prim,
                                      {args = Vector.map (args, Cexp.ty),
-                                      deArray = Type.deArray,
-                                      deArrow = Type.deArrow,
-                                      deRef = Type.deRef,
-                                      deVector = Type.deVector,
-                                      deWeak = Type.deWeak,
-                                      result = result})
+                                      result = result,
+                                      typeOps = {deArray = Type.deArray,
+                                                 deArrow = Type.deArrow,
+                                                 deRef = Type.deRef,
+                                                 deVector = Type.deVector,
+                                                 deWeak = Type.deWeak}})
    in
       Cexp.make (Cexp.PrimApp {args = args,
                                prim = prim,

Modified: mlton/trunk/mlton/ssa/useless.fun
===================================================================
--- mlton/trunk/mlton/ssa/useless.fun	2008-08-19 22:12:43 UTC (rev 6738)
+++ mlton/trunk/mlton/ssa/useless.fun	2008-08-19 22:12:52 UTC (rev 6739)
@@ -763,11 +763,11 @@
                             (prim,
                              {args = argTypes,
                               result = resultType,
-                              deArray = Type.deArray,
-                              deArrow = fn _ => Error.bug "Useless.doitExp: deArrow",
-                              deRef = Type.deRef,
-                              deVector = Type.deVector,
-                              deWeak = Type.deWeak}))}
+                              typeOps = {deArray = Type.deArray,
+                                         deArrow = fn _ => Error.bug "Useless.doitExp: deArrow",
+                                         deRef = Type.deRef,
+                                         deVector = Type.deVector,
+                                         deWeak = Type.deWeak}}))}
                end
           | Select {tuple, offset} =>
                let