[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