[MLton-commit] r7406
Matthew Fluet
fluet at mlton.org
Fri Jan 22 08:48:21 PST 2010
Duplicate the functionality of MLton.Pointer to c-types.mlb:C_Pointer.
Furthermore, C_Pointer operations are all in terms of C_Size.t and
C_Ptrdiff.t, so as to be agnostic to the pointer size. Also add
get/set operations for all of the C_* types exported by c-types.mlb.
----------------------------------------------------------------------
A mlton/trunk/basis-library/c/
A mlton/trunk/basis-library/c/pointer.sig
A mlton/trunk/basis-library/c/pointer.sml
U mlton/trunk/basis-library/c-types.mlb
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
----------------------------------------------------------------------
Added: mlton/trunk/basis-library/c/pointer.sig
===================================================================
--- mlton/trunk/basis-library/c/pointer.sig 2010-01-22 16:48:13 UTC (rev 7405)
+++ mlton/trunk/basis-library/c/pointer.sig 2010-01-22 16:48:19 UTC (rev 7406)
@@ -0,0 +1,77 @@
+(* Copyright (C) 2010 Matthew Fluet.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature C_POINTER =
+sig
+ type t = MLton.Pointer.t
+ val add: t * C_Ptrdiff.t -> t
+ val compare: t * t -> order
+ val diff: t * t -> C_Ptrdiff.t
+ val fromWord: C_Size.t -> t
+ val getC_SChar: t * C_Ptrdiff.t -> C_SChar.t
+ val getC_UChar: t * C_Ptrdiff.t -> C_UChar.t
+ val getC_SShort: t * C_Ptrdiff.t -> C_SShort.t
+ val getC_UShort: t * C_Ptrdiff.t -> C_UShort.t
+ val getC_SInt: t * C_Ptrdiff.t -> C_SInt.t
+ val getC_UInt: t * C_Ptrdiff.t -> C_UInt.t
+ val getC_SLong: t * C_Ptrdiff.t -> C_SLong.t
+ val getC_ULong: t * C_Ptrdiff.t -> C_ULong.t
+ val getC_SLongLong: t * C_Ptrdiff.t -> C_SLongLong.t
+ val getC_ULongLong: t * C_Ptrdiff.t -> C_ULongLong.t
+ val getC_Float: t * C_Ptrdiff.t -> C_Float.t
+ val getC_Double: t * C_Ptrdiff.t -> C_Double.t
+ val getC_Size: t * C_Ptrdiff.t -> C_Size.t
+ val getC_Ptrdiff: t * C_Ptrdiff.t -> C_Ptrdiff.t
+ val getC_Intmax: t * C_Ptrdiff.t -> C_Intmax.t
+ val getC_UIntmax: t * C_Ptrdiff.t -> C_UIntmax.t
+ val getC_Intptr: t * C_Ptrdiff.t -> C_Intptr.t
+ val getC_UIntptr: t * C_Ptrdiff.t -> C_UIntptr.t
+ val getC_Pointer: t * C_Ptrdiff.t -> t
+ val getInt8: t * C_Ptrdiff.t -> Int8.int
+ val getInt16: t * C_Ptrdiff.t -> Int16.int
+ val getInt32: t * C_Ptrdiff.t -> Int32.int
+ val getInt64: t * C_Ptrdiff.t -> Int64.int
+ val getReal32: t * C_Ptrdiff.t -> Real32.real
+ val getReal64: t * C_Ptrdiff.t -> Real64.real
+ val getWord8: t * C_Ptrdiff.t -> Word8.word
+ val getWord16: t * C_Ptrdiff.t -> Word16.word
+ val getWord32: t * C_Ptrdiff.t -> Word32.word
+ val getWord64: t * C_Ptrdiff.t -> Word64.word
+ val isNull: t -> bool
+ val null: t
+ val setC_SChar: t * C_Ptrdiff.t * C_SChar.t -> unit
+ val setC_UChar: t * C_Ptrdiff.t * C_UChar.t -> unit
+ val setC_SShort: t * C_Ptrdiff.t * C_SShort.t -> unit
+ val setC_UShort: t * C_Ptrdiff.t * C_UShort.t -> unit
+ val setC_SInt: t * C_Ptrdiff.t * C_SInt.t -> unit
+ val setC_UInt: t * C_Ptrdiff.t * C_UInt.t -> unit
+ val setC_SLong: t * C_Ptrdiff.t * C_SLong.t -> unit
+ val setC_ULong: t * C_Ptrdiff.t * C_ULong.t -> unit
+ val setC_SLongLong: t * C_Ptrdiff.t * C_SLongLong.t -> unit
+ val setC_ULongLong: t * C_Ptrdiff.t * C_ULongLong.t -> unit
+ val setC_Float: t * C_Ptrdiff.t * C_Float.t -> unit
+ val setC_Double: t * C_Ptrdiff.t * C_Double.t -> unit
+ val setC_Size: t * C_Ptrdiff.t * C_Size.t -> unit
+ val setC_Ptrdiff: t * C_Ptrdiff.t * C_Ptrdiff.t -> unit
+ val setC_Intmax: t * C_Ptrdiff.t * C_Intmax.t -> unit
+ val setC_UIntmax: t * C_Ptrdiff.t * C_UIntmax.t -> unit
+ val setC_Intptr: t * C_Ptrdiff.t * C_Intptr.t -> unit
+ val setC_UIntptr: t * C_Ptrdiff.t * C_UIntptr.t -> unit
+ val setC_Pointer: t * C_Ptrdiff.t * t -> unit
+ val setInt8: t * C_Ptrdiff.t * Int8.int -> unit
+ val setInt16: t * C_Ptrdiff.t * Int16.int -> unit
+ val setInt32: t * C_Ptrdiff.t * Int32.int -> unit
+ val setInt64: t * C_Ptrdiff.t * Int64.int -> unit
+ val setReal32: t * C_Ptrdiff.t * Real32.real -> unit
+ val setReal64: t * C_Ptrdiff.t * Real64.real -> unit
+ val setWord8: t * C_Ptrdiff.t * Word8.word -> unit
+ val setWord16: t * C_Ptrdiff.t * Word16.word -> unit
+ val setWord32: t * C_Ptrdiff.t * Word32.word -> unit
+ val setWord64: t * C_Ptrdiff.t * Word64.word -> unit
+ val sizeofPointer: C_Size.t
+ val sub: t * C_Ptrdiff.t -> t
+ val toWord: t -> C_Size.t
+end
\ No newline at end of file
Added: mlton/trunk/basis-library/c/pointer.sml
===================================================================
--- mlton/trunk/basis-library/c/pointer.sml 2010-01-22 16:48:13 UTC (rev 7405)
+++ mlton/trunk/basis-library/c/pointer.sml 2010-01-22 16:48:19 UTC (rev 7406)
@@ -0,0 +1,426 @@
+(* Copyright (C) 2010 Matthew Fluet.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure C_Pointer : C_POINTER =
+struct
+
+open Primitive.MLton.Pointer
+
+val sizeofPointer = C_Size.div (C_Size.fromInt C_Size.wordSize, 0w8)
+
+local
+ structure S =
+ C_SChar_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_SChar = S.f
+end
+local
+ structure S =
+ C_UChar_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_UChar = S.f
+end
+
+local
+ structure S =
+ C_SShort_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_SShort = S.f
+end
+local
+ structure S =
+ C_UShort_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_UShort = S.f
+end
+
+local
+ structure S =
+ C_SInt_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_SInt = S.f
+end
+local
+ structure S =
+ C_UInt_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_UInt = S.f
+end
+
+local
+ structure S =
+ C_SLong_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_SLong = S.f
+end
+local
+ structure S =
+ C_ULong_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_ULong = S.f
+end
+
+local
+ structure S =
+ C_SLongLong_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_SLongLong = S.f
+end
+local
+ structure S =
+ C_ULongLong_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_ULongLong = S.f
+end
+
+local
+ structure S =
+ C_Float_ChooseRealN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fReal32 = getReal32
+ val fReal64 = getReal64)
+in
+ val getC_Float = S.f
+end
+local
+ structure S =
+ C_Double_ChooseRealN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fReal32 = getReal32
+ val fReal64 = getReal64)
+in
+ val getC_Double = S.f
+end
+
+local
+ structure S =
+ C_Size_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_Size = S.f
+end
+local
+ structure S =
+ C_Ptrdiff_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_Ptrdiff = S.f
+end
+
+local
+ structure S =
+ C_Intmax_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_Intmax = S.f
+end
+local
+ structure S =
+ C_UIntmax_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_UIntmax = S.f
+end
+
+local
+ structure S =
+ C_Intptr_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fInt8 = getInt8
+ val fInt16 = getInt16
+ val fInt32 = getInt32
+ val fInt64 = getInt64)
+in
+ val getC_Intptr = S.f
+end
+local
+ structure S =
+ C_UIntptr_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t -> 'a
+ val fWord8 = getWord8
+ val fWord16 = getWord16
+ val fWord32 = getWord32
+ val fWord64 = getWord64)
+in
+ val getC_UIntptr = S.f
+end
+
+val getC_Pointer = getCPointer
+
+
+local
+ structure S =
+ C_SChar_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_SChar = S.f
+end
+local
+ structure S =
+ C_UChar_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_UChar = S.f
+end
+
+local
+ structure S =
+ C_SShort_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_SShort = S.f
+end
+local
+ structure S =
+ C_UShort_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_UShort = S.f
+end
+
+local
+ structure S =
+ C_SInt_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_SInt = S.f
+end
+local
+ structure S =
+ C_UInt_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_UInt = S.f
+end
+
+local
+ structure S =
+ C_SLong_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_SLong = S.f
+end
+local
+ structure S =
+ C_ULong_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_ULong = S.f
+end
+
+local
+ structure S =
+ C_SLongLong_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_SLongLong = S.f
+end
+local
+ structure S =
+ C_ULongLong_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_ULongLong = S.f
+end
+
+local
+ structure S =
+ C_Float_ChooseRealN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = setReal32
+ val fReal64 = setReal64)
+in
+ val setC_Float = S.f
+end
+local
+ structure S =
+ C_Double_ChooseRealN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fReal32 = setReal32
+ val fReal64 = setReal64)
+in
+ val setC_Double = S.f
+end
+
+local
+ structure S =
+ C_Size_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_Size = S.f
+end
+local
+ structure S =
+ C_Ptrdiff_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_Ptrdiff = S.f
+end
+
+local
+ structure S =
+ C_Intmax_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_Intmax = S.f
+end
+local
+ structure S =
+ C_UIntmax_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_UIntmax = S.f
+end
+
+local
+ structure S =
+ C_Intptr_ChooseIntN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fInt8 = setInt8
+ val fInt16 = setInt16
+ val fInt32 = setInt32
+ val fInt64 = setInt64)
+in
+ val setC_Intptr = S.f
+end
+local
+ structure S =
+ C_UIntptr_ChooseWordN
+ (type 'a t = t * C_Ptrdiff.t * 'a -> unit
+ val fWord8 = setWord8
+ val fWord16 = setWord16
+ val fWord32 = setWord32
+ val fWord64 = setWord64)
+in
+ val setC_UIntptr = S.f
+end
+
+val setC_Pointer = setCPointer
+
+
+end
Modified: mlton/trunk/basis-library/c-types.mlb
===================================================================
--- mlton/trunk/basis-library/c-types.mlb 2010-01-22 16:48:13 UTC (rev 7405)
+++ mlton/trunk/basis-library/c-types.mlb 2010-01-22 16:48:19 UTC (rev 7406)
@@ -14,6 +14,7 @@
in
local
basis.mlb
+ mlton.mlb
local
config/choose-int.sml
config/choose-real.sml
@@ -25,6 +26,16 @@
in ann "forceUsed" in
$(LIB_MLTON_DIR)/targets/$(TARGET)/sml/c-types.sml
end end
+ local
+ local
+ primitive/primitive.mlb
+ in
+ structure Primitive
+ end
+ in
+ c/pointer.sig
+ c/pointer.sml
+ end
in
structure C_Char
structure C_SChar
@@ -77,5 +88,6 @@
structure C_UIntptr
functor C_UIntptr_ChooseWordN
+ structure C_Pointer
end
end
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2010-01-22 16:48:13 UTC (rev 7405)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2010-01-22 16:48:19 UTC (rev 7406)
@@ -809,6 +809,7 @@
where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
where type Word8Vector.vector = Word8Vector.vector
+ where type MLton.Pointer.t = MLton.Pointer.t
where type 'a MLton.Thread.t = 'a MLton.Thread.t
where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
More information about the MLton-commit
mailing list