[MLton-commit] r7405

Matthew Fluet fluet at mlton.org
Fri Jan 22 08:48:17 PST 2010


Better primitive types for CPointer_* primitives.
----------------------------------------------------------------------

U   mlton/trunk/basis-library/mlton/pointer.sml
U   mlton/trunk/basis-library/primitive/prim-mlton.sml
U   mlton/trunk/mlton/atoms/prim.fun
U   mlton/trunk/mlton/backend/rep-type.fun

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

Modified: mlton/trunk/basis-library/mlton/pointer.sml
===================================================================
--- mlton/trunk/basis-library/mlton/pointer.sml	2010-01-22 16:48:08 UTC (rev 7404)
+++ mlton/trunk/basis-library/mlton/pointer.sml	2010-01-22 16:48:13 UTC (rev 7405)
@@ -1,4 +1,5 @@
-(* Copyright (C) 2003-2008 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2010 Matthew Fluet.
+ * Copyright (C) 2003-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
  * MLton is released under a BSD-style license.
@@ -10,11 +11,15 @@
 
 open Primitive.MLton.Pointer
 
-val sizeofPointer = Word.div (Word.fromInt C_Size.wordSize, 0w8)
+val sizeofPointer =
+   Word.div (Word.fromInt C_Size.wordSize, 0w8)
 
-val add = fn (p, t) => add (p, C_Size.fromWord t)
-val sub = fn (p, t) => sub (p, C_Size.fromWord t)
-val diff = fn (p, p') => C_Size.toWord (diff (p, p'))
+val add = fn (p, t) =>
+   add (p, C_Ptrdiff.fromLarge (Word.toLargeIntX t))
+val sub = fn (p, t) =>
+   sub (p, C_Ptrdiff.fromLarge (Word.toLargeIntX t))
+val diff = fn (p, p') =>
+   Word.fromLargeInt (C_Ptrdiff.toLarge (diff (p, p')))
 
 local
    fun wrap f (p, i) =

Modified: mlton/trunk/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-mlton.sml	2010-01-22 16:48:08 UTC (rev 7404)
+++ mlton/trunk/basis-library/primitive/prim-mlton.sml	2010-01-22 16:48:13 UTC (rev 7405)
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2010 Matthew Fluet.
+ * Copyright (C) 1999-2009 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -242,23 +243,23 @@
       type pointer = t
 
       val add =
-         _prim "CPointer_add": pointer * C_Size.word -> pointer;
+         _prim "CPointer_add": t * C_Ptrdiff.t -> t;
       val sub =
-         _prim "CPointer_sub": pointer * C_Size.word -> pointer;
+         _prim "CPointer_sub": t * C_Ptrdiff.t -> t;
       val diff =
-         _prim "CPointer_diff": pointer * pointer -> C_Size.word;
-      val < = _prim "CPointer_lt": pointer * pointer -> bool;
+         _prim "CPointer_diff": t * t -> C_Ptrdiff.t;
+      val < = _prim "CPointer_lt": t * t -> bool;
       local
-         structure S = IntegralComparisons(type t = pointer
+         structure S = IntegralComparisons(type t = t
                                            val < = <)
       in
          open S
       end
 
       val fromWord =
-         _prim "CPointer_fromWord": C_Size.word -> pointer;
+         _prim "CPointer_fromWord": C_Size.t -> t;
       val toWord =
-         _prim "CPointer_toWord": pointer -> C_Size.word;
+         _prim "CPointer_toWord": t -> C_Size.t;
 
       val null: t = fromWord 0w0
 

Modified: mlton/trunk/mlton/atoms/prim.fun
===================================================================
--- mlton/trunk/mlton/atoms/prim.fun	2010-01-22 16:48:08 UTC (rev 7404)
+++ mlton/trunk/mlton/atoms/prim.fun	2010-01-22 16:48:13 UTC (rev 7405)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009-2010 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -1223,9 +1223,9 @@
        | Array_update =>
             oneTarg (fn t => (threeArgs (array t, seqIndex, t), unit))
        | CPointer_add =>
-            noTargs (fn () => (twoArgs (cpointer, csize), cpointer))
+            noTargs (fn () => (twoArgs (cpointer, cptrdiff), cpointer))
        | CPointer_diff =>
-            noTargs (fn () => (twoArgs (cpointer, cpointer), csize))
+            noTargs (fn () => (twoArgs (cpointer, cpointer), cptrdiff))
        | CPointer_equal =>
             noTargs (fn () => (twoArgs (cpointer, cpointer), bool))
        | CPointer_fromWord => noTargs (fn () => (oneArg (csize), cpointer))
@@ -1249,7 +1249,7 @@
        | CPointer_setWord s =>
             noTargs (fn () => (threeArgs (cpointer, cptrdiff, word s), unit))
        | CPointer_sub =>
-            noTargs (fn () => (twoArgs (cpointer, csize), cpointer))
+            noTargs (fn () => (twoArgs (cpointer, cptrdiff), cpointer))
        | CPointer_toWord => noTargs (fn () => (oneArg cpointer, csize))
        | Exn_extra => oneTarg (fn t => (oneArg exn, t))
        | Exn_name => noTargs (fn () => (oneArg exn, string))
@@ -2021,7 +2021,7 @@
                              datatype z = datatype ApplyResult.t
                           in
                              case p of
-                                CPointer_diff => word (WordX.zero (WordSize.cpointer ()))
+                                CPointer_diff => word (WordX.zero (WordSize.cptrdiff ()))
                               | CPointer_equal => t
                               | CPointer_lt => f
                               | IntInf_compare =>

Modified: mlton/trunk/mlton/backend/rep-type.fun
===================================================================
--- mlton/trunk/mlton/backend/rep-type.fun	2010-01-22 16:48:08 UTC (rev 7404)
+++ mlton/trunk/mlton/backend/rep-type.fun	2010-01-22 16:48:13 UTC (rev 7405)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009-2010 Matthew Fluet.
  * Copyright (C) 2004-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
@@ -559,6 +559,7 @@
 
       val cint = word (WordSize.cint ())
       val csize = word (WordSize.csize ())
+      val cptrdiff = word (WordSize.cptrdiff ())
       val shiftArg = word WordSize.shiftArg
 
       val or = fn (p1, p2) => fn t => p1 t orelse p2 t
@@ -587,12 +588,12 @@
       fun wordShift s = done ([wordOrBitsOrSeq s, shiftArg], SOME (wordOrBitsOrSeq s))
    in
       case Prim.name prim of
-         CPointer_add => done ([cpointer, csize], SOME cpointer)
-       | CPointer_diff => done ([cpointer, cpointer], SOME csize)
+         CPointer_add => done ([cpointer, cptrdiff], SOME cpointer)
+       | CPointer_diff => done ([cpointer, cpointer], SOME cptrdiff)
        | CPointer_equal => done ([cpointer, cpointer], SOME bool)
        | CPointer_fromWord => done ([csize], SOME cpointer)
        | CPointer_lt => done ([cpointer, cpointer], SOME bool)
-       | CPointer_sub => done ([cpointer, csize], SOME cpointer)
+       | CPointer_sub => done ([cpointer, cptrdiff], SOME cpointer)
        | CPointer_toWord => done ([cpointer], SOME csize)
        | FFI f => done (Vector.toListMap (CFunction.args f, 
                                           fn t' => fn t => equals (t', t)),




More information about the MLton-commit mailing list