[MLton-commit] r4459
Matthew Fluet
MLton@mlton.org
Thu, 4 May 2006 18:03:37 -0700
Declare MLton.Pointer.t to be the primitive pointer tycon; needed for _import * and _symbol * type checking
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-05-05 01:03:36 UTC (rev 4459)
@@ -29,6 +29,27 @@
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
DEFAULT_WORD_MAPS = default-word32.map default-word64.map
+.PHONY: type-check-one
+type-check-one:
+ for objptrrep in objptr-rep32.map; do \
+ for header in header-word32.map; do \
+ for seqindex in seqindex-int32.map; do \
+ for defchar in default-char8.map; do \
+ for defint in default-int32.map; do \
+ for defreal in default-real64.map; do \
+ for defword in default-word32.map; do \
+ echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defreal $$defword"; \
+ $(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ -mlb-path-map "maps/$$objptrrep" \
+ -mlb-path-map "maps/$$header" \
+ -mlb-path-map "maps/$$seqindex" \
+ -mlb-path-map "maps/$$defchar" \
+ -mlb-path-map "maps/$$defint" \
+ -mlb-path-map "maps/$$defreal" \
+ -mlb-path-map "maps/$$defword" \
+ build/sources.mlb; \
+ done; done; done; done; done; done; done
+
.PHONY: type-check
type-check:
for objptrrep in $(OBJPTR_MAPS); do \
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -208,9 +208,10 @@
let
val cs = strError n
in
- if Primitive.MLton.Pointer.isNull cs
+ if Primitive.MLton.Pointer.isNull
+ (Primitive.MLton.Pointer.fromWord cs)
then "Unknown error"
- else CUtil.C_String.toString cs
+ else CUtil.C_String.toString cs
end
fun raiseSys n = raise SysErr (errorMsg n, SOME n)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -70,7 +70,8 @@
let
val res =
SysCall.syscallErr
- ({clear = true, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({clear = true, restart = false,
+ errVal = CUtil.C_Pointer.null}, fn () =>
{return = Prim.readDir d,
post = fn cs => SOME cs,
handlers = [(Error.cleared, fn () => NONE),
@@ -132,7 +133,8 @@
let
val res =
SysCall.syscallErr
- ({clear = false, restart = false, errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({clear = false, restart = false,
+ errVal = CUtil.C_Pointer.null}, fn () =>
{return = Prim.getcwd (!buffer, C_Size.fromInt (!size)),
post = fn _ => true,
handlers = [(Error.range, fn _ => false)]})
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -53,7 +53,7 @@
fun getlogin () =
SysCall.syscall'
- ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({errVal = CUtil.C_Pointer.null}, fn () =>
(Prim.getlogin (), fn cs =>
CS.toString cs))
@@ -242,7 +242,7 @@
let
val cs = Prim.getenv (NullString.nullTerm name)
in
- if Primitive.MLton.Pointer.isNull cs
+ if CUtil.C_Pointer.isNull cs
then NONE
else SOME (CS.toString cs)
end
@@ -253,7 +253,7 @@
fun ttyname fd =
SysCall.syscall'
- ({errVal = Primitive.MLton.Pointer.null}, fn () =>
+ ({errVal = CUtil.C_Pointer.null}, fn () =>
(Prim.ttyname fd, fn cs =>
CS.toString cs))
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -432,12 +432,10 @@
end
(* Primitive Basis (MLton Extensions) *)
-(*
structure Pointer =
struct
type t = pointer
end
-*)
structure Thread =
struct
type t = thread
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -25,42 +25,6 @@
val installSignalHandler =
_prim "MLton_installSignalHandler": unit -> unit;
-structure Pointer =
- struct
- (* open Pointer *)
- type t = C_Pointer.t
-
- val fromWord = fn x => x
- val toWord = fn x => x
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
- val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
- val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
- val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
- val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
- val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
- val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
- val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
- val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
- val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
- end
-
structure GCState =
struct
type t = Pointer.t
@@ -224,6 +188,62 @@
end
end
+structure Pointer =
+ struct
+ open Pointer
+ type pointer = t
+
+ local
+ structure S =
+ C_Pointer_ChooseWordN
+ (type 'a t = 'a -> t
+ val fWord8 = _prim "WordU8_toWord8": Primitive.Word8.word -> pointer;
+ val fWord16 = _prim "WordU16_toWord16": Primitive.Word16.word -> pointer;
+ val fWord32 = _prim "WordU32_toWord32": Primitive.Word32.word -> pointer;
+ val fWord64 = _prim "WordU64_toWord64": Primitive.Word64.word -> pointer;)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
+ C_Pointer_ChooseWordN
+ (type 'a t = t -> 'a
+ val fWord8 = _prim "WordU8_toWord8": pointer -> Primitive.Word8.word;
+ val fWord16 = _prim "WordU16_toWord16": pointer -> Primitive.Word16.word;
+ val fWord32 = _prim "WordU32_toWord32": pointer -> Primitive.Word32.word;
+ val fWord64 = _prim "WordU64_toWord64": pointer -> Primitive.Word64.word;)
+ in
+ val toWord = S.f
+ end
+
+ val null: t = fromWord 0w0
+
+ fun isNull p = p = null
+
+ val getInt8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Int8.int;
+ val getInt16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Int16.int;
+ val getInt32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Int32.int;
+ val getInt64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Int64.int;
+ val getPointer = _prim "Pointer_getPointer": t * C_Ptrdiff.t -> 'a;
+ val getReal32 = _prim "Pointer_getReal32": t * C_Ptrdiff.t -> Real32.real;
+ val getReal64 = _prim "Pointer_getReal64": t * C_Ptrdiff.t -> Real64.real;
+ val getWord8 = _prim "Pointer_getWord8": t * C_Ptrdiff.t -> Word8.word;
+ val getWord16 = _prim "Pointer_getWord16": t * C_Ptrdiff.t -> Word16.word;
+ val getWord32 = _prim "Pointer_getWord32": t * C_Ptrdiff.t -> Word32.word;
+ val getWord64 = _prim "Pointer_getWord64": t * C_Ptrdiff.t -> Word64.word;
+ val setInt8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Int8.int -> unit;
+ val setInt16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Int16.int -> unit;
+ val setInt32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Int32.int -> unit;
+ val setInt64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Int64.int -> unit;
+ val setPointer = _prim "Pointer_setPointer": t * C_Ptrdiff.t * 'a -> unit;
+ val setReal32 = _prim "Pointer_setReal32": t * C_Ptrdiff.t * Real32.real -> unit;
+ val setReal64 = _prim "Pointer_setReal64": t * C_Ptrdiff.t * Real64.real -> unit;
+ val setWord8 = _prim "Pointer_setWord8": t * C_Ptrdiff.t * Word8.word -> unit;
+ val setWord16 = _prim "Pointer_setWord16": t * C_Ptrdiff.t * Word16.word -> unit;
+ val setWord32 = _prim "Pointer_setWord32": t * C_Ptrdiff.t * Word32.word -> unit;
+ val setWord64 = _prim "Pointer_setWord64": t * C_Ptrdiff.t * Word64.word -> unit;
+ end
+
structure Profile =
struct
val isOn = _build_const "MLton_Profile_isOn": bool;
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sig 2006-05-05 01:03:36 UTC (rev 4459)
@@ -8,6 +8,14 @@
signature C_UTIL =
sig
+ structure C_Pointer :
+ sig
+ type t = C_Pointer.t
+
+ val null: t
+ val isNull: t -> bool
+ end
+
(* C char* *)
structure C_String :
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/CUtil.sml 2006-05-05 01:03:36 UTC (rev 4459)
@@ -9,6 +9,8 @@
structure CUtil: C_UTIL =
struct
open Int
+
+ structure Pointer = Primitive.MLton.Pointer
fun makeLength (sub, term) p =
let
@@ -34,17 +36,26 @@
a
end
+ structure C_Pointer =
+ struct
+ type t = C_Pointer.t
+ val null = Pointer.toWord Pointer.null
+ fun isNull p = p = null
+ end
+
structure C_String =
struct
type t = C_String.t
fun sub (cs, i) =
Primitive.Char8.fromWord8Unsafe
- (Primitive.MLton.Pointer.getWord8 (cs, C_Ptrdiff.fromInt i))
+ (Pointer.getWord8
+ (Pointer.fromWord cs, C_Ptrdiff.fromInt i))
fun update (cs, i, c) =
- Primitive.MLton.Pointer.setWord8
- (cs, C_Ptrdiff.fromInt i, Primitive.Char8.toWord8Unsafe c)
+ Pointer.setWord8
+ (Pointer.fromWord cs, C_Ptrdiff.fromInt i,
+ Primitive.Char8.toWord8Unsafe c)
fun toCharArrayOfLength (cs, n) = toArrayOfLength (cs, sub, n)
@@ -61,9 +72,10 @@
type t = C_StringArray.t
fun sub (css: t, i) =
- Primitive.MLton.Pointer.getPointer (css, C_Ptrdiff.fromInt i)
+ Pointer.getPointer
+ (Pointer.fromWord css, C_Ptrdiff.fromInt i)
- val length = makeLength (sub, Primitive.MLton.Pointer.isNull)
+ val length = makeLength (sub, Pointer.isNull)
val toArrayOfLength =
fn (css, n) => toArrayOfLength (css, C_String.toString o sub, n)
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-export.c 2006-05-05 01:03:36 UTC (rev 4459)
@@ -2,7 +2,7 @@
#include "export.h"
void g () {
- Char c;
+ Char8 c;
fprintf (stderr, "g starting\n");
c = f (13, 17.15, 'a');
@@ -23,7 +23,7 @@
fprintf (stderr, "g3 done\n");
}
-void g4 (Int i) {
+void g4 (Int32 i) {
fprintf (stderr, "g4 (%d)\n", i);
f4 (i);
}
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c 2006-05-04 20:43:20 UTC (rev 4458)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/ffi-import.c 2006-05-05 01:03:36 UTC (rev 4459)
@@ -1,18 +1,18 @@
#include "platform.h"
-Int FFI_INT = 13;
-Word FFI_WORD = 0xFF;
+Int32 FFI_INT = 13;
+Word32 FFI_WORD = 0xFF;
Bool FFI_BOOL = TRUE;
-Real FFI_REAL = 3.14159;
+Real64 FFI_REAL = 3.14159;
-Char ffi (Pointer a1, Pointer a2, Int n) {
+Char8 ffi (Pointer a1, Pointer a2, Int32 n) {
double *ds = (double*)a1;
int *p = (int*)a2;
int i;
double sum;
sum = 0.0;
- for (i = 0; i < GC_arrayNumElements (a1); ++i) {
+ for (i = 0; i < GC_getArrayLength (a1); ++i) {
sum += ds[i];
ds[i] += n;
}