[MLton-commit] r4348
Matthew Fluet
MLton@mlton.org
Sun, 5 Feb 2006 07:30:22 -0800
Refactoring.
* Ensure that primitives and primitive FFI imports make no assumption
about default sizes.
* Ensure that bitsize related characteristics are expressed in Int32/Word32;
this includes shift arguments.
* Major reworking of IntInf code to be parametric with respect to
objptr size and mplimb size.
This is using a "poor-man's" functor approach via the config/* and
map/* files. The Makefile includes a type-check target that
type-checks the basis library under a variety of different
representation choices. This ensures that although we use transparent
structure assignment (to facilitate rebinding of structues as more
operations have been defined), we use the appropriate coercions where
necessary.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-real64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m64.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.weird.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep64.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index64.map
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sig
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-intinf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-nullstring.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/.ignore
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/Makefile
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/top-level/infixes-unsafe.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/dynamic-wind.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/dynamic-wind.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/integral-comparisons.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/real-comparisons.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-02-05 15:30:17 UTC (rev 4348)
@@ -6,9 +6,42 @@
# See the file MLton-LICENSE for details.
##
+SRC = $(shell cd .. && pwd)
+BUILD = $(SRC)/build
+BIN = $(BUILD)/bin
+MLTON = mlton
+PATH = $(BIN):$(shell echo $$PATH)
+
all:
.PHONY: clean
clean:
find . -type f | egrep '.(old|ast|core-ml)$$' | xargs rm -f
../bin/clean
+
+
+CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
+DEFAULT_CHAR_MAPS = default-char8.map
+DEFAULT_INT_MAPS = default-int32.map default-int64.map default-intinf.map
+DEFAULT_WORD_MAPS = default-word32.map default-word64.map
+OBJPTR_REP_MAPS = objptr-rep32.map objptr-rep64.map
+SEQ_INDEX_MAPS = seq-index32.map seq-index64.map
+
+.PHONY: type-check
+type-check:
+ for ctypes in $(CTYPES_MAPS); do \
+ for defchar in $(DEFAULT_CHAR_MAPS); do \
+ for defint in $(DEFAULT_INT_MAPS); do \
+ for defword in $(DEFAULT_WORD_MAPS); do \
+ for objptrrep in $(OBJPTR_REP_MAPS); do \
+ for seqindex in $(SEQ_INDEX_MAPS); do \
+ echo "Type checking: $$ctypes $$defchar $$defint $$defword $$objptrrep $$seqindex"; \
+ $(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ -mlb-path-map "maps/$$ctypes" \
+ -mlb-path-map "maps/$$defchar" \
+ -mlb-path-map "maps/$$defint" \
+ -mlb-path-map "maps/$$defword" \
+ -mlb-path-map "maps/$$objptrrep" \
+ -mlb-path-map "maps/$$seqindex" \
+ build/sources.mlb; \
+ done; done; done; done; done; done
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/libs/basis-extra/basis-extra.mlb 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,294 @@
+(* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+ann
+ "deadCode true"
+ "sequenceNonUnit warn"
+ "nonexhaustiveMatch warn" "redundantMatch warn"
+ "warnUnused false" "forceUsed"
+in
+ ../primitive/primitive.mlb
+ ../top-level/infixes.sml
+ ../top-level/infixes-unsafe.sml
+ ../util/dynamic-wind.sig
+ ../util/dynamic-wind.sml
+
+ ../integer/int0.sml
+ ../integer/word0.sml
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
+ ../config/c/misc/$(CTYPES)
+ ../config/objptr/$(OBJPTR_REP)
+ ../config/seq/$(SEQ_INDEX)
+ end end
+ ../integer/int-inf0.sml
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
+ ../config/default/$(DEFAULT_CHAR)
+ ../config/default/$(DEFAULT_INT)
+ ../config/default/$(DEFAULT_WORD)
+ end end
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
+ ../config/c/misc/$(CTYPES)
+ ../config/objptr/$(OBJPTR_REP)
+ ../config/seq/$(SEQ_INDEX)
+ end end
+
+(*
+ local
+ ../../primitive/primitive.mlb
+ (* Common basis implementation. *)
+ ../../top-level/infixes.sml
+ ../../misc/basic.sml
+ ../../misc/dynamic-wind.sig
+ ../../misc/dynamic-wind.sml
+ ../../general/general.sig
+ ../../general/general.sml
+ ../../misc/util.sml
+ ../../general/option.sig
+ ../../general/option.sml
+ ../../list/list.sig
+ ../../list/list.sml
+ ../../list/list-pair.sig
+ ../../list/list-pair.sml
+ ../../arrays-and-vectors/slice.sig
+ ../../arrays-and-vectors/sequence.sig
+ ../../arrays-and-vectors/sequence.fun
+ ../../arrays-and-vectors/vector-slice.sig
+ ../../arrays-and-vectors/vector.sig
+ ../../arrays-and-vectors/vector.sml
+ ../../arrays-and-vectors/array-slice.sig
+ ../../arrays-and-vectors/array.sig
+ ../../arrays-and-vectors/array.sml
+ ../../arrays-and-vectors/array2.sig
+ ../../arrays-and-vectors/array2.sml
+ ../../arrays-and-vectors/mono-vector-slice.sig
+ ../../arrays-and-vectors/mono-vector.sig
+ ../../arrays-and-vectors/mono-vector.fun
+ ../../arrays-and-vectors/mono-array-slice.sig
+ ../../arrays-and-vectors/mono-array.sig
+ ../../arrays-and-vectors/mono-array.fun
+ ../../arrays-and-vectors/mono-array2.sig
+ ../../arrays-and-vectors/mono-array2.fun
+ ../../arrays-and-vectors/mono.sml
+ ../../text/string0.sml
+ ../../text/char0.sml
+ ../../misc/reader.sig
+ ../../misc/reader.sml
+ ../../text/string-cvt.sig
+ ../../text/string-cvt.sml
+ ../../general/bool.sig
+ ../../general/bool.sml
+ ../../integer/integer.sig
+ ../../integer/int.sml
+ ../../text/char.sig
+ ../../text/char.sml
+ ../../text/substring.sig
+ ../../text/substring.sml
+ ../../text/string.sig
+ ../../text/string.sml
+ ../../misc/C.sig
+ ../../misc/C.sml
+ ../../integer/word.sig
+ ../../integer/word.sml
+ ../../integer/int-inf.sig
+ ../../integer/int-inf.sml
+ ../../real/IEEE-real.sig
+ ../../real/IEEE-real.sml
+ ../../real/math.sig
+ ../../real/real.sig
+ ../../real/real.fun
+ ../../integer/pack-word.sig
+ ../../integer/pack-word32.sml
+ ../../text/byte.sig
+ ../../text/byte.sml
+ ../../text/text.sig
+ ../../text/text.sml
+ ../../real/pack-real.sig
+ ../../real/pack-real.sml
+ ../../real/real32.sml
+ ../../real/real64.sml
+ ../../integer/patch.sml
+ ../../integer/embed-int.sml
+ ../../integer/embed-word.sml
+ ann "forceUsed" in
+ ../../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
+ end
+
+ ../../top-level/arithmetic.sml
+
+ (* misc/unique-id.sig *)
+ (* misc/unique-id.fun *)
+ ../../misc/cleaner.sig
+ ../../misc/cleaner.sml
+
+ ../../system/pre-os.sml
+ ../../system/time.sig
+ ../../system/time.sml
+ ../../system/date.sig
+ ../../system/date.sml
+
+ ../../io/io.sig
+ ../../io/io.sml
+ ../../io/prim-io.sig
+ ../../io/prim-io.fun
+ ../../io/bin-prim-io.sml
+ ../../io/text-prim-io.sml
+
+ ../../posix/error.sig
+ ../../posix/error.sml
+ ../../posix/stub-mingw.sml
+ ../../posix/flags.sig
+ ../../posix/flags.sml
+ ../../posix/signal.sig
+ ../../posix/signal.sml
+ ../../posix/proc-env.sig
+ ../../posix/proc-env.sml
+ ../../posix/file-sys.sig
+ ../../posix/file-sys.sml
+ ../../posix/io.sig
+ ../../posix/io.sml
+ ../../posix/process.sig
+ ../../posix/process.sml
+ ../../posix/sys-db.sig
+ ../../posix/sys-db.sml
+ ../../posix/tty.sig
+ ../../posix/tty.sml
+ ../../posix/posix.sig
+ ../../posix/posix.sml
+
+ ../../platform/cygwin.sml
+
+ ../../io/stream-io.sig
+ ../../io/stream-io.fun
+ ../../io/imperative-io.sig
+ ../../io/imperative-io.fun
+ ../../io/bin-stream-io.sig
+ ../../io/bin-io.sig
+ ../../io/bin-io.sml
+ ../../io/text-stream-io.sig
+ ../../io/text-io.sig
+ ../../io/text-io.sml
+
+ ../../system/path.sig
+ ../../system/path.sml
+ ../../system/file-sys.sig
+ ../../system/file-sys.sml
+ ../../system/command-line.sig
+ ../../system/command-line.sml
+
+ ../../general/sml90.sig
+ ../../general/sml90.sml
+
+ ../../mlton/pointer.sig
+ ../../mlton/pointer.sml
+ ../../mlton/call-stack.sig
+ ../../mlton/call-stack.sml
+ ../../mlton/exit.sml
+ ../../mlton/exn.sig
+ ../../mlton/exn.sml
+ ../../mlton/thread.sig
+ ../../mlton/thread.sml
+ ../../mlton/signal.sig
+ ../../mlton/signal.sml
+ ../../mlton/process.sig
+ ../../mlton/process.sml
+ ../../mlton/gc.sig
+ ../../mlton/gc.sml
+ ../../mlton/rusage.sig
+ ../../mlton/rusage.sml
+
+ ../../system/process.sig
+ ../../system/process.sml
+ ../../system/io.sig
+ ../../system/io.sml
+ ../../system/os.sig
+ ../../system/os.sml
+ ../../system/unix.sig
+ ../../system/unix.sml
+ ../../system/timer.sig
+ ../../system/timer.sml
+
+ ../../net/net.sig
+ ../../net/net.sml
+ ../../net/net-host-db.sig
+ ../../net/net-host-db.sml
+ ../../net/net-prot-db.sig
+ ../../net/net-prot-db.sml
+ ../../net/net-serv-db.sig
+ ../../net/net-serv-db.sml
+ ../../net/socket.sig
+ ../../net/socket.sml
+ ../../net/generic-sock.sig
+ ../../net/generic-sock.sml
+ ../../net/inet-sock.sig
+ ../../net/inet-sock.sml
+ ../../net/unix-sock.sig
+ ../../net/unix-sock.sml
+
+ ../../mlton/array.sig
+ ../../mlton/cont.sig
+ ../../mlton/cont.sml
+ ../../mlton/random.sig
+ ../../mlton/random.sml
+ ../../mlton/io.sig
+ ../../mlton/io.fun
+ ../../mlton/text-io.sig
+ ../../mlton/bin-io.sig
+ ../../mlton/itimer.sig
+ ../../mlton/itimer.sml
+ ../../mlton/ffi.sig
+ ann
+ "ffiStr MLtonFFI"
+ in
+ ../../mlton/ffi.sml
+ end
+ ../../mlton/int-inf.sig
+ ../../mlton/platform.sig
+ ../../mlton/platform.sml
+ ../../mlton/proc-env.sig
+ ../../mlton/proc-env.sml
+ ../../mlton/profile.sig
+ ../../mlton/profile.sml
+ (*
+ # mlton/ptrace.sig
+ # mlton/ptrace.sml
+ *)
+ ../../mlton/rlimit.sig
+ ../../mlton/rlimit.sml
+ ../../mlton/socket.sig
+ ../../mlton/socket.sml
+ ../../mlton/syslog.sig
+ ../../mlton/syslog.sml
+ ../../mlton/vector.sig
+ ../../mlton/weak.sig
+ ../../mlton/weak.sml
+ ../../mlton/finalizable.sig
+ ../../mlton/finalizable.sml
+ ../../mlton/word.sig
+ ../../mlton/world.sig
+ ../../mlton/world.sml
+ ../../mlton/mlton.sig
+ ../../mlton/mlton.sml
+
+ ../../sml-nj/sml-nj.sig
+ ../../sml-nj/sml-nj.sml
+ ../../sml-nj/unsafe.sig
+ ../../sml-nj/unsafe.sml
+
+ top-level/basis.sig
+ ann
+ "allowRebindEquals true"
+ in
+ top-level/basis.sml
+ end
+ in
+ structure BasisExtra
+ top-level/basis-sigs.sml
+ top-level/basis-funs.sml
+ top-level/top-level.sml
+ end
+*)
+end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config0.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config0.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,30 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Char8 = Primitive.Char8
+structure Char16 = Primitive.Char16
+structure Char32 = Primitive.Char32
+
+structure Int8 = Primitive.Int8
+structure Int16 = Primitive.Int16
+structure Int32 = Primitive.Int32
+structure Int64 = Primitive.Int64
+structure IntInf = Primitive.IntInf
+
+structure Pointer = Primitive.Pointer
+
+structure Real32 = Primitive.Real32
+structure Real64 = Primitive.Real64
+
+structure String8 = Primitive.String8
+structure String16 = Primitive.String16
+structure String32 = Primitive.String32
+
+structure Word8 = Primitive.Word8
+structure Word16 = Primitive.Word16
+structure Word32 = Primitive.Word32
+structure Word64 = Primitive.Word64
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,30 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Char8 = Primitive.Char8
+structure Char16 = Primitive.Char16
+structure Char32 = Primitive.Char32
+
+structure Int8 = Int8
+structure Int16 = Int16
+structure Int32 = Int32
+structure Int64 = Int64
+structure IntInf = IntInf
+
+structure Pointer = Primitive.Pointer
+
+structure Real32 = Primitive.Real32
+structure Real64 = Primitive.Real64
+
+structure String8 = Primitive.String8
+structure String16 = Primitive.String16
+structure String32 = Primitive.String32
+
+structure Word8 = Word8
+structure Word16 = Word16
+structure Word32 = Word32
+structure Word64 = Word64
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m32.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,128 @@
+(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+
+(* C *)
+structure C_Char = struct open Int8 type t = int end
+functor C_Char_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_SChar = struct open Int8 type t = int end
+functor C_SChar_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_UChar = struct open Word8 type t = word end
+functor C_UChar_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Short = struct open Int16 type t = int end
+functor C_Short_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SShort = struct open Int16 type t = int end
+functor C_SShort_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_UShort = struct open Word16 type t = word end
+functor C_UShort_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Int = struct open Int32 type t = int end
+functor C_Int_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SInt = struct open Int32 type t = int end
+functor C_SInt_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UInt = struct open Word32 type t = word end
+functor C_UInt_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Long = struct open Int32 type t = int end
+functor C_Long_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SLong = struct open Int32 type t = int end
+functor C_SLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_ULong = struct open Word32 type t = word end
+functor C_ULong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_LongLong = struct open Int64 type t = int end
+functor C_LongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SLongLong = struct open Int64 type t = int end
+functor C_SLongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_ULongLong = struct open Word64 type t = word end
+functor C_ULongLong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Float = struct open Real32 type t = real end
+functor C_Float_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real32 (A)
+structure C_Double = struct open Real64 type t = real end
+functor C_Double_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real64 (A)
+structure C_Size = struct open Word32 type t = word end
+functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+structure C_Pointer = Pointer
+structure C_String = Pointer
+structure C_StringArray = Pointer
+
+(* Generic integers *)
+structure C_Fd = C_Int
+functor C_Fd_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Signal = C_Int
+functor C_Signal_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Status = C_Int
+functor C_Status_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Sock = C_Int
+functor C_Sock_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+
+(* C99 *)
+structure C_Ptrdiff = struct open Int32 type t = int end
+functor C_Ptrdiff_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_Intmax = struct open Int64 type t = int end
+functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UIntmax = struct open Word64 type t = word end
+functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <dirent.h> *)
+structure C_DirP = struct open Word32 type t = word end
+functor C_DirP_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <poll.h> *)
+structure C_NFds = struct open Word32 type t = word end
+functor C_NFds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <resource.h> *)
+structure C_RLim = struct open Word64 type t = word end
+functor C_RLim_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <sys/types.h> *)
+structure C_Clock = struct open Int32 type t = int end
+functor C_Clock_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_Dev = struct open Word64 type t = word end
+functor C_Dev_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_GId = struct open Word32 type t = word end
+functor C_GId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Id = struct open Word32 type t = word end
+functor C_Id_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_INo = struct open Word64 type t = word end
+functor C_INo_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Mode = struct open Word32 type t = word end
+functor C_Mode_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_NLink = struct open Word32 type t = word end
+functor C_NLink_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Off = struct open Int64 type t = int end
+functor C_Off_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_PId = struct open Int32 type t = int end
+functor C_PId_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SSize = struct open Int32 type t = int end
+functor C_SSize_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SUSeconds = struct open Int32 type t = int end
+functor C_SUSeconds_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_Time = struct open Int32 type t = int end
+functor C_Time_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UId = struct open Word32 type t = word end
+functor C_UId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_USeconds = struct open Word32 type t = word end
+functor C_USeconds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <sys/socket.h> *)
+structure C_Socklen = struct open Word32 type t = word end
+functor C_Socklen_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <termios.h> *)
+structure C_CC = struct open Word8 type t = word end
+functor C_CC_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Speed = struct open Word32 type t = word end
+functor C_Speed_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_TCFlag = struct open Word32 type t = word end
+functor C_TCFlag_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from "gmp.h" *)
+structure C_MPLimb = struct open Word32 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+
+structure C_Errno = struct type 'a t = 'a end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.m64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,128 @@
+(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+
+(* C *)
+structure C_Char = struct open Int8 type t = int end
+functor C_Char_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_SChar = struct open Int8 type t = int end
+functor C_SChar_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_UChar = struct open Word8 type t = word end
+functor C_UChar_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Short = struct open Int16 type t = int end
+functor C_Short_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SShort = struct open Int16 type t = int end
+functor C_SShort_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_UShort = struct open Word16 type t = word end
+functor C_UShort_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Int = struct open Int32 type t = int end
+functor C_Int_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SInt = struct open Int32 type t = int end
+functor C_SInt_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UInt = struct open Word32 type t = word end
+functor C_UInt_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Long = struct open Int64 type t = int end
+functor C_Long_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SLong = struct open Int64 type t = int end
+functor C_SLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_ULong = struct open Word64 type t = word end
+functor C_ULong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_LongLong = struct open Int64 type t = int end
+functor C_LongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SLongLong = struct open Int64 type t = int end
+functor C_SLongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_ULongLong = struct open Word64 type t = word end
+functor C_ULongLong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Float = struct open Real32 type t = real end
+functor C_Float_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real32 (A)
+structure C_Double = struct open Real64 type t = real end
+functor C_Double_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real64 (A)
+structure C_Size = struct open Word64 type t = word end
+functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+structure C_Pointer = Pointer
+structure C_String = Pointer
+structure C_StringArray = Pointer
+
+(* Generic integers *)
+structure C_Fd = C_Int
+functor C_Fd_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Signal = C_Int
+functor C_Signal_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Status = C_Int
+functor C_Status_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Sock = C_Int
+functor C_Sock_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+
+(* C99 *)
+structure C_Ptrdiff = struct open Int64 type t = int end
+functor C_Ptrdiff_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_Intmax = struct open Int64 type t = int end
+functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UIntmax = struct open Word64 type t = word end
+functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <dirent.h> *)
+structure C_DirP = struct open Word64 type t = word end
+functor C_DirP_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <poll.h> *)
+structure C_NFds = struct open Word64 type t = word end
+functor C_NFds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <resource.h> *)
+structure C_RLim = struct open Word64 type t = word end
+functor C_RLim_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+(* from <sys/types.h> *)
+structure C_Clock = struct open Int64 type t = int end
+functor C_Clock_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_Dev = struct open Word64 type t = word end
+functor C_Dev_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_GId = struct open Word32 type t = word end
+functor C_GId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Id = struct open Word32 type t = word end
+functor C_Id_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_INo = struct open Word64 type t = word end
+functor C_INo_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Mode = struct open Word32 type t = word end
+functor C_Mode_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_NLink = struct open Word64 type t = word end
+functor C_NLink_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Off = struct open Int64 type t = int end
+functor C_Off_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_PId = struct open Int32 type t = int end
+functor C_PId_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SSize = struct open Int64 type t = int end
+functor C_SSize_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SUSeconds = struct open Int64 type t = int end
+functor C_SUSeconds_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_Time = struct open Int64 type t = int end
+functor C_Time_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UId = struct open Word32 type t = word end
+functor C_UId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_USeconds = struct open Word32 type t = word end
+functor C_USeconds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <sys/socket.h> *)
+structure C_Socklen = struct open Word32 type t = word end
+functor C_Socklen_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <termios.h> *)
+structure C_CC = struct open Word8 type t = word end
+functor C_CC_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Speed = struct open Word32 type t = word end
+functor C_Speed_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_TCFlag = struct open Word32 type t = word end
+functor C_TCFlag_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from "gmp.h" *)
+structure C_MPLimb = struct open Word64 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+
+
+structure C_Errno = struct type 'a t = 'a end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,128 @@
+(* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+
+(* C *)
+structure C_Char = struct open Int64 type t = int end
+functor C_Char_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_SChar = struct open Int64 type t = int end
+functor C_SChar_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int64 (A)
+structure C_UChar = struct open Word64 type t = word end
+functor C_UChar_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Short = struct open Int8 type t = int end
+functor C_Short_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_SShort = struct open Int8 type t = int end
+functor C_SShort_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int8 (A)
+structure C_UShort = struct open Word8 type t = word end
+functor C_UShort_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word8 (A)
+structure C_Int = struct open Int16 type t = int end
+functor C_Int_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SInt = struct open Int16 type t = int end
+functor C_SInt_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_UInt = struct open Word16 type t = word end
+functor C_UInt_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Long = struct open Int16 type t = int end
+functor C_Long_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SLong = struct open Int16 type t = int end
+functor C_SLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_ULong = struct open Word16 type t = word end
+functor C_ULong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_LongLong = struct open Int32 type t = int end
+functor C_LongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_SLongLong = struct open Int32 type t = int end
+functor C_SLongLong_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_ULongLong = struct open Word32 type t = word end
+functor C_ULongLong_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Float = struct open Real32 type t = real end
+functor C_Float_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real32 (A)
+structure C_Double = struct open Real64 type t = real end
+functor C_Double_ChooseRealN (A: CHOOSE_REALN_ARG) = ChooseRealN_Real64 (A)
+structure C_Size = struct open Word16 type t = word end
+functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+structure C_Pointer = Pointer
+structure C_String = Pointer
+structure C_StringArray = Pointer
+
+(* Generic integers *)
+structure C_Fd = C_Int
+functor C_Fd_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Signal = C_Int
+functor C_Signal_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Status = C_Int
+functor C_Status_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+structure C_Sock = C_Int
+functor C_Sock_ChooseIntN (A: CHOOSE_INTN_ARG) = C_Int_ChooseIntN (A)
+
+(* C99 *)
+structure C_Ptrdiff = struct open Int16 type t = int end
+functor C_Ptrdiff_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_Intmax = struct open Int32 type t = int end
+functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntmax = struct open Word32 type t = word end
+functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <dirent.h> *)
+structure C_DirP = struct open Word16 type t = word end
+functor C_DirP_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+(* from <poll.h> *)
+structure C_NFds = struct open Word16 type t = word end
+functor C_NFds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+(* from <resource.h> *)
+structure C_RLim = struct open Word32 type t = word end
+functor C_RLim_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+
+(* from <sys/types.h> *)
+structure C_Clock = struct open Int16 type t = int end
+functor C_Clock_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_Dev = struct open Word32 type t = word end
+functor C_Dev_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_GId = struct open Word16 type t = word end
+functor C_GId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Id = struct open Word16 type t = word end
+functor C_Id_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_INo = struct open Word32 type t = word end
+functor C_INo_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Mode = struct open Word16 type t = word end
+functor C_Mode_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_NLink = struct open Word16 type t = word end
+functor C_NLink_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_Off = struct open Int32 type t = int end
+functor C_Off_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_PId = struct open Int16 type t = int end
+functor C_PId_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SSize = struct open Int16 type t = int end
+functor C_SSize_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_SUSeconds = struct open Int16 type t = int end
+functor C_SUSeconds_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_Time = struct open Int16 type t = int end
+functor C_Time_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int16 (A)
+structure C_UId = struct open Word16 type t = word end
+functor C_UId_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_USeconds = struct open Word16 type t = word end
+functor C_USeconds_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+(* from <sys/socket.h> *)
+structure C_Socklen = struct open Word16 type t = word end
+functor C_Socklen_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+(* from <termios.h> *)
+structure C_CC = struct open Word64 type t = word end
+functor C_CC_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word64 (A)
+structure C_Speed = struct open Word16 type t = word end
+functor C_Speed_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+structure C_TCFlag = struct open Word16 type t = word end
+functor C_TCFlag_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+(* from "gmp.h" *)
+structure C_MPLimb = struct open Word16 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
+
+
+structure C_Errno = struct type 'a t = 'a end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,11 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Char = Char8
+type char = Char.char
+structure String = String8
+type string = String.string
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,33 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Int = Int32
+type int = Int.int
+
+functor CharAddToFromInt(type char
+ val fromInt32 : Int32.int -> char
+ val toInt32 : char -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ end
+functor IntAddToFromInt(type int
+ val fromInt32 : Int32.int -> int
+ val toInt32 : int -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ end
+functor WordAddToFromInt(type word
+ val fromInt32 : Int32.int -> word
+ val toInt32 : word -> Int32.int
+ val toInt32X : word -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ val toIntX = toInt32X
+ end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,33 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Int = Int64
+type int = Int.int
+
+functor CharAddToFromInt(type char
+ val fromInt64 : Int64.int -> char
+ val toInt64 : char -> Int64.int) =
+ struct
+ val fromInt = fromInt64
+ val toInt = toInt64
+ end
+functor IntAddToFromInt(type int
+ val fromInt64 : Int64.int -> int
+ val toInt64 : int -> Int64.int) =
+ struct
+ val fromInt = fromInt64
+ val toInt = toInt64
+ end
+functor WordAddToFromInt(type word
+ val fromInt64 : Int64.int -> word
+ val toInt64 : word -> Int64.int
+ val toInt64X : word -> Int64.int) =
+ struct
+ val fromInt = fromInt64
+ val toInt = toInt64
+ val toIntX = toInt64X
+ end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,33 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Int = IntInf
+type int = Int.int
+
+functor CharAddToFromInt(type char
+ val fromInt32 : Int32.int -> char
+ val toInt32 : char -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ end
+functor IntAddToFromInt(type int
+ val fromInt32 : Int32.int -> int
+ val toInt32 : int -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ end
+functor WordAddToFromInt(type word
+ val fromInt32 : Int32.int -> word
+ val toInt32 : word -> Int32.int
+ val toInt32X : word -> Int32.int) =
+ struct
+ val fromInt = fromInt32
+ val toInt = toInt32
+ val toIntX = toInt32X
+ end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-real64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-real64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-real64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,9 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Real = Real64
+type real = Real.real
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,19 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Word = Word32
+type word = Word.word
+
+functor WordAddToFromWord(type word
+ val fromWord32 : Word32.word -> word
+ val toWord32 : word -> Word32.word
+ val toWord32X : word -> Word32.word) =
+ struct
+ val fromWord = fromWord32
+ val toWord = toWord32
+ val toWordX = toWord32X
+ end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,19 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Word = Word64
+type word = Word.word
+
+functor WordAddToFromWord(type word
+ val fromWord64 : Word64.word -> word
+ val toWord64 : word -> Word64.word
+ val toWord64X : word -> Word64.word) =
+ struct
+ val fromWord = fromWord64
+ val toWord = toWord64
+ val toWordX = toWord64X
+ end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep32.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep32.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,16 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure ObjptrInt = Int32
+structure ObjptrWord = Word32
+
+functor ObjptrInt_ChooseIntN (A: CHOOSE_INTN_ARG) :
+ sig val f : ObjptrInt.int A.t end =
+ ChooseIntN_Int32 (A)
+functor ObjptrWord_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : ObjptrWord.word A.t end =
+ ChooseWordN_Word32 (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/objptr/objptr-rep64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,16 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure ObjptrInt = Int64
+structure ObjptrWord = Word64
+
+functor ObjptrInt_ChooseIntN (A: CHOOSE_INTN_ARG) :
+ sig val f : ObjptrInt.int A.t end =
+ ChooseIntN_Int64 (A)
+functor ObjptrWord_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : ObjptrWord.word A.t end =
+ ChooseWordN_Word64 (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,12 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure SeqIndex = Int32
+
+functor SeqIndex_ChooseIntN (A: CHOOSE_INTN_ARG) :
+ sig val f : SeqIndex.int A.t end =
+ ChooseIntN_Int32 (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,12 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure SeqIndex = Int64
+
+functor SeqIndex_ChooseIntN (A: CHOOSE_INTN_ARG) :
+ sig val f : SeqIndex.int A.t end =
+ ChooseIntN_Int64 (A)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,1321 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature INT_INF0 =
+ sig
+ eqtype int
+ type t = int
+
+ datatype rep =
+ Big of C_MPLimb.word vector
+ | Small of ObjptrInt.int
+ val rep: int -> rep
+ val areSmall: int * int -> bool
+
+ val maxInt: int option
+ val minInt: int option
+
+ val zero: int
+ val one: int
+
+ val abs: int -> int
+ val + : int * int -> int
+ val divMod: int * int -> int * int
+ val div: int * int -> int
+ val gcd: int * int -> int
+ val mod: int * int -> int
+ val * : int * int -> int
+ val ~ : int -> int
+ val quotRem: int * int -> int * int
+ val quot: int * int -> int
+ val rem: int * int -> int
+ val - : int * int -> int
+
+ val < : int * int -> bool
+ val <= : int * int -> bool
+ val > : int * int -> bool
+ val >= : int * int -> bool
+ val compare: int * int -> Primitive.Order.order
+ val min: int * int -> int
+ val max: int * int -> int
+
+ val andb: int * int -> int
+ val << : int * Primitive.Word32.word -> int
+ val notb: int -> int
+ val orb: int * int -> int
+ val ~>> : int * Primitive.Word32.word -> int
+ val xorb: int * int -> int
+
+ val toString8: int -> Primitive.String8.string
+
+ val fromInt8: Primitive.Int8.int -> int
+ val fromInt16: Primitive.Int16.int -> int
+ val fromInt32: Primitive.Int32.int -> int
+ val fromInt64: Primitive.Int64.int -> int
+ val fromIntInf: Primitive.IntInf.int -> int
+
+ val fromWord8: Primitive.Word8.word -> int
+ val fromWord16: Primitive.Word16.word -> int
+ val fromWord32: Primitive.Word32.word -> int
+ val fromWord64: Primitive.Word64.word -> int
+
+ val fromWordX8: Primitive.Word8.word -> int
+ val fromWordX16: Primitive.Word16.word -> int
+ val fromWordX32: Primitive.Word32.word -> int
+ val fromWordX64: Primitive.Word64.word -> int
+
+ val toInt8: int -> Primitive.Int8.int
+ val toInt16: int -> Primitive.Int16.int
+ val toInt32: int -> Primitive.Int32.int
+ val toInt64: int -> Primitive.Int64.int
+ val toIntInf: int -> Primitive.IntInf.int
+
+ val toWord8: int -> Primitive.Word8.word
+ val toWord16: int -> Primitive.Word16.word
+ val toWord32: int -> Primitive.Word32.word
+ val toWord64: int -> Primitive.Word64.word
+
+ val toWordX8: int -> Primitive.Word8.word
+ val toWordX16: int -> Primitive.Word16.word
+ val toWordX32: int -> Primitive.Word32.word
+ val toWordX64: int -> Primitive.Word64.word
+ end
+
+structure Primitive = struct
+
+open Primitive
+
+structure IntInf : INT_INF0 =
+ struct
+ structure Prim = Primitive.IntInf
+
+ structure A = Primitive.Array
+ structure V = Primitive.Vector
+ structure S = SeqIndex
+
+ structure W = ObjptrWord
+ structure I = ObjptrInt
+ structure MPLimb = C_MPLimb
+ structure Sz = struct
+ open C_Size
+ local
+ structure S =
+ SeqIndex_ChooseIntN
+ (type 'a t = 'a -> C_Size.word
+ val fInt8 = C_Size.fromInt8
+ val fInt16 = C_Size.fromInt16
+ val fInt32 = C_Size.fromInt32
+ val fInt64 = C_Size.fromInt64)
+ in
+ val fromSeqIndex = S.f
+ end
+ end
+
+ type bigInt = Prim.int
+ datatype rep =
+ Big of MPLimb.t V.vector
+ | Small of ObjptrInt.int
+
+ val zero: bigInt = 0
+ val one: bigInt = 1
+ val negOne: bigInt = ~1
+
+ (* Check if an IntInf.int is small (i.e., a fixnum). *)
+ fun isSmall (i: bigInt): bool =
+ 0w0 <> W.andb (Prim.toWord i, 0w1)
+
+ (* Check if two IntInf.int's are both small (i.e., fixnums). *)
+ fun areSmall (i: bigInt, i': bigInt): bool =
+ 0w0 <> W.andb (W.andb (Prim.toWord i, Prim.toWord i'), 0w1)
+
+ (* Return the number of `limbs' in a bigInt. *)
+ fun bigNumLimbs i = S.- (V.length (Prim.toVector i), 1)
+ fun numLimbs i =
+ if isSmall i
+ then 1
+ else bigNumLimbs i
+
+ fun dropTag (w: W.word): W.word = W.~>> (w, 0w1)
+ fun dropTagCoerce (i: bigInt): W.word = dropTag (Prim.toWord i)
+ fun dropTagCoerceInt (i: bigInt): I.int = W.toIntXEq (dropTagCoerce i)
+ fun addTag (w: W.word): W.word = W.orb (W.<< (w, 0w1), 0w1)
+ fun addTagCoerce (w: W.word): bigInt = Prim.fromWord (addTag w)
+ fun addTagCoerceInt (i: I.int): bigInt = addTagCoerce (W.fromIntEq i)
+ fun zeroTag (w: W.word): W.word = W.andb (w, W.notb 0w1)
+ fun oneTag (w: W.word): W.word = W.orb (w, 0w1)
+ fun oneTagCoerce (w: W.word): bigInt = Prim.fromWord (oneTag w)
+
+ fun rep i =
+ if isSmall i
+ then Small (dropTagCoerceInt i)
+ else Big (Prim.toVector i)
+
+ fun 'a buildBigInt {toMPLimb: 'a -> MPLimb.word,
+ other : {zero: 'a,
+ eq: 'a * 'a -> bool,
+ rshift: 'a * Word32.word -> 'a}}
+ (isneg, ans) =
+ let
+ fun loop (ans, i, acc) =
+ if (#eq other) (ans, (#zero other))
+ then (i, acc)
+ else let
+ val limb = toMPLimb ans
+ val ans = (#rshift other) (ans, MPLimb.wordSizeWord')
+ in
+ loop (ans, S.+ (i, 1), (i, limb) :: acc)
+ end
+ val (n, acc) = loop (ans, 1, [(0, if isneg then 0w1 else 0w0)])
+ val a = A.array n
+ fun loop acc =
+ case acc of
+ [] => ()
+ | (i, v) :: acc => (A.update (a, i, v)
+ ; loop acc)
+ val () = loop acc
+ in
+ Prim.fromVector (V.fromArray a)
+ end
+
+ local
+ fun 'a make {toMPLimb: 'a -> MPLimb.word,
+ toObjptrWord: 'a -> ObjptrWord.word,
+ toObjptrWordX: 'a -> ObjptrWord.word,
+ other : {precision': Int32.int,
+ zero: 'a,
+ one: 'a,
+ neg: 'a -> 'a,
+ eq: 'a * 'a -> bool,
+ lt: 'a * 'a -> bool,
+ rashift: 'a * Word32.word -> 'a,
+ rshift: 'a * Word32.word -> 'a}} =
+ let
+ fun fromInt i =
+ if Int32.> (ObjptrWord.wordSize', #precision' other)
+ then Prim.fromWord (addTag (toObjptrWordX i))
+ else let
+ val upperBits =
+ (#rashift other)
+ (i, Word32.- (ObjptrWord.wordSizeWord', 0w2))
+ in
+ if (#eq other) (upperBits, #zero other)
+ orelse (#eq other) (upperBits, (#neg other) (#one other))
+ then Prim.fromWord (addTag (toObjptrWord i))
+ else let
+ val (isneg, ans) =
+ if (#lt other) (i, (#zero other))
+ then (true, (#neg other) i)
+ else (false, i)
+ in
+ buildBigInt
+ {toMPLimb = toMPLimb,
+ other = {zero = #zero other,
+ eq = #eq other,
+ rshift = #rshift other}}
+ (isneg, ans)
+ end
+ end
+ in
+ fromInt
+ end
+ in
+ val fromInt8 =
+ make {toMPLimb = MPLimb.fromIntZ8,
+ toObjptrWord = ObjptrWord.fromIntZ8,
+ toObjptrWordX = ObjptrWord.fromInt8,
+ other = {precision' = Int8.precision',
+ zero = Int8.zero,
+ one = Int8.one,
+ neg = Int8.~,
+ eq = ((op =) : Int8.int * Int8.int -> bool),
+ lt = Int8.<,
+ rashift = Int8.~>>,
+ rshift = Int8.>>}}
+ val fromInt16 =
+ make {toMPLimb = MPLimb.fromIntZ16,
+ toObjptrWord = ObjptrWord.fromIntZ16,
+ toObjptrWordX = ObjptrWord.fromInt16,
+ other = {precision' = Int16.precision',
+ zero = Int16.zero,
+ one = Int16.one,
+ neg = Int16.~,
+ eq = ((op =) : Int16.int * Int16.int -> bool),
+ lt = Int16.<,
+ rashift = Int16.~>>,
+ rshift = Int16.>>}}
+ val fromInt32 =
+ make {toMPLimb = MPLimb.fromIntZ32,
+ toObjptrWord = ObjptrWord.fromIntZ32,
+ toObjptrWordX = ObjptrWord.fromInt32,
+ other = {precision' = Int32.precision',
+ zero = Int32.zero,
+ one = Int32.one,
+ neg = Int32.~,
+ eq = ((op =) : Int32.int * Int32.int -> bool),
+ lt = Int32.<,
+ rashift = Int32.~>>,
+ rshift = Int32.>>}}
+ val fromInt64 =
+ make {toMPLimb = MPLimb.fromIntZ64,
+ toObjptrWord = ObjptrWord.fromIntZ64,
+ toObjptrWordX = ObjptrWord.fromInt64,
+ other = {precision' = Int64.precision',
+ zero = Int64.zero,
+ one = Int64.one,
+ neg = Int64.~,
+ eq = ((op =) : Int64.int * Int64.int -> bool),
+ lt = Int64.<,
+ rashift = Int64.~>>,
+ rshift = Int64.>>}}
+ val fromIntInf = fn i => i
+ end
+
+ local
+ structure S =
+ ObjptrInt_ChooseIntN
+ (type 'a t = 'a -> bigInt
+ val fInt8 = fromInt8
+ val fInt16 = fromInt16
+ val fInt32 = fromInt32
+ val fInt64 = fromInt64)
+ in
+ val fromObjptrInt = S.f
+ end
+
+ local
+ fun 'a make {toMPLimb: 'a -> MPLimb.word,
+ toObjptrWord: 'a -> ObjptrWord.word,
+ other : {wordSize': Int32.int,
+ zero: 'a,
+ one: 'a,
+ eq: 'a * 'a -> bool,
+ lt: 'a * 'a -> bool,
+ rshift: 'a * Word32.word -> 'a}} =
+ let
+ fun fromWord w =
+ if Int32.> (ObjptrWord.wordSize', #wordSize' other)
+ then Prim.fromWord (addTag (toObjptrWord w))
+ else let
+ val upperBits =
+ (#rshift other)
+ (w, Word32.- (ObjptrWord.wordSizeWord', 0w2))
+ in
+ if (#eq other) (upperBits, #zero other)
+ then Prim.fromWord (addTag (toObjptrWord w))
+ else let
+ val ans = w
+ in
+ buildBigInt
+ {toMPLimb = toMPLimb,
+ other = {zero = #zero other,
+ eq = #eq other,
+ rshift = #rshift other}}
+ (false, ans)
+ end
+ end
+ in
+ fromWord
+ end
+ in
+ val fromWord8 =
+ make {toMPLimb = MPLimb.fromWord8,
+ toObjptrWord = ObjptrWord.fromWord8,
+ other = {wordSize' = Word8.wordSize',
+ zero = Word8.zero,
+ one = Word8.one,
+ eq = ((op =) : Word8.word * Word8.word -> bool),
+ lt = Word8.<,
+ rshift = Word8.>>}}
+ val fromWord16 =
+ make {toMPLimb = MPLimb.fromWord16,
+ toObjptrWord = ObjptrWord.fromWord16,
+ other = {wordSize' = Word16.wordSize',
+ zero = Word16.zero,
+ one = Word16.one,
+ eq = ((op =) : Word16.word * Word16.word -> bool),
+ lt = Word16.<,
+ rshift = Word16.>>}}
+ val fromWord32 =
+ make {toMPLimb = MPLimb.fromWord32,
+ toObjptrWord = ObjptrWord.fromWord32,
+ other = {wordSize' = Word32.wordSize',
+ zero = Word32.zero,
+ one = Word32.one,
+ eq = ((op =) : Word32.word * Word32.word -> bool),
+ lt = Word32.<,
+ rshift = Word32.>>}}
+ val fromWord64 =
+ make {toMPLimb = MPLimb.fromWord64,
+ toObjptrWord = ObjptrWord.fromWord64,
+ other = {wordSize' = Word64.wordSize',
+ zero = Word64.zero,
+ one = Word64.one,
+ eq = ((op =) : Word64.word * Word64.word -> bool),
+ lt = Word64.<,
+ rshift = Word64.>>}}
+ end
+
+ val fromWordX8 : Word8.word -> bigInt =
+ fn w => fromInt8 (Int8.fromWordX8 w)
+ val fromWordX16 : Word16.word -> bigInt =
+ fn w => fromInt16 (Int16.fromWordX16 w)
+ val fromWordX32 : Word32.word -> bigInt =
+ fn w => fromInt32 (Int32.fromWordX32 w)
+ val fromWordX64 : Word64.word -> bigInt =
+ fn w => fromInt64 (Int64.fromWordX64 w)
+
+ local
+ fun 'a make {fromMPLimb: MPLimb.word -> 'a,
+ fromObjptrWordX: ObjptrWord.word -> 'a,
+ other : {precision': Int32.int,
+ zero: 'a,
+ lshift: 'a * Word32.word -> 'a,
+ neg: 'a -> 'a,
+ orb: 'a * 'a -> 'a}} =
+ let
+ val limbsPer =
+ if Int32.>= (MPLimb.wordSize', #precision' other)
+ then 1
+ else S.fromInt32 (Int32.quot (#precision' other, MPLimb.wordSize'))
+ fun toInt i =
+ if isSmall i
+ then fromObjptrWordX (dropTagCoerce i)
+ else if Int32.> (ObjptrWord.wordSize', #precision' other)
+ then raise Overflow
+ else
+ let
+ val v = Prim.toVector i
+ val n = V.length v
+ val isneg = V.sub (v, 0) <> 0w0
+ val ans =
+ if S.> (S.- (n, 1), limbsPer)
+ then raise Overflow
+ else if Int32.>= (MPLimb.wordSize', #precision' other)
+ then fromMPLimb (V.sub (v, 1))
+ else
+ let
+ fun loop (i, ans) =
+ if S.> (i, 0)
+ then let
+ val ans =
+ (#orb other)
+ ((#lshift other)
+ (ans, MPLimb.wordSizeWord'),
+ fromMPLimb (V.sub (v, i)))
+ in
+ loop (S.- (i, 1), ans)
+ end
+ else ans
+ in
+ loop (S.- (n, 1), #zero other)
+ end
+ in
+ if isneg then (#neg other) ans else ans
+ end
+ in
+ toInt
+ end
+ in
+ val toInt8 =
+ make {fromMPLimb = MPLimb.toInt8,
+ fromObjptrWordX = ObjptrWord.toIntX8,
+ other = {precision' = Int8.precision',
+ zero = Int8.zero,
+ lshift = Int8.<<,
+ neg = Int8.~,
+ orb = Int8.orb}}
+ val toInt16 =
+ make {fromMPLimb = MPLimb.toInt16,
+ fromObjptrWordX = ObjptrWord.toIntX16,
+ other = {precision' = Int16.precision',
+ zero = Int16.zero,
+ lshift = Int16.<<,
+ neg = Int16.~,
+ orb = Int16.orb}}
+ val toInt32 =
+ make {fromMPLimb = MPLimb.toInt32,
+ fromObjptrWordX = ObjptrWord.toIntX32,
+ other = {precision' = Int32.precision',
+ zero = Int32.zero,
+ lshift = Int32.<<,
+ neg = Int32.~,
+ orb = Int32.orb}}
+ val toInt64 =
+ make {fromMPLimb = MPLimb.toInt64,
+ fromObjptrWordX = ObjptrWord.toIntX64,
+ other = {precision' = Int64.precision',
+ zero = Int64.zero,
+ lshift = Int64.<<,
+ neg = Int64.~,
+ orb = Int64.orb}}
+ val toIntInf = fn i => i
+ end
+
+ local
+ fun 'a make {fromMPLimb: MPLimb.word -> 'a,
+ fromObjptrWordX: ObjptrWord.word -> 'a,
+ other : {wordSize': Int32.int,
+ zero: 'a,
+ lshift: 'a * Word32.word -> 'a,
+ neg: 'a -> 'a,
+ orb: 'a * 'a -> 'a}} =
+ let
+ val limbsPer =
+ if Int32.>= (MPLimb.wordSize', #wordSize' other)
+ then 1
+ else S.fromInt32 (Int32.quot (#wordSize' other, MPLimb.wordSize'))
+ fun toWord i =
+ if isSmall i
+ then fromObjptrWordX (dropTagCoerce i)
+ else let
+ val v = Prim.toVector i
+ val n = V.length v
+ val isneg = V.sub (v, 0) <> 0w0
+ val ans =
+ let
+ fun loop (i, ans) =
+ if S.> (i, 0)
+ then let
+ val ans =
+ (#orb other)
+ ((#lshift other)
+ (ans, MPLimb.wordSizeWord'),
+ fromMPLimb (V.sub (v, i)))
+ in
+ loop (S.- (i, 1), ans)
+ end
+ else ans
+ in
+ loop (S.min (S.- (n, 1), limbsPer), #zero other)
+ end
+ in
+ if isneg then (#neg other) ans else ans
+ end
+ in
+ toWord
+ end
+ in
+ val toWord8 =
+ make {fromMPLimb = MPLimb.toWord8,
+ fromObjptrWordX = ObjptrWord.toWordX8,
+ other = {wordSize' = Word8.wordSize',
+ zero = Word8.zero,
+ lshift = Word8.<<,
+ neg = Word8.~,
+ orb = Word8.orb}}
+ val toWordX8 = toWord8
+ val toWord16 =
+ make {fromMPLimb = MPLimb.toWord16,
+ fromObjptrWordX = ObjptrWord.toWordX16,
+ other = {wordSize' = Word16.wordSize',
+ zero = Word16.zero,
+ lshift = Word16.<<,
+ neg = Word16.~,
+ orb = Word16.orb}}
+ val toWordX16 = toWord16
+ val toWord32 =
+ make {fromMPLimb = MPLimb.toWord32,
+ fromObjptrWordX = ObjptrWord.toWordX32,
+ other = {wordSize' = Word32.wordSize',
+ zero = Word32.zero,
+ lshift = Word32.<<,
+ neg = Word32.~,
+ orb = Word32.orb}}
+ val toWordX32 = toWord32
+ val toWord64 =
+ make {fromMPLimb = MPLimb.toWord64,
+ fromObjptrWordX = ObjptrWord.toWordX64,
+ other = {wordSize' = Word64.wordSize',
+ zero = Word64.zero,
+ lshift = Word64.<<,
+ neg = Word64.~,
+ orb = Word64.orb}}
+ val toWordX64 = toWord64
+ end
+
+ local
+ val bytesPerMPLimb = Sz.fromInt32 (Int32.quot (MPLimb.wordSize', 8))
+ val bytesPerCounter = Sz.fromInt32 (Int32.quot (S.precision', 8))
+ val bytesPerLength = Sz.fromInt32 (Int32.quot (S.precision', 8))
+ val bytesPerHeader = Sz.fromInt32 4
+ in
+ val bytesPerArrayHeader =
+ Sz.+ (bytesPerCounter, Sz.+ (bytesPerLength, bytesPerHeader))
+ (* Reserve heap space for a large IntInf.int with room for num + extra
+ * `limbs'. The reason for splitting this up is that extra is intended
+ * to be a constant, and so can be combined at compile time.
+ *)
+ fun reserve (num: S.int, extra: S.int) =
+ Sz.+ (Sz.* (bytesPerMPLimb, Sz.fromSeqIndex num),
+ Sz.+ (Sz.* (bytesPerMPLimb, Sz.fromSeqIndex extra),
+ Sz.+ (bytesPerMPLimb, (* isneg Field *)
+ bytesPerArrayHeader (* Array Header *)
+ )))
+ end
+
+ (* badObjptr{Int,Word}{,Tagged} is the fixnum IntInf.int whose
+ * negation and absolute values are not fixnums.
+ * negBadIntInf is the negation (and absolute value) of that IntInf.int.
+ *)
+ val badObjptrInt: I.int = I.~>> (I.minInt', 0w1)
+ val badObjptrWord: W.word = W.fromIntEq badObjptrInt
+ val badObjptrWordTagged: W.word = addTag badObjptrWord
+ val badObjptrIntTagged: I.int = W.toIntXEq badObjptrWordTagged
+ val negBadIntInf: bigInt = fromObjptrInt (I.~ badObjptrInt)
+
+ (* Given two ObjptrWord.word's, check if they have the same `high'/'sign' bit.
+ *)
+ fun sameSignBit (lhs: W.word, rhs: W.word): bool =
+ I.>= (W.toIntXEq (W.xorb (lhs, rhs)), 0)
+
+ (* Given a bignum bigint, test if it is (strictly) negative.
+ *)
+ fun bigIsNeg (arg: bigInt): bool =
+ V.sub (Prim.toVector arg, 0) <> 0w0
+
+ local
+ fun make (smallOp, bigOp, limbsFn, extra)
+ (lhs: bigInt, rhs: bigInt): bigInt =
+ let
+ val res =
+ if areSmall (lhs, rhs)
+ then let
+ val lhsw = dropTagCoerce lhs
+ val lhsi = W.toIntXEq lhsw
+ val rhsw = dropTagCoerce rhs
+ val rhsi = W.toIntXEq rhsw
+ val ansi = smallOp (lhsi, rhsi)
+ val answ = W.fromIntEq ansi
+ val ans = addTag answ
+ in
+ if sameSignBit (ans, answ)
+ then SOME (Prim.fromWord ans)
+ else NONE
+ end handle Overflow => NONE
+ else NONE
+ in
+ case res of
+ NONE => bigOp (lhs, rhs,
+ reserve (limbsFn (numLimbs lhs, numLimbs rhs), extra))
+ | SOME i => i
+ end
+ in
+ val bigAdd = make (I.+, Prim.+, S.max, 1)
+ val bigSub = make (I.-, Prim.-, S.max, 1)
+ val bigMul = make (I.*, Prim.*, S.+, 0)
+ end
+
+ fun bigNeg (arg: bigInt): bigInt =
+ if isSmall arg
+ then let
+ val argw = Prim.toWord arg
+ in
+ if argw = badObjptrWordTagged
+ then negBadIntInf
+ else Prim.fromWord (W.- (0w2, argw))
+ end
+ else Prim.~ (arg, reserve (numLimbs arg, 1))
+
+
+ fun bigQuot (num: bigInt, den: bigInt): bigInt =
+ if areSmall (num, den)
+ then let
+ val numw = dropTagCoerce num
+ val numi = W.toIntXEq numw
+ val denw = dropTagCoerce den
+ val deni = W.toIntXEq numw
+ in
+ if numw = badObjptrWord
+ andalso deni = ~1
+ then negBadIntInf
+ else let
+ val ansi = I.quot (numi, deni)
+ val answ = W.fromIntEq ansi
+ val ans = addTag answ
+ in
+ Prim.fromWord ans
+ end
+ end
+ else let
+ val nlimbs = numLimbs num
+ val dlimbs = numLimbs den
+ in
+ if S.< (nlimbs, dlimbs)
+ then zero
+ else if den = zero
+ then raise Div
+ else Prim.quot (num, den,
+ reserve (S.- (nlimbs, dlimbs), 1))
+ end
+
+ fun bigRem (num: bigInt, den: bigInt): bigInt =
+ if areSmall (num, den)
+ then let
+ val numw = dropTagCoerce num
+ val numi = W.toIntXEq numw
+ val denw = dropTagCoerce den
+ val deni = W.toIntXEq numw
+ val ansi = I.rem (numi, deni)
+ val answ = W.fromIntEq ansi
+ val ans = addTag answ
+ in
+ Prim.fromWord ans
+ end
+ else let
+ val nlimbs = numLimbs num
+ val dlimbs = numLimbs den
+ in
+ if S.< (nlimbs, dlimbs)
+ then num
+ else if den = zero
+ then raise Div
+ else Prim.rem (num, den,
+ reserve (dlimbs, 1))
+ end
+
+ (* Based on code from PolySpace. *)
+ local
+ open I
+
+ fun mod2 x = I.andb (x, 1)
+ fun div2 x = I.>> (x, 0w1)
+
+ fun gcdInt (a, b, acc) =
+ case (a, b) of
+ (0, _) => b * acc
+ | (_, 0) => a * acc
+ | (_, 1) => acc
+ | (1, _) => acc
+ | _ =>
+ if a = b
+ then a * acc
+ else
+ let
+ val a_2 = div2 a
+ val a_r2 = mod2 a
+ val b_2 = div2 b
+ val b_r2 = mod2 b
+ in
+ if 0 = a_r2
+ then
+ if 0 = b_r2
+ then gcdInt (a_2, b_2, acc + acc)
+ else gcdInt (a_2, b, acc)
+ else
+ if 0 = b_r2
+ then gcdInt (a, b_2, acc)
+ else
+ if a >= b
+ then gcdInt (div2 (a - b), b, acc)
+ else gcdInt (a, div2 (b - a), acc)
+ end
+ in
+ fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
+ if areSmall (lhs, rhs)
+ then addTagCoerceInt (gcdInt (I.abs (dropTagCoerceInt lhs),
+ I.abs (dropTagCoerceInt rhs),
+ 1))
+ else Prim.gcd (lhs, rhs,
+ reserve (S.max (numLimbs lhs, numLimbs rhs), 0))
+ end
+
+
+ fun bigCompare (lhs: bigInt, rhs: bigInt): order =
+ if areSmall (lhs, rhs)
+ then I.compare (W.toIntXEq (Prim.toWord lhs),
+ W.toIntXEq (Prim.toWord rhs))
+ else Int32.compare (Prim.compare (lhs, rhs), 0)
+
+ local
+ fun make (smallTest, int32Test)
+ (lhs: bigInt, rhs: bigInt): bool =
+ if areSmall (lhs, rhs)
+ then smallTest (W.toIntXEq (Prim.toWord lhs),
+ W.toIntXEq (Prim.toWord rhs))
+ else int32Test (Prim.compare (lhs, rhs), 0)
+ in
+ val bigLT = make (I.<, Int32.<)
+ val bigLE = make (I.<=, Int32.<=)
+ val bigGT = make (I.>, Int32.>)
+ val bigGE = make (I.>=, Int32.>=)
+ end
+
+ fun bigAbs (arg: bigInt): bigInt =
+ if isSmall arg
+ then let
+ val argw = Prim.toWord arg
+ in
+ if argw = badObjptrWordTagged
+ then negBadIntInf
+ else if I.< (W.toIntXEq argw, 0)
+ then Prim.fromWord (W.- (0w2, argw))
+ else arg
+ end
+ else if bigIsNeg arg
+ then Prim.~ (arg, reserve (numLimbs arg, 1))
+ else arg
+
+ fun bigMin (lhs: bigInt, rhs: bigInt): bigInt =
+ if bigLE (lhs, rhs) then lhs else rhs
+
+ fun bigMax (lhs: bigInt, rhs: bigInt): bigInt =
+ if bigLE (lhs, rhs) then rhs else lhs
+
+ fun bigSign' (arg: bigInt): Int32.int =
+ if isSmall arg
+ then I.sign' (dropTagCoerceInt arg)
+ else if bigIsNeg arg
+ then ~1
+ else 1
+
+ fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
+ bigSign' lhs = bigSign' rhs
+
+ local
+ val op + = bigAdd
+ val op - = bigSub
+ val op > = bigGT
+ val op >= = bigGE
+ val op < = bigLT
+ val quot = bigQuot
+ val rem = bigRem
+ in
+ fun bigDiv (x, y) =
+ if x >= zero
+ then if y > zero
+ then quot (x, y)
+ else if y < zero
+ then if x = zero
+ then zero
+ else quot (x - one, y) - one
+ else raise Div
+ else if y < zero
+ then quot (x, y)
+ else if y > zero
+ then quot (x + one, y) - one
+ else raise Div
+
+ fun bigMod (x, y) =
+ if x >= zero
+ then if y > zero
+ then rem (x, y)
+ else if y < zero
+ then if x = zero
+ then zero
+ else rem (x - one, y) + (one + y)
+ else raise Div
+ else if y < zero
+ then rem (x, y)
+ else if y > zero
+ then rem (x + one, y) + (y - one)
+ else raise Div
+
+ fun bigDivMod (x, y) = (bigDiv (x, y), bigMod (x, y))
+ fun bigQuotRem (x, y) = (bigQuot (x, y), bigRem (x, y))
+ end
+
+ local
+ fun make (smallOp, bigOp)
+ (lhs: bigInt, rhs: bigInt) =
+ if areSmall (lhs, rhs)
+ then
+ let
+ val answ = smallOp (Prim.toWord lhs, Prim.toWord rhs)
+ val ans = oneTagCoerce answ
+ in
+ ans
+ end
+ else bigOp (lhs, rhs,
+ reserve (S.max (numLimbs lhs, numLimbs rhs), 0))
+ in
+ val bigAndb = make (W.andb, Prim.andb)
+ val bigOrb = make (W.orb, Prim.orb)
+ val bigXorb = make (W.xorb, Prim.xorb)
+ end
+
+ fun bigNotb (arg: bigInt): bigInt =
+ if isSmall arg
+ then oneTagCoerce (W.notb (Prim.toWord arg))
+ else Prim.notb (arg, reserve (numLimbs arg, 0))
+
+ local
+ val bitsPerLimb = MPLimb.wordSizeWord'
+ fun shiftSize shift = S.fromWord32 (Word32.div (shift, bitsPerLimb))
+ in
+ fun bigLshift (arg: bigInt, shift: Word32.word): bigInt =
+ if shift = 0wx0
+ then arg
+ else Prim.<< (arg, shift,
+ reserve (S.+ (numLimbs arg, shiftSize shift), 1))
+ fun bigRashift (arg: bigInt, shift: Word32.word): bigInt =
+ if shift = 0wx0
+ then arg
+ else Prim.~>> (arg, shift,
+ reserve (S.max (1, S.- (numLimbs arg, shiftSize shift)), 0))
+ end
+
+ fun bigToString8 (arg: bigInt): String8.string =
+ Prim.toString
+ (arg, 10, Sz.+ (bytesPerArrayHeader (* Array Header *),
+ Sz.+ (0w2, (* sign *)
+ Sz.* (0w10, Sz.fromSeqIndex (numLimbs arg)))))
+
+ type int = bigInt
+ type t = int
+
+ val maxInt = NONE
+ val minInt = NONE
+
+ val abs = bigAbs
+ val op + = bigAdd
+ val divMod = bigDivMod
+ val op div = bigDiv
+ val gcd = bigGcd
+ val op mod = bigMod
+ val op * = bigMul
+ val op ~ = bigNeg
+ val quotRem = bigQuotRem
+ val quot = bigQuot
+ val rem = bigRem
+ val op - = bigSub
+
+ val op < = bigLT
+ val op <= = bigLE
+ val op > = bigGT
+ val op >= = bigGE
+ val compare = bigCompare
+ val min = bigMin
+ val max = bigMax
+
+ val andb = bigAndb
+ val << = bigLshift
+ val notb = bigNotb
+ val orb = bigOrb
+ val ~>> = bigRashift
+ val xorb = bigXorb
+
+ val toString8 = bigToString8
+end
+
+structure Int8 =
+ struct
+ open Int8
+ val fromIntInf = IntInf.toInt8
+ val toIntInf = IntInf.fromInt8
+ end
+structure Int16 =
+ struct
+ open Int16
+ val fromIntInf = IntInf.toInt16
+ val toIntInf = IntInf.fromInt16
+ end
+structure Int32 =
+ struct
+ open Int32
+ val fromIntInf = IntInf.toInt32
+ val toIntInf = IntInf.fromInt32
+ end
+structure Int64 =
+ struct
+ open Int64
+ val fromIntInf = IntInf.toInt64
+ val toIntInf = IntInf.fromInt64
+ end
+structure Word8 =
+ struct
+ open Word8
+ val fromIntInf = IntInf.toWord8
+ val toIntInf = IntInf.fromWord8
+ val toIntInfX = IntInf.fromWordX8
+ end
+structure Word16 =
+ struct
+ open Word16
+ val fromIntInf = IntInf.toWord16
+ val toIntInf = IntInf.fromWord16
+ val toIntInfX = IntInf.fromWordX16
+ end
+structure Word32 =
+ struct
+ open Word32
+ val fromIntInf = IntInf.toWord32
+ val toIntInf = IntInf.fromWord32
+ val toIntInfX = IntInf.fromWordX32
+ end
+structure Word64 =
+ struct
+ open Word64
+ val fromIntInf = IntInf.toWord64
+ val toIntInf = IntInf.fromWord64
+ val toIntInfX = IntInf.fromWordX64
+ end
+
+end
+
+(*
+(*
+ * IntInf.int's either have a bottom bit of 1, in which case the top 31
+ * bits are the signed integer, or else the bottom bit is 0, in which case
+ * they point to an vector of Word.word's. The first word is either 0,
+ * indicating that the number is positive, or 1, indicating that it is
+ * negative. The rest of the vector contains the `limbs' (big digits) of
+ * the absolute value of the number, from least to most significant.
+ *)
+structure IntInf: INT_INF_EXTRA =
+ struct
+
+ (*
+ * bigInt toString and fmt.
+ * dpc is the maximum number of digits per `limb'.
+ *)
+ local
+ open StringCvt
+
+ fun cvt {base: smallInt,
+ dpc: word,
+ smallCvt: smallInt -> string}
+ (arg: bigInt)
+ : string =
+ if isSmall arg
+ then smallCvt (Word.toIntX (stripTag arg))
+ else Prim.toString (arg, base,
+ Word.+
+ (reserve (0, 0),
+ Word.+ (0w2, (* sign character *)
+ Word.* (dpc,
+ Word.fromInt (bigSize arg)))))
+ val binCvt = cvt {base = 2, dpc = 0w32, smallCvt = Int.fmt BIN}
+ val octCvt = cvt {base = 8, dpc = 0w11, smallCvt = Int.fmt OCT}
+ val hexCvt = cvt {base = 16, dpc = 0w8, smallCvt = Int.fmt HEX}
+ in
+ val bigToString = cvt {base = 10,
+ dpc = 0w10,
+ smallCvt = Int.toString}
+ fun bigFmt radix =
+ case radix of
+ BIN => binCvt
+ | OCT => octCvt
+ | DEC => bigToString
+ | HEX => hexCvt
+ end
+
+ (*
+ * bigInt scan and fromString.
+ *)
+ local
+ open StringCvt
+
+ (*
+ * We use Word.word to store chunks of digits.
+ * smallToInf converts such a word to a fixnum bigInt.
+ * Thus, it can only represent values in [- 2^30, 2^30).
+ *)
+ fun smallToBig (arg: Word.word): bigInt =
+ Prim.fromWord (addTag arg)
+
+
+ (*
+ * Given a char, if it is a digit in the appropriate base,
+ * convert it to a word. Otherwise, return NONE.
+ * Note, both a-f and A-F are accepted as hexadecimal digits.
+ *)
+ fun binDig (ch: char): Word.word option =
+ case ch of
+ #"0" => SOME 0w0
+ | #"1" => SOME 0w1
+ | _ => NONE
+
+ local
+ val op <= = Char.<=
+ in
+ fun octDig (ch: char): Word.word option =
+ if #"0" <= ch andalso ch <= #"7"
+ then SOME (Word.fromInt (ord ch -? ord #"0"))
+ else NONE
+
+ fun decDig (ch: char): Word.word option =
+ if #"0" <= ch andalso ch <= #"9"
+ then SOME (Word.fromInt (ord ch -? ord #"0"))
+ else NONE
+
+ fun hexDig (ch: char): Word.word option =
+ if #"0" <= ch andalso ch <= #"9"
+ then SOME (Word.fromInt (ord ch -? ord #"0"))
+ else if #"a" <= ch andalso ch <= #"f"
+ then SOME (Word.fromInt (ord ch -? (ord #"a" - 0xa)))
+ else if #"A" <= ch andalso ch <= #"F"
+ then SOME (Word.fromInt
+ (ord ch -? (ord #"A" - 0xA)))
+ else
+ NONE
+ end
+
+ (*
+ * Given a digit converter and a char reader, return a digit
+ * reader.
+ *)
+ fun toDigR (charToDig: char -> Word.word option,
+ cread: (char, 'a) reader)
+ (s: 'a)
+ : (Word.word * 'a) option =
+ case cread s of
+ NONE => NONE
+ | SOME (ch, s') =>
+ case charToDig ch of
+ NONE => NONE
+ | SOME dig => SOME (dig, s')
+
+ (*
+ * A chunk represents the result of processing some digits.
+ * more is a bool indicating if there might be more digits.
+ * shift is base raised to the number-of-digits-seen power.
+ * chunk is the value of the digits seen.
+ *)
+ type chunk = {
+ more: bool,
+ shift: Word.word,
+ chunk: Word.word
+ }
+
+ (*
+ * Given the base, the number of digits per chunk,
+ * a char reader and a digit reader, return a chunk reader.
+ *)
+ fun toChunkR (base: Word.word,
+ dpc: smallInt,
+ dread: (Word.word, 'a) reader)
+ : (chunk, 'a) reader =
+ let fun loop {left: smallInt,
+ shift: Word.word,
+ chunk: Word.word,
+ s: 'a}
+ : chunk * 'a =
+ if left <= 0
+ then ({more = true,
+ shift = shift,
+ chunk = chunk },
+ s)
+ else
+ case dread s of
+ NONE => ({more = false,
+ shift = shift,
+ chunk = chunk},
+ s)
+ | SOME (dig, s') =>
+ loop {
+ left = left - 1,
+ shift = Word.* (base, shift),
+ chunk = Word.+ (Word.* (base,
+ chunk),
+ dig),
+ s = s'
+ }
+ fun reader (s: 'a): (chunk * 'a) option =
+ case dread s of
+ NONE => NONE
+ | SOME (dig, next) =>
+ SOME (loop {left = dpc - 1,
+ shift = base,
+ chunk = dig,
+ s = next})
+ in reader
+ end
+
+ (*
+ * Given a chunk reader, return an unsigned reader.
+ *)
+ fun toUnsR (ckread: (chunk, 'a) reader): (bigInt, 'a) reader =
+ let fun loop (more: bool, ac: bigInt, s: 'a) =
+ if more
+ then case ckread s of
+ NONE => (ac, s)
+ | SOME ({more, shift, chunk}, s') =>
+ loop (more,
+ bigPlus (bigMul (smallToBig shift,
+ ac),
+ smallToBig chunk),
+ s')
+ else (ac, s)
+ fun reader (s: 'a): (bigInt * 'a) option =
+ case ckread s of
+ NONE => NONE
+ | SOME ({more, chunk, ...}, s') =>
+ SOME (loop (more,
+ smallToBig chunk,
+ s'))
+ in reader
+ end
+
+ (*
+ * Given a char reader and an unsigned reader, return an unsigned
+ * reader that includes skipping the option hex '0x'.
+ *)
+ fun toHexR (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
+ s =
+ case cread s of
+ NONE => NONE
+ | SOME (c1, s1) =>
+ if c1 = #"0" then
+ case cread s1 of
+ NONE => SOME (zero, s1)
+ | SOME (c2, s2) =>
+ if c2 = #"x" orelse c2 = #"X" then
+ case uread s2 of
+ NONE => SOME (zero, s1)
+ | SOME x => SOME x
+ else uread s
+ else uread s
+
+ (*
+ * Given a char reader and an unsigned reader, return a signed
+ * reader. This includes skipping any initial white space.
+ *)
+ fun toSign (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
+ : (bigInt, 'a) reader =
+ let
+ fun reader (s: 'a): (bigInt * 'a) option =
+ case cread s of
+ NONE => NONE
+ | SOME (ch, s') =>
+ if Char.isSpace ch then reader s'
+ else
+ let
+ val (isNeg, s'') =
+ case ch of
+ #"+" => (false, s')
+ | #"-" => (true, s')
+ | #"~" => (true, s')
+ | _ => (false, s)
+ in
+ if isNeg then
+ case uread s'' of
+ NONE => NONE
+ | SOME (abs, s''') =>
+ SOME (bigNegate abs, s''')
+ else uread s''
+ end
+ in
+ reader
+ end
+
+ (*
+ * Base-specific conversions from char readers to
+ * bigInt readers.
+ *)
+ local
+ fun reader (base, dpc, dig)
+ (cread: (char, 'a) reader): (bigInt, 'a) reader =
+ let val dread = toDigR (dig, cread)
+ val ckread = toChunkR (base, dpc, dread)
+ val uread = toUnsR ckread
+ val hread =
+ if base = 0w16 then toHexR (cread, uread) else uread
+ val reader = toSign (cread, hread)
+ in reader
+ end
+ in
+ fun binReader z = reader (0w2, 29, binDig) z
+ fun octReader z = reader (0w8, 9, octDig) z
+ fun decReader z = reader (0w10, 9, decDig) z
+ fun hexReader z = reader (0w16, 7, hexDig) z
+ end
+ in
+
+ local fun stringReader (pos, str) =
+ if pos >= String.size str
+ then NONE
+ else SOME (String.sub (str, pos), (pos + 1, str))
+ val reader = decReader stringReader
+ in
+ fun bigFromString str =
+ case reader (0, str) of
+ NONE => NONE
+ | SOME (res, _) => SOME res
+ end
+
+ fun bigScan radix =
+ case radix of
+ BIN => binReader
+ | OCT => octReader
+ | DEC => decReader
+ | HEX => hexReader
+ end
+
+ local
+ fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
+ in
+ fun pow (i: bigInt, j: int): bigInt =
+ if j < 0 then
+ if i = zero then
+ raise Div
+ else
+ if i = one then one
+ else if i = negOne then if isEven j then one else negOne
+ else zero
+ else
+ if j = 0 then one
+ else
+ let
+ fun square (n: bigInt): bigInt = bigMul (n, n)
+ (* pow (j) returns (i ^ j) *)
+ fun pow (j: int): bigInt =
+ if j <= 0 then one
+ else if isEven j then evenPow j
+ else bigMul (i, evenPow (j - 1))
+ (* evenPow (j) returns (i ^ j), assuming j is even *)
+ and evenPow (j: int): bigInt =
+ square (pow (Int.quot (j, 2)))
+ in pow (j)
+ end
+ end
+
+
+ (*
+ * bigInt log2
+ *)
+ structure Word =
+ struct
+ open Word
+ fun log2 (w: word): int =
+ let
+ fun loop (n, s, ac): word =
+ if n = 0w1
+ then ac
+ else
+ let
+ val (n, ac) =
+ if n >= << (0w1, s)
+ then (>> (n, s), ac + s)
+ else (n, ac)
+ in
+ loop (n, >> (s, 0w1), ac)
+ end
+ in
+ toInt (loop (w, 0w16, 0w0))
+ end
+ end
+
+ local
+ val bitsPerLimb: Int.int = 32
+ in
+ fun log2 (n: bigInt): Int.int =
+ if bigLE (n, 0)
+ then raise Domain
+ else
+ case rep n of
+ Big v =>
+ Int.+ (Int.* (bitsPerLimb, Int.- (Vector.length v, 2)),
+ Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
+ | Small i => Word.log2 (Word.fromInt i)
+ end
+
+
+ end
+
+structure LargeInt = IntInf
+*)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,309 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature INTEGER0 =
+ sig
+ include PRIM_INTEGER
+
+ val precisionWord': Primitive.Word32.word
+
+ val maxInt: int option
+ val minInt: int option
+
+ val zero: int
+ val one: int
+
+ val abs: int -> int
+ val div: int * int -> int
+ val mod: int * int -> int
+ val power: {base:int, exp: int} -> int
+ val quot: int * int -> int
+ val rem: int * int -> int
+
+ val << : int * Primitive.Word32.word -> int
+ val >> : int * Primitive.Word32.word -> int
+ val rol : int * Primitive.Word32.word -> int
+ val ror : int * Primitive.Word32.word -> int
+ val ~>> : int * Primitive.Word32.word -> int
+
+ val sign': int -> Primitive.Int32.int
+ val sameSign: int * int -> bool
+
+ val fromInt8: Primitive.Int8.int -> int
+ val fromInt16: Primitive.Int16.int -> int
+ val fromInt32: Primitive.Int32.int -> int
+ val fromInt64: Primitive.Int64.int -> int
+
+ val fromWord8: Primitive.Word8.word -> int
+ val fromWord16: Primitive.Word16.word -> int
+ val fromWord32: Primitive.Word32.word -> int
+ val fromWord64: Primitive.Word64.word -> int
+
+ val fromWordX8: Primitive.Word8.word -> int
+ val fromWordX16: Primitive.Word16.word -> int
+ val fromWordX32: Primitive.Word32.word -> int
+ val fromWordX64: Primitive.Word64.word -> int
+
+ val toInt8: int -> Primitive.Int8.int
+ val toInt16: int -> Primitive.Int16.int
+ val toInt32: int -> Primitive.Int32.int
+ val toInt64: int -> Primitive.Int64.int
+
+ val toWord8: int -> Primitive.Word8.word
+ val toWord16: int -> Primitive.Word16.word
+ val toWord32: int -> Primitive.Word32.word
+ val toWord64: int -> Primitive.Word64.word
+
+ val toWordX8: int -> Primitive.Word8.word
+ val toWordX16: int -> Primitive.Word16.word
+ val toWordX32: int -> Primitive.Word32.word
+ val toWordX64: int -> Primitive.Word64.word
+ end
+
+functor MkInt0 (I: PRIM_INTEGER): INTEGER0 =
+ struct
+
+ open I
+
+ val detectOverflow = Primitive.Controls.detectOverflow
+
+ val precisionWord' = Primitive.Word32.fromInt32Unsafe precision'
+ val precisionMinusOneWord' = Primitive.Word32.- (precisionWord', 0w1)
+
+ val maxInt: int option = SOME maxInt'
+ val minInt: int option = SOME minInt'
+
+ val zero: int = fromInt32Unsafe 0
+ val one: int = fromInt32Unsafe 1
+
+ fun abs (x: int) = if x < zero then ~ x else x
+
+ fun quot (x, y) =
+ if Primitive.Controls.safe andalso y = zero
+ then raise Div
+ else if detectOverflow andalso x = minInt' andalso y = ~one
+ then raise Overflow
+ else quotUnsafe (x, y)
+
+ fun rem (x, y) =
+ if Primitive.Controls.safe andalso y = zero
+ then raise Div
+ else if x = minInt' andalso y = ~one
+ then zero
+ else remUnsafe (x, y)
+
+ fun x div y =
+ if x >= zero
+ then if y > zero
+ then quotUnsafe (x, y)
+ else if y < zero
+ then if x = zero
+ then zero
+ else quotUnsafe (x - one, y) -? one
+ else raise Div
+ else if y < zero
+ then if detectOverflow andalso x = minInt' andalso y = ~one
+ then raise Overflow
+ else quotUnsafe (x, y)
+ else if y > zero
+ then quotUnsafe (x + one, y) -? one
+ else raise Div
+
+ fun x mod y =
+ if x >= zero
+ then if y > zero
+ then remUnsafe (x, y)
+ else if y < zero
+ then if x = zero
+ then zero
+ else remUnsafe (x - one, y) +? (y + one)
+ else raise Div
+ else if y < zero
+ then if x = minInt' andalso y = ~one
+ then zero
+ else remUnsafe (x, y)
+ else if y > zero
+ then remUnsafe (x + one, y) +? (y - one)
+ else raise Div
+
+ fun << (i, n) =
+ if Primitive.Word32.>= (n, precisionWord')
+ then zero
+ else <<? (i, n)
+ fun >> (i, n) =
+ if Primitive.Word32.>= (n, precisionWord')
+ then zero
+ else >>? (i, n)
+ fun ~>> (i, n) =
+ if Primitive.Word32.< (n, precisionWord')
+ then ~>>? (i, n)
+ else ~>>? (i, precisionMinusOneWord')
+ fun rol (i, n) =
+ let
+ val n = Primitive.Word32.remUnsafe (n, precisionWord')
+ in
+ if n = 0w0
+ then i
+ else rolUnsafe (i, n)
+ end
+ fun ror (i, n) =
+ let
+ val n = Primitive.Word32.remUnsafe (n, precisionWord')
+ in
+ if n = 0w0
+ then i
+ else rorUnsafe (i, n)
+ end
+
+ fun power {base, exp} =
+ if Primitive.Controls.safe andalso exp < zero
+ then raise Primitive.Exn.Fail8 "Int.power"
+ else let
+ fun loop (exp, accum) =
+ if exp <= zero
+ then accum
+ else loop (exp - one, base * accum)
+ in loop (exp, one)
+ end
+
+
+ val sign': int -> Primitive.Int32.int =
+ fn i => if i = zero
+ then 0
+ else if i < zero
+ then ~1
+ else 1
+
+ fun sameSign (x, y) = sign' x = sign' y
+
+ local
+ fun 'a make {fromIntUnsafe: 'a -> int,
+ toIntUnsafe: int -> 'a,
+ other : {precision': Primitive.Int32.int,
+ maxInt': 'a,
+ minInt': 'a,
+ lte : 'a * 'a -> bool}} =
+ if detectOverflow andalso
+ precision' <> #precision' other
+ then if Primitive.Int32.< (precision', #precision' other)
+ then (fn i =>
+ if ((#lte other) (toIntUnsafe minInt', i)
+ andalso (#lte other) (toIntUnsafe maxInt', i))
+ then fromIntUnsafe i
+ else raise Overflow,
+ toIntUnsafe)
+ else (fromIntUnsafe,
+ fn i =>
+ if (fromIntUnsafe (#minInt' other) <= i
+ andalso i <= fromIntUnsafe (#maxInt' other))
+ then toIntUnsafe i
+ else raise Overflow)
+ else (fromIntUnsafe, toIntUnsafe)
+ in
+ val (fromInt8, toInt8) =
+ make {fromIntUnsafe = fromInt8Unsafe,
+ toIntUnsafe = toInt8Unsafe,
+ other = {precision' = Primitive.Int8.precision',
+ maxInt' = Primitive.Int8.maxInt',
+ minInt' = Primitive.Int8.minInt',
+ lte = Primitive.Int8.<=}}
+ val (fromInt16, toInt16) =
+ make {fromIntUnsafe = fromInt16Unsafe,
+ toIntUnsafe = toInt16Unsafe,
+ other = {precision' = Primitive.Int16.precision',
+ maxInt' = Primitive.Int16.maxInt',
+ minInt' = Primitive.Int16.minInt',
+ lte = Primitive.Int16.<=}}
+ val (fromInt32, toInt32) =
+ make {fromIntUnsafe = fromInt32Unsafe,
+ toIntUnsafe = toInt32Unsafe,
+ other = {precision' = Primitive.Int32.precision',
+ maxInt' = Primitive.Int32.maxInt',
+ minInt' = Primitive.Int32.minInt',
+ lte = Primitive.Int32.<=}}
+ val (fromInt64, toInt64) =
+ make {fromIntUnsafe = fromInt64Unsafe,
+ toIntUnsafe = toInt64Unsafe,
+ other = {precision' = Primitive.Int64.precision',
+ maxInt' = Primitive.Int64.maxInt',
+ minInt' = Primitive.Int64.minInt',
+ lte = Primitive.Int64.<=}}
+ end
+
+ local
+ fun 'a make {fromWordUnsafe: 'a -> int, fromWordXUnsafe: 'a -> int,
+ toWordUnsafe: int -> 'a, toWordXUnsafe: int -> 'a,
+ other : {wordSize': Primitive.Int32.int,
+ gt: 'a * 'a -> bool,
+ lt: 'a * 'a -> bool}} =
+ let
+ fun fromWord w =
+ if detectOverflow
+ andalso Primitive.Int32.>= (#wordSize' other, precision')
+ andalso (#gt other) (w, toWordUnsafe maxInt')
+ then raise Overflow
+ else fromWordUnsafe w
+ fun fromWordX w =
+ if detectOverflow
+ andalso Primitive.Int32.> (#wordSize' other, precision')
+ andalso (#lt other) (toWordUnsafe maxInt', w)
+ andalso (#lt other) (w, toWordUnsafe maxInt')
+ then raise Overflow
+ else fromWordXUnsafe w
+ in
+ (fromWord,
+ fromWordX,
+ toWordUnsafe,
+ toWordXUnsafe)
+ end
+ in
+ val (fromWord8, fromWordX8, toWord8, toWordX8) =
+ make {fromWordUnsafe = fromWord8Unsafe,
+ fromWordXUnsafe = fromWordX8Unsafe,
+ toWordUnsafe = toWord8Unsafe,
+ toWordXUnsafe =toWordX8Unsafe,
+ other = {wordSize' = Primitive.Word8.wordSize',
+ lt = Primitive.Word8.<,
+ gt = Primitive.Word8.>}}
+ val (fromWord16, fromWordX16, toWord16, toWordX16) =
+ make {fromWordUnsafe = fromWord16Unsafe,
+ fromWordXUnsafe = fromWordX16Unsafe,
+ toWordUnsafe = toWord16Unsafe,
+ toWordXUnsafe =toWordX16Unsafe,
+ other = {wordSize' = Primitive.Word16.wordSize',
+ lt = Primitive.Word16.<,
+ gt = Primitive.Word16.>}}
+ val (fromWord32, fromWordX32, toWord32, toWordX32) =
+ make {fromWordUnsafe = fromWord32Unsafe,
+ fromWordXUnsafe = fromWordX32Unsafe,
+ toWordUnsafe = toWord32Unsafe,
+ toWordXUnsafe =toWordX32Unsafe,
+ other = {wordSize' = Primitive.Word32.wordSize',
+ lt = Primitive.Word32.<,
+ gt = Primitive.Word32.>}}
+ val (fromWord64, fromWordX64, toWord64, toWordX64) =
+ make {fromWordUnsafe = fromWord64Unsafe,
+ fromWordXUnsafe = fromWordX64Unsafe,
+ toWordUnsafe = toWord64Unsafe,
+ toWordXUnsafe =toWordX64Unsafe,
+ other = {wordSize' = Primitive.Word64.wordSize',
+ lt = Primitive.Word64.<,
+ gt = Primitive.Word64.>}}
+ end
+
+ end
+
+structure Primitive = struct
+open Primitive
+
+structure Int8 = MkInt0 (Primitive.Int8)
+structure Int16 = MkInt0 (Primitive.Int16)
+structure Int32 = MkInt0 (Primitive.Int32)
+structure Int64 = MkInt0 (Primitive.Int64)
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,213 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+signature WORD0 =
+ sig
+ include PRIM_WORD
+
+ val wordSizeWord': Primitive.Word32.word
+
+ val zero: word
+ val one: word
+
+ val div: word * word -> word
+ val mod: word * word -> word
+
+ val << : word * Primitive.Word32.word -> word
+ val >> : word * Primitive.Word32.word -> word
+ val rol : word * Primitive.Word32.word -> word
+ val ror : word * Primitive.Word32.word -> word
+ val ~>> : word * Primitive.Word32.word -> word
+
+ val fromInt8: Primitive.Int8.int -> word
+ val fromInt16: Primitive.Int16.int -> word
+ val fromInt32: Primitive.Int32.int -> word
+ val fromInt64: Primitive.Int64.int -> word
+ val fromIntEq: intEq -> word
+
+ val fromIntZ8: Primitive.Int8.int -> word
+ val fromIntZ16: Primitive.Int16.int -> word
+ val fromIntZ32: Primitive.Int32.int -> word
+ val fromIntZ64: Primitive.Int64.int -> word
+ val fromIntZEq: intEq -> word
+
+ val fromWord8: Primitive.Word8.word -> word
+ val fromWord16: Primitive.Word16.word -> word
+ val fromWord32: Primitive.Word32.word -> word
+ val fromWord64: Primitive.Word64.word -> word
+
+ val fromWordX8: Primitive.Word8.word -> word
+ val fromWordX16: Primitive.Word16.word -> word
+ val fromWordX32: Primitive.Word32.word -> word
+ val fromWordX64: Primitive.Word64.word -> word
+
+ val toInt8: word -> Primitive.Int8.int
+ val toInt16: word -> Primitive.Int16.int
+ val toInt32: word -> Primitive.Int32.int
+ val toInt64: word -> Primitive.Int64.int
+ val toIntEq: word -> intEq
+
+ val toIntX8: word -> Primitive.Int8.int
+ val toIntX16: word -> Primitive.Int16.int
+ val toIntX32: word -> Primitive.Int32.int
+ val toIntX64: word -> Primitive.Int64.int
+ val toIntXEq: word -> intEq
+
+ val toWord8: word -> Primitive.Word8.word
+ val toWord16: word -> Primitive.Word16.word
+ val toWord32: word -> Primitive.Word32.word
+ val toWord64: word -> Primitive.Word64.word
+
+ val toWordX8: word -> Primitive.Word8.word
+ val toWordX16: word -> Primitive.Word16.word
+ val toWordX32: word -> Primitive.Word32.word
+ val toWordX64: word -> Primitive.Word64.word
+ end
+
+functor MkWord0 (W: PRIM_WORD): WORD0 =
+ struct
+
+ open W
+
+ val detectOverflow = Primitive.Controls.detectOverflow
+
+ val wordSizeWord' = Primitive.Word32.fromInt32Unsafe wordSize'
+ val wordSizeMinusOneWord' = Primitive.Word32.- (wordSizeWord', 0w1)
+
+ val zero: word = fromWord32Unsafe 0w0
+ val one: word = fromWord32Unsafe 0w1
+
+ local
+ fun make f (w, w') =
+ if Primitive.Controls.safe andalso w' = zero
+ then raise Div
+ else f (w, w')
+ in
+ val op div = make (op quotUnsafe)
+ val op mod = make (op remUnsafe)
+ end
+
+ fun << (w, n) =
+ if Primitive.Word32.>= (n, wordSizeWord')
+ then zero
+ else <<? (w, n)
+ fun >> (w, n) =
+ if Primitive.Word32.>= (n, wordSizeWord')
+ then zero
+ else >>? (w, n)
+ fun ~>> (w, n) =
+ if Primitive.Word32.< (n, wordSizeWord')
+ then ~>>? (w, n)
+ else ~>>? (w, wordSizeMinusOneWord')
+ fun rol (w, n) =
+ let
+ val n = Primitive.Word32.remUnsafe (n, wordSizeWord')
+ in
+ if n = 0w0
+ then w
+ else rolUnsafe (w, n)
+ end
+ fun ror (w, n) =
+ let
+ val n = Primitive.Word32.remUnsafe (n, wordSizeWord')
+ in
+ if n = 0w0
+ then w
+ else rorUnsafe (w, n)
+ end
+
+ local
+ fun 'a make {fromIntUnsafe: 'a -> word, fromIntZUnsafe: 'a -> word,
+ toIntUnsafe: word -> 'a, toIntXUnsafe: word -> 'a,
+ other : {precision': Primitive.Int32.int,
+ maxInt': 'a,
+ minInt': 'a}} =
+ let
+ fun toInt w =
+ if detectOverflow
+ andalso Primitive.Int32.>= (wordSize', #precision' other)
+ andalso w > fromIntUnsafe (#maxInt' other)
+ then raise Overflow
+ else toIntUnsafe w
+ fun toIntX w =
+ if detectOverflow
+ andalso Primitive.Int32.> (wordSize', #precision' other)
+ andalso fromIntUnsafe (#maxInt' other) < w
+ andalso w < fromIntUnsafe (#minInt' other)
+ then raise Overflow
+ else toIntXUnsafe w
+ in
+ (fromIntUnsafe,
+ fromIntZUnsafe,
+ toInt,
+ toIntX)
+ end
+ in
+ val (fromInt8, fromIntZ8, toInt8, toIntX8) =
+ make {fromIntUnsafe = fromInt8Unsafe,
+ fromIntZUnsafe = fromIntZ8Unsafe,
+ toIntUnsafe = toInt8Unsafe,
+ toIntXUnsafe = toIntX8Unsafe,
+ other = {precision' = Primitive.Int8.precision',
+ maxInt' = Primitive.Int8.maxInt',
+ minInt' = Primitive.Int8.minInt'}}
+ val (fromInt16, fromIntZ16, toInt16, toIntX16) =
+ make {fromIntUnsafe = fromInt16Unsafe,
+ fromIntZUnsafe = fromIntZ16Unsafe,
+ toIntUnsafe = toInt16Unsafe,
+ toIntXUnsafe = toIntX16Unsafe,
+ other = {precision' = Primitive.Int16.precision',
+ maxInt' = Primitive.Int16.maxInt',
+ minInt' = Primitive.Int16.minInt'}}
+ val (fromInt32, fromIntZ32, toInt32, toIntX32) =
+ make {fromIntUnsafe = fromInt32Unsafe,
+ fromIntZUnsafe = fromIntZ32Unsafe,
+ toIntUnsafe = toInt32Unsafe,
+ toIntXUnsafe = toIntX32Unsafe,
+ other = {precision' = Primitive.Int32.precision',
+ maxInt' = Primitive.Int32.maxInt',
+ minInt' = Primitive.Int32.minInt'}}
+ val (fromInt64, fromIntZ64, toInt64, toIntX64) =
+ make {fromIntUnsafe = fromInt64Unsafe,
+ fromIntZUnsafe = fromIntZ64Unsafe,
+ toIntUnsafe = toInt64Unsafe,
+ toIntXUnsafe = toIntX64Unsafe,
+ other = {precision' = Primitive.Int64.precision',
+ maxInt' = Primitive.Int64.maxInt',
+ minInt' = Primitive.Int64.minInt'}}
+ val (fromIntEq, fromIntZEq, toIntEq, toIntXEq) =
+ (fromIntEqUnsafe,
+ fromIntZEqUnsafe,
+ fn w =>
+ if detectOverflow
+ andalso w > (>> (notb zero, 0w1))
+ then raise Overflow
+ else toIntEqUnsafe w,
+ toIntXEqUnsafe)
+ end
+
+ val (fromWord8, fromWordX8, toWord8, toWordX8) =
+ (fromWord8Unsafe, fromWordX8Unsafe, toWord8Unsafe, toWordX8Unsafe)
+ val (fromWord16, fromWordX16, toWord16, toWordX16) =
+ (fromWord16Unsafe, fromWordX16Unsafe, toWord16Unsafe, toWordX16Unsafe)
+ val (fromWord32, fromWordX32, toWord32, toWordX32) =
+ (fromWord32Unsafe, fromWordX32Unsafe, toWord32Unsafe, toWordX32Unsafe)
+ val (fromWord64, fromWordX64, toWord64, toWordX64) =
+ (fromWord64Unsafe, fromWordX64Unsafe, toWord64Unsafe, toWordX64Unsafe)
+
+ end
+
+structure Primitive = struct
+open Primitive
+
+structure Word8 = MkWord0 (Primitive.Word8)
+structure Word16 = MkWord0 (Primitive.Word16)
+structure Word32 = MkWord0 (Primitive.Word32)
+structure Word64 = MkWord0 (Primitive.Word64)
+
+end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m32.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m32.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+CTYPES c-types.m32.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m64.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.m64.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+CTYPES c-types.m64.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.weird.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.weird.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/c-types.weird.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+CTYPES c-types.weird.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-char8.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_CHAR default-char8.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int32.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_INT default-int32.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-int64.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_INT default-int64.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-intinf.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_INT default-intinf.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word32.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_WORD default-word32.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-word64.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+DEFAULT_WORD default-word64.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep32.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep32.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+OBJPTR_REP objptr-rep32.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep64.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/objptr-rep64.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+OBJPTR_REP objptr-rep64.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index32.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index32.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index32.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+SEQ_INDEX seq-index32.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index64.map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index64.map 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index64.map 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+SEQ_INDEX seq-index64.sml
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sig 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sig 2006-02-05 15:30:17 UTC (rev 4348)
@@ -1,4 +0,0 @@
-signature DYNAMIC_WIND =
- sig
- val wind: (unit -> 'a) * (unit -> unit) -> 'a
- end
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -1,27 +0,0 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
- * Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-2000 NEC Research Institute.
- *
- * MLton is released under a BSD-style license.
- * See the file MLton-LICENSE for details.
- *)
-
-structure DynamicWind: DYNAMIC_WIND =
-struct
-
-fun try (f: unit -> 'a, k: 'a -> 'b, h: exn -> 'b) =
- let
- datatype t =
- A of 'a
- | E of exn
- in
- case A (f ()) handle e => E e of
- A a => k a
- | E e => h e
- end
-
-fun wind (thunk, cleanup: unit -> unit) =
- try (thunk, fn a => (cleanup (); a), fn e => (cleanup (); raise e))
-
-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-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-basis.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -6,6 +6,8 @@
* See the file MLton-LICENSE for details.
*)
+structure Primitive = struct
+
(* Primitive Basis (Definition) *)
structure Bool =
struct
@@ -443,12 +445,13 @@
type 'a t = 'a weak
end
+end
(* Top-level bindings *)
-datatype bool = datatype Bool.bool
-type exn = Exn.exn
-datatype list = datatype List.list
-datatype ref = datatype Ref.ref
-type unit = Unit.unit
-type 'a array = 'a Array.array
-type 'a vector = 'a Vector.vector
+datatype bool = datatype Primitive.Bool.bool
+type exn = Primitive.Exn.exn
+datatype list = datatype Primitive.List.list
+datatype ref = datatype Primitive.Ref.ref
+type unit = Primitive.Unit.unit
+type 'a array = 'a Primitive.Array.array
+type 'a vector = 'a Primitive.Vector.vector
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,123 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure Char8 =
+ struct
+ open Char8
+
+ val < = _prim "WordU8_lt": char * char -> bool;
+
+ val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
+ val fromInt16 = _prim "WordS16_toWord8": Int16.int -> char;
+ val fromInt32 = _prim "WordS32_toWord8": Int32.int -> char;
+ val fromInt64 = _prim "WordS64_toWord8": Int64.int -> char;
+
+ val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
+ val fromWord16 = _prim "WordU16_toWord8": Word16.word -> char;
+ val fromWord32 = _prim "WordU32_toWord8": Word32.word -> char;
+ val fromWord64 = _prim "WordU64_toWord8": Word64.word -> char;
+
+ val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
+ val toInt16 = _prim "WordS8_toWord16": char -> Int16.int;
+ val toInt32 = _prim "WordS8_toWord32": char -> Int32.int;
+ val toInt64 = _prim "WordS8_toWord64": char -> Int64.int;
+
+ val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
+ val toWord16 = _prim "WordU8_toWord16": char -> Word16.word;
+ val toWord32 = _prim "WordU8_toWord32": char -> Word32.word;
+ val toWord64 = _prim "WordU8_toWord64": char -> Word64.word;
+ end
+structure Char8 =
+ struct
+ open Char8
+ local
+ structure S = IntegralComparisons(Char8)
+ in
+ open S
+ end
+ end
+
+structure Char16 =
+ struct
+ open Char16
+
+ val < = _prim "WordU16_lt": char * char -> bool;
+
+ val fromInt8 = _prim "WordS8_toWord16": Int8.int -> char;
+ val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
+ val fromInt32 = _prim "WordS32_toWord16": Int32.int -> char;
+ val fromInt64 = _prim "WordS64_toWord16": Int64.int -> char;
+
+ val fromWord8 = _prim "WordU8_toWord16": Word8.word -> char;
+ val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char;
+ val fromWord32 = _prim "WordU32_toWord16": Word32.word -> char;
+ val fromWord64 = _prim "WordU64_toWord16": Word64.word -> char;
+
+ val toInt8 = _prim "WordS16_toWord8": char -> Int8.int;
+ val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
+ val toInt32 = _prim "WordS16_toWord32": char -> Int32.int;
+ val toInt64 = _prim "WordS16_toWord64": char -> Int64.int;
+
+ val toWord8 = _prim "WordU16_toWord8": char -> Word8.word;
+ val toWord16 = _prim "WordU16_toWord16": char -> Word16.word;
+ val toWord32 = _prim "WordU16_toWord32": char -> Word32.word;
+ val toWord64 = _prim "WordU16_toWord64": char -> Word64.word;
+ end
+structure Char16 =
+ struct
+ open Char16
+ local
+ structure S = IntegralComparisons(Char16)
+ in
+ open S
+ end
+ end
+
+structure Char32 =
+ struct
+ open Char32
+
+ val < = _prim "WordU32_lt": char * char -> bool;
+
+ val fromInt8 = _prim "WordS8_toWord32": Int8.int -> char;
+ val fromInt16 = _prim "WordS16_toWord32": Int16.int -> char;
+ val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
+ val fromInt64 = _prim "WordS64_toWord32": Int64.int -> char;
+
+ val fromWord8 = _prim "WordU8_toWord32": Word8.word -> char;
+ val fromWord16 = _prim "WordU16_toWord32": Word16.word -> char;
+ val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char;
+ val fromWord64 = _prim "WordU64_toWord32": Word64.word -> char;
+
+ val toInt8 = _prim "WordS32_toWord8": char -> Int8.int;
+ val toInt16 = _prim "WordS32_toWord16": char -> Int16.int;
+ val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
+ val toInt64 = _prim "WordS32_toWord64": char -> Int64.int;
+
+ val toWord8 = _prim "WordU32_toWord8": char -> Word8.word;
+ val toWord16 = _prim "WordU32_toWord16": char -> Word16.word;
+ val toWord32 = _prim "WordU32_toWord32": char -> Word32.word;
+ val toWord64 = _prim "WordU32_toWord64": char -> Word64.word;
+ end
+structure Char32 =
+ struct
+ open Char32
+ local
+ structure S = IntegralComparisons(Char32)
+ in
+ open S
+ end
+ end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,754 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+signature PRIM_INTEGER =
+ sig
+ eqtype int
+ type t = int
+
+ val precision' : Primitive.Int32.int
+ val maxInt': int
+ val minInt': int
+
+ val +? : int * int -> int
+ val + : int * int -> int
+ val *? : int * int -> int
+ val * : int * int -> int
+ val ~? : int -> int
+ val ~ : int -> int
+ val quotUnsafe: int * int -> int
+ val -? : int * int -> int
+ val - : int * int -> int
+ val remUnsafe: int * int -> int
+
+ val < : int * int -> bool
+ val <= : int * int -> bool
+ val > : int * int -> bool
+ val >= : int * int -> bool
+ val compare: int * int -> Primitive.Order.order
+ val min: int * int -> int
+ val max: int * int -> int
+ val ltu: int * int -> bool
+ val leu: int * int -> bool
+ val gtu: int * int -> bool
+ val geu: int * int -> bool
+
+ val andb: int * int -> int
+ val <<? : int * Primitive.Word32.word -> int
+ val notb: int -> int
+ val orb: int * int -> int
+ val rolUnsafe: int * Primitive.Word32.word -> int
+ val rorUnsafe: int * Primitive.Word32.word -> int
+ val ~>>? : int * Primitive.Word32.word -> int
+ val >>? : int * Primitive.Word32.word -> int
+ val xorb: int * int -> int
+
+ type wordEq
+
+ val fromInt8Unsafe: Primitive.Int8.int -> int
+ val fromInt16Unsafe: Primitive.Int16.int -> int
+ val fromInt32Unsafe: Primitive.Int32.int -> int
+ val fromInt64Unsafe: Primitive.Int64.int -> int
+ val fromIntZ8Unsafe: Primitive.Int8.int -> int
+ val fromIntZ16Unsafe: Primitive.Int16.int -> int
+ val fromIntZ32Unsafe: Primitive.Int32.int -> int
+ val fromIntZ64Unsafe: Primitive.Int64.int -> int
+ val fromWord8Unsafe: Primitive.Word8.word -> int
+ val fromWord16Unsafe: Primitive.Word16.word -> int
+ val fromWord32Unsafe: Primitive.Word32.word -> int
+ val fromWord64Unsafe: Primitive.Word64.word -> int
+ val fromWordEqUnsafe: wordEq -> int
+ val fromWordX8Unsafe: Primitive.Word8.word -> int
+ val fromWordX16Unsafe: Primitive.Word16.word -> int
+ val fromWordX32Unsafe: Primitive.Word32.word -> int
+ val fromWordX64Unsafe: Primitive.Word64.word -> int
+ val fromWordXEqUnsafe: wordEq -> int
+
+ val toInt8Unsafe: int -> Primitive.Int8.int
+ val toInt16Unsafe: int -> Primitive.Int16.int
+ val toInt32Unsafe: int -> Primitive.Int32.int
+ val toInt64Unsafe: int -> Primitive.Int64.int
+ val toIntZ8Unsafe: int -> Primitive.Int8.int
+ val toIntZ16Unsafe: int -> Primitive.Int16.int
+ val toIntZ32Unsafe: int -> Primitive.Int32.int
+ val toIntZ64Unsafe: int -> Primitive.Int64.int
+ val toWord8Unsafe: int -> Primitive.Word8.word
+ val toWord16Unsafe: int -> Primitive.Word16.word
+ val toWord32Unsafe: int -> Primitive.Word32.word
+ val toWord64Unsafe: int -> Primitive.Word64.word
+ val toWordEqUnsafe: int -> wordEq
+ val toWordX8Unsafe: int -> Primitive.Word8.word
+ val toWordX16Unsafe: int -> Primitive.Word16.word
+ val toWordX32Unsafe: int -> Primitive.Word32.word
+ val toWordX64Unsafe: int -> Primitive.Word64.word
+ val toWordXEqUnsafe: int -> wordEq
+ end
+
+structure Primitive = struct
+
+open Primitive
+
+structure Int1 =
+ struct
+ open Int1
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
+ val precision' : Int32.int = 1
+ val toBig = _prim "WordU1_toWord8": int -> big;
+ end
+structure Int2 =
+ struct
+ open Int2
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
+ val precision' : Int32.int = 2
+ val toBig = _prim "WordU2_toWord8": int -> big;
+ end
+structure Int3 =
+ struct
+ open Int3
+ type big = Int8.int
+ val precision' : Int32.int = 3
+ val toBig = _prim "WordU3_toWord8": int -> big;
+ end
+structure Int4 =
+ struct
+ open Int4
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
+ val precision' : Int32.int = 4
+ val toBig = _prim "WordU4_toWord8": int -> big;
+ end
+structure Int5 =
+ struct
+ open Int5
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
+ val precision' : Int32.int = 5
+ val toBig = _prim "WordU5_toWord8": int -> big;
+ end
+structure Int6 =
+ struct
+ open Int6
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
+ val precision' : Int32.int = 6
+ val toBig = _prim "WordU6_toWord8": int -> big;
+ end
+structure Int7 =
+ struct
+ open Int7
+ type big = Int8.int
+ val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
+ val precision' : Int32.int = 7
+ val toBig = _prim "WordU7_toWord8": int -> big;
+ end
+structure Int8 =
+ struct
+ open Int8
+
+ val precision' : Int32.int = 8
+ val maxInt' : int = 0x7f
+ val minInt' : int = ~0x80
+
+ val +? = _prim "Word8_add": int * int -> int;
+ val + =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
+ else +?
+ val *? = _prim "WordS8_mul": int * int -> int;
+ val * =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
+ else *?
+ val ~? = _prim "Word8_neg": int -> int;
+ val ~ =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "Word8_negCheck": int -> int;)
+ else ~?
+ val quotUnsafe = _prim "WordS8_quot": int * int -> int;
+ val -? = _prim "Word8_sub": int * int -> int;
+ val - =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
+ else -?
+ val remUnsafe = _prim "WordS8_rem": int * int -> int;
+
+ val < = _prim "WordS8_lt": int * int -> bool;
+
+ val andb = _prim "Word8_andb": int * int -> int;
+ val <<? = _prim "Word8_lshift": int * Word32.word -> int;
+ val notb = _prim "Word8_notb": int -> int;
+ val orb = _prim "Word8_orb": int * int -> int;
+ val rolUnsafe = _prim "Word8_rol": int * Word32.word -> int;
+ val rorUnsafe = _prim "Word8_ror": int * Word32.word -> int;
+ val ~>>? = _prim "WordS8_rshift": int * Word32.word -> int;
+ val >>? = _prim "WordU8_rshift": int * Word32.word -> int;
+ val xorb = _prim "Word8_xorb": int * int -> int;
+
+ type wordEq = Word8.word
+
+ val fromInt8Unsafe = _prim "WordS8_toWord8": Int8.int -> int;
+ val fromInt16Unsafe = _prim "WordS16_toWord8": Int16.int -> int;
+ val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> int;
+ val fromInt64Unsafe = _prim "WordS64_toWord8": Int64.int -> int;
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord8": Int8.int -> int;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord8": Int16.int -> int;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord8": Int32.int -> int;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord8": Int64.int -> int;
+
+ val fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> int;
+ val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> int;
+ val fromWord32Unsafe = _prim "WordU32_toWord8": Word32.word -> int;
+ val fromWord64Unsafe = _prim "WordU64_toWord8": Word64.word -> int;
+ val fromWordEqUnsafe = fromWord8Unsafe
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord8": Word8.word -> int;
+ val fromWordX16Unsafe = _prim "WordS16_toWord8": Word16.word -> int;
+ val fromWordX32Unsafe = _prim "WordS32_toWord8": Word32.word -> int;
+ val fromWordX64Unsafe = _prim "WordS64_toWord8": Word64.word -> int;
+ val fromWordXEqUnsafe = fromWordX8Unsafe
+
+ val toInt8Unsafe = _prim "WordS8_toWord8": int -> Int8.int;
+ val toInt16Unsafe = _prim "WordS8_toWord16": int -> Int16.int;
+ val toInt32Unsafe = _prim "WordS8_toWord32": int -> Int32.int;
+ val toInt64Unsafe = _prim "WordS8_toWord64": int -> Int64.int;
+
+ val toIntZ8Unsafe = _prim "WordU8_toWord8": int -> Int8.int;
+ val toIntZ16Unsafe = _prim "WordU8_toWord16": int -> Int16.int;
+ val toIntZ32Unsafe = _prim "WordU8_toWord32": int -> Int32.int;
+ val toIntZ64Unsafe = _prim "WordU8_toWord64": int -> Int64.int;
+
+ val toWord8Unsafe = _prim "WordU8_toWord8": int -> Word8.word;
+ val toWord16Unsafe = _prim "WordU8_toWord16": int -> Word16.word;
+ val toWord32Unsafe = _prim "WordU8_toWord32": int -> Word32.word;
+ val toWord64Unsafe = _prim "WordU8_toWord64": int -> Word64.word;
+ val toWordEqUnsafe = toWord8Unsafe
+
+ val toWordX8Unsafe = _prim "WordS8_toWord8": int -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS8_toWord16": int -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS8_toWord32": int -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS8_toWord64": int -> Word64.word;
+ val toWordXEqUnsafe = toWordX8Unsafe
+ end
+structure Int8 : PRIM_INTEGER =
+ struct
+ open Int8
+ local
+ structure S = IntegralComparisons(Int8)
+ in
+ open S
+ end
+ local
+ structure S = UnsignedIntegralComparisons(type int = Int8.int
+ type word = Word8.word
+ val fromInt = Word8.fromInt8Unsafe
+ val < = Word8.<)
+ in
+ open S
+ end
+ end
+structure Int9 =
+ struct
+ open Int9
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
+ val precision' : Int32.int = 9
+ val toBig = _prim "WordU9_toWord16": int -> big;
+ end
+structure Int10 =
+ struct
+ open Int10
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
+ val precision' : Int32.int = 10
+ val toBig = _prim "WordU10_toWord16": int -> big;
+ end
+structure Int11 =
+ struct
+ open Int11
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
+ val precision' : Int32.int = 11
+ val toBig = _prim "WordU11_toWord16": int -> big;
+ end
+structure Int12 =
+ struct
+ open Int12
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
+ val precision' : Int32.int = 12
+ val toBig = _prim "WordU12_toWord16": int -> big;
+ end
+structure Int13 =
+ struct
+ open Int13
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
+ val precision' : Int32.int = 13
+ val toBig = _prim "WordU13_toWord16": int -> big;
+ end
+structure Int14 =
+ struct
+ open Int14
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
+ val precision' : Int32.int = 14
+ val toBig = _prim "WordU14_toWord16": int -> big;
+ end
+structure Int15 =
+ struct
+ open Int15
+ type big = Int16.int
+ val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
+ val precision' : Int32.int = 15
+ val toBig = _prim "WordU15_toWord16": int -> big;
+ end
+structure Int16 =
+ struct
+ open Int16
+
+ val precision' : Int32.int = 16
+ val maxInt' : int = 0x7fff
+ val minInt' : int = ~0x8000
+
+ val +? = _prim "Word16_add": int * int -> int;
+ val + =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS16_addCheck": int * int -> int;)
+ else +?
+ val *? = _prim "WordS16_mul": int * int -> int;
+ val * =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS16_mulCheck": int * int -> int;)
+ else *?
+ val ~? = _prim "Word16_neg": int -> int;
+ val ~ =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "Word16_negCheck": int -> int;)
+ else ~?
+ val quotUnsafe = _prim "WordS16_quot": int * int -> int;
+ val -? = _prim "Word16_sub": int * int -> int;
+ val - =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS16_subCheck": int * int -> int;)
+ else -?
+ val remUnsafe = _prim "WordS16_rem": int * int -> int;
+
+ val < = _prim "WordS16_lt": int * int -> bool;
+
+ val andb = _prim "Word16_andb": int * int -> int;
+ val <<? = _prim "Word16_lshift": int * Word32.word -> int;
+ val notb = _prim "Word16_notb": int -> int;
+ val orb = _prim "Word16_orb": int * int -> int;
+ val rolUnsafe = _prim "Word16_rol": int * Word32.word -> int;
+ val rorUnsafe = _prim "Word16_ror": int * Word32.word -> int;
+ val ~>>? = _prim "WordS16_rshift": int * Word32.word -> int;
+ val >>? = _prim "WordU16_rshift": int * Word32.word -> int;
+ val xorb = _prim "Word16_xorb": int * int -> int;
+
+ type wordEq = Word16.word
+
+ val fromInt8Unsafe = _prim "WordS8_toWord16": Int8.int -> int;
+ val fromInt16Unsafe = _prim "WordS16_toWord16": Int16.int -> int;
+ val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> int;
+ val fromInt64Unsafe = _prim "WordS64_toWord16": Int64.int -> int;
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord16": Int8.int -> int;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord16": Int16.int -> int;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord16": Int32.int -> int;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord16": Int64.int -> int;
+
+ val fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> int;
+ val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> int;
+ val fromWord32Unsafe = _prim "WordU32_toWord16": Word32.word -> int;
+ val fromWord64Unsafe = _prim "WordU64_toWord16": Word64.word -> int;
+ val fromWordEqUnsafe = fromWord16Unsafe
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord16": Word8.word -> int;
+ val fromWordX16Unsafe = _prim "WordS16_toWord16": Word16.word -> int;
+ val fromWordX32Unsafe = _prim "WordS32_toWord16": Word32.word -> int;
+ val fromWordX64Unsafe = _prim "WordS64_toWord16": Word64.word -> int;
+ val fromWordXEqUnsafe = fromWordX16Unsafe
+
+ val toInt8Unsafe = _prim "WordS16_toWord8": int -> Int8.int;
+ val toInt16Unsafe = _prim "WordS16_toWord16": int -> Int16.int;
+ val toInt32Unsafe = _prim "WordS16_toWord32": int -> Int32.int;
+ val toInt64Unsafe = _prim "WordS16_toWord64": int -> Int64.int;
+
+ val toIntZ8Unsafe = _prim "WordU16_toWord8": int -> Int8.int;
+ val toIntZ16Unsafe = _prim "WordU16_toWord16": int -> Int16.int;
+ val toIntZ32Unsafe = _prim "WordU16_toWord32": int -> Int32.int;
+ val toIntZ64Unsafe = _prim "WordU16_toWord64": int -> Int64.int;
+
+ val toWord8Unsafe = _prim "WordU16_toWord8": int -> Word8.word;
+ val toWord16Unsafe = _prim "WordU16_toWord16": int -> Word16.word;
+ val toWord32Unsafe = _prim "WordU16_toWord32": int -> Word32.word;
+ val toWord64Unsafe = _prim "WordU16_toWord64": int -> Word64.word;
+ val toWordEqUnsafe = toWord16Unsafe
+
+ val toWordX8Unsafe = _prim "WordS16_toWord8": int -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS16_toWord16": int -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS16_toWord32": int -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS16_toWord64": int -> Word64.word;
+ val toWordXEqUnsafe = toWordX16Unsafe
+ end
+structure Int16 : PRIM_INTEGER =
+ struct
+ open Int16
+ local
+ structure S = IntegralComparisons(Int16)
+ in
+ open S
+ end
+ local
+ structure S = UnsignedIntegralComparisons(type int = Int16.int
+ type word = Word16.word
+ val fromInt = Word16.fromInt16Unsafe
+ val < = Word16.<)
+ in
+ open S
+ end
+ end
+structure Int17 =
+ struct
+ open Int17
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
+ val precision' : Int32.int = 17
+ val toBig = _prim "WordU17_toWord32": int -> big;
+ end
+structure Int18 =
+ struct
+ open Int18
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
+ val precision' : Int32.int = 18
+ val toBig = _prim "WordU18_toWord32": int -> big;
+ end
+structure Int19 =
+ struct
+ open Int19
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
+ val precision' : Int32.int = 19
+ val toBig = _prim "WordU19_toWord32": int -> big;
+ end
+structure Int20 =
+ struct
+ open Int20
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
+ val precision' : Int32.int = 20
+ val toBig = _prim "WordU20_toWord32": int -> big;
+ end
+structure Int21 =
+ struct
+ open Int21
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
+ val precision' : Int32.int = 21
+ val toBig = _prim "WordU21_toWord32": int -> big;
+ end
+structure Int22 =
+ struct
+ open Int22
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
+ val precision' : Int32.int = 22
+ val toBig = _prim "WordU22_toWord32": int -> big;
+ end
+structure Int23 =
+ struct
+ open Int23
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
+ val precision' : Int32.int = 23
+ val toBig = _prim "WordU23_toWord32": int -> big;
+ end
+structure Int24 =
+ struct
+ open Int24
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
+ val precision' : Int32.int = 24
+ val toBig = _prim "WordU24_toWord32": int -> big;
+ end
+structure Int25 =
+ struct
+ open Int25
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
+ val precision' : Int32.int = 25
+ val toBig = _prim "WordU25_toWord32": int -> big;
+ end
+structure Int26 =
+ struct
+ open Int26
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
+ val precision' : Int32.int = 26
+ val toBig = _prim "WordU26_toWord32": int -> big;
+ end
+structure Int27 =
+ struct
+ open Int27
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
+ val precision' : Int32.int = 27
+ val toBig = _prim "WordU27_toWord32": int -> big;
+ end
+structure Int28 =
+ struct
+ open Int28
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
+ val precision' : Int32.int = 28
+ val toBig = _prim "WordU28_toWord32": int -> big;
+ end
+structure Int29 =
+ struct
+ open Int29
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
+ val precision' : Int32.int = 29
+ val toBig = _prim "WordU29_toWord32": int -> big;
+ end
+structure Int30 =
+ struct
+ open Int30
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
+ val precision' : Int32.int = 30
+ val toBig = _prim "WordU30_toWord32": int -> big;
+ end
+structure Int31 =
+ struct
+ open Int31
+ type big = Int32.int
+ val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
+ val precision' : Int32.int = 31
+ val toBig = _prim "WordU31_toWord32": int -> big;
+ end
+structure Int32 =
+ struct
+ open Int32
+
+ val precision' : Int32.int = 32
+ val maxInt' : int = 0x7fffffff
+ val minInt' : int = ~0x80000000
+
+ val +? = _prim "Word32_add": int * int -> int;
+ val + =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS32_addCheck": int * int -> int;)
+ else +?
+ val *? = _prim "WordS32_mul": int * int -> int;
+ val * =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS32_mulCheck": int * int -> int;)
+ else *?
+ val ~? = _prim "Word32_neg": int -> int;
+ val ~ =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "Word32_negCheck": int -> int;)
+ else ~?
+ val quotUnsafe = _prim "WordS32_quot": int * int -> int;
+ val -? = _prim "Word32_sub": int * int -> int;
+ val - =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS32_subCheck": int * int -> int;)
+ else -?
+ val remUnsafe = _prim "WordS32_rem": int * int -> int;
+
+ val < = _prim "WordS32_lt": int * int -> bool;
+
+ val andb = _prim "Word32_andb": int * int -> int;
+ val <<? = _prim "Word32_lshift": int * Word32.word -> int;
+ val notb = _prim "Word32_notb": int -> int;
+ val orb = _prim "Word32_orb": int * int -> int;
+ val rolUnsafe = _prim "Word32_rol": int * Word32.word -> int;
+ val rorUnsafe = _prim "Word32_ror": int * Word32.word -> int;
+ val ~>>? = _prim "WordS32_rshift": int * Word32.word -> int;
+ val >>? = _prim "WordU32_rshift": int * Word32.word -> int;
+ val xorb = _prim "Word32_xorb": int * int -> int;
+
+ type wordEq = Word32.word
+
+ val fromInt8Unsafe = _prim "WordS8_toWord32": Int8.int -> int;
+ val fromInt16Unsafe = _prim "WordS16_toWord32": Int16.int -> int;
+ val fromInt32Unsafe = _prim "WordS32_toWord32": Int32.int -> int;
+ val fromInt64Unsafe = _prim "WordS64_toWord32": Int64.int -> int;
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord32": Int8.int -> int;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord32": Int16.int -> int;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord32": Int32.int -> int;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord32": Int64.int -> int;
+
+ val fromWord8Unsafe = _prim "WordU8_toWord32": Word8.word -> int;
+ val fromWord16Unsafe = _prim "WordU16_toWord32": Word16.word -> int;
+ val fromWord32Unsafe = _prim "WordU32_toWord32": Word32.word -> int;
+ val fromWord64Unsafe = _prim "WordU64_toWord32": Word64.word -> int;
+ val fromWordEqUnsafe = fromWord32Unsafe
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord32": Word8.word -> int;
+ val fromWordX16Unsafe = _prim "WordS16_toWord32": Word16.word -> int;
+ val fromWordX32Unsafe = _prim "WordS32_toWord32": Word32.word -> int;
+ val fromWordX64Unsafe = _prim "WordS64_toWord32": Word64.word -> int;
+ val fromWordXEqUnsafe = fromWordX32Unsafe
+
+ val toInt8Unsafe = _prim "WordS32_toWord8": int -> Int8.int;
+ val toInt16Unsafe = _prim "WordS32_toWord16": int -> Int16.int;
+ val toInt32Unsafe = _prim "WordS32_toWord32": int -> Int32.int;
+ val toInt64Unsafe = _prim "WordS32_toWord64": int -> Int64.int;
+
+ val toIntZ8Unsafe = _prim "WordU32_toWord8": int -> Int8.int;
+ val toIntZ16Unsafe = _prim "WordU32_toWord16": int -> Int16.int;
+ val toIntZ32Unsafe = _prim "WordU32_toWord32": int -> Int32.int;
+ val toIntZ64Unsafe = _prim "WordU32_toWord64": int -> Int64.int;
+
+ val toWord8Unsafe = _prim "WordU32_toWord8": int -> Word8.word;
+ val toWord16Unsafe = _prim "WordU32_toWord16": int -> Word16.word;
+ val toWord32Unsafe = _prim "WordU32_toWord32": int -> Word32.word;
+ val toWord64Unsafe = _prim "WordU32_toWord64": int -> Word64.word;
+ val toWordEqUnsafe = toWord32Unsafe
+
+ val toWordX8Unsafe = _prim "WordS32_toWord8": int -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS32_toWord16": int -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS32_toWord32": int -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS32_toWord64": int -> Word64.word;
+ val toWordXEqUnsafe = toWordX32Unsafe
+ end
+structure Int32 : PRIM_INTEGER =
+ struct
+ open Int32
+ local
+ structure S = IntegralComparisons(Int32)
+ in
+ open S
+ end
+ local
+ structure S = UnsignedIntegralComparisons(type int = Int32.int
+ type word = Word32.word
+ val fromInt = Word32.fromInt32Unsafe
+ val < = Word32.<)
+ in
+ open S
+ end
+ end
+structure Int64 =
+ struct
+ open Int64
+
+ val precision' : Int32.int = 64
+ val maxInt' : int = 0x7fffffffffffffff
+ val minInt' : int = ~0x8000000000000000
+
+ val +? = _prim "Word64_add": int * int -> int;
+ val + =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS64_addCheck": int * int -> int;)
+ else +?
+ val *? = _prim "WordS64_mul": int * int -> int;
+ val * =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS64_mulCheck": int * int -> int;)
+ else *?
+ val ~? = _prim "Word64_neg": int -> int;
+ val ~ =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "Word64_negCheck": int -> int;)
+ else ~?
+ val quotUnsafe = _prim "WordS64_quot": int * int -> int;
+ val -? = _prim "Word64_sub": int * int -> int;
+ val - =
+ if Controls.detectOverflow
+ then Exn.wrapOverflow (_prim "WordS64_subCheck": int * int -> int;)
+ else -?
+ val remUnsafe = _prim "WordS64_rem": int * int -> int;
+
+ val < = _prim "WordS64_lt": int * int -> bool;
+
+ val andb = _prim "Word64_andb": int * int -> int;
+ val <<? = _prim "Word64_lshift": int * Word32.word -> int;
+ val notb = _prim "Word64_notb": int -> int;
+ val orb = _prim "Word64_orb": int * int -> int;
+ val rolUnsafe = _prim "Word64_rol": int * Word32.word -> int;
+ val rorUnsafe = _prim "Word64_ror": int * Word32.word -> int;
+ val ~>>? = _prim "WordS64_rshift": int * Word32.word -> int;
+ val >>? = _prim "WordU64_rshift": int * Word32.word -> int;
+ val xorb = _prim "Word64_xorb": int * int -> int;
+
+ type wordEq = Word64.word
+
+ val fromInt8Unsafe = _prim "WordS8_toWord64": Int8.int -> int;
+ val fromInt16Unsafe = _prim "WordS16_toWord64": Int16.int -> int;
+ val fromInt32Unsafe = _prim "WordS32_toWord64": Int32.int -> int;
+ val fromInt64Unsafe = _prim "WordS64_toWord64": Int64.int -> int;
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord64": Int8.int -> int;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord64": Int16.int -> int;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord64": Int32.int -> int;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord64": Int64.int -> int;
+
+ val fromWord8Unsafe = _prim "WordU8_toWord64": Word8.word -> int;
+ val fromWord16Unsafe = _prim "WordU16_toWord64": Word16.word -> int;
+ val fromWord32Unsafe = _prim "WordU32_toWord64": Word32.word -> int;
+ val fromWord64Unsafe = _prim "WordU64_toWord64": Word64.word -> int;
+ val fromWordEqUnsafe = fromWord64Unsafe
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord64": Word8.word -> int;
+ val fromWordX16Unsafe = _prim "WordS16_toWord64": Word16.word -> int;
+ val fromWordX32Unsafe = _prim "WordS32_toWord64": Word32.word -> int;
+ val fromWordX64Unsafe = _prim "WordS64_toWord64": Word64.word -> int;
+ val fromWordXEqUnsafe = fromWordX64Unsafe
+
+ val toInt8Unsafe = _prim "WordS64_toWord8": int -> Int8.int;
+ val toInt16Unsafe = _prim "WordS64_toWord16": int -> Int16.int;
+ val toInt32Unsafe = _prim "WordS64_toWord32": int -> Int32.int;
+ val toInt64Unsafe = _prim "WordS64_toWord64": int -> Int64.int;
+
+ val toIntZ8Unsafe = _prim "WordU64_toWord8": int -> Int8.int;
+ val toIntZ16Unsafe = _prim "WordU64_toWord16": int -> Int16.int;
+ val toIntZ32Unsafe = _prim "WordU64_toWord32": int -> Int32.int;
+ val toIntZ64Unsafe = _prim "WordU64_toWord64": int -> Int64.int;
+
+ val toWord8Unsafe = _prim "WordU64_toWord8": int -> Word8.word;
+ val toWord16Unsafe = _prim "WordU64_toWord16": int -> Word16.word;
+ val toWord32Unsafe = _prim "WordU64_toWord32": int -> Word32.word;
+ val toWord64Unsafe = _prim "WordU64_toWord64": int -> Word64.word;
+ val toWordEqUnsafe = toWord64Unsafe
+
+ val toWordX8Unsafe = _prim "WordS64_toWord8": int -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS64_toWord16": int -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS64_toWord32": int -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS64_toWord64": int -> Word64.word;
+ val toWordXEqUnsafe = toWordX64Unsafe
+ end
+structure Int64 : PRIM_INTEGER =
+ struct
+ open Int64
+ local
+ structure S = IntegralComparisons(Int64)
+ in
+ open S
+ end
+ local
+ structure S = UnsignedIntegralComparisons(type int = Int64.int
+ type word = Word64.word
+ val fromInt = Word64.fromInt64Unsafe
+ val < = Word64.<)
+ in
+ open S
+ end
+ end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-intinf.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-intinf.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,41 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure IntInf =
+ struct
+ open IntInf
+
+ val + = _prim "IntInf_add": int * int * C_Size.t -> int;
+ val andb = _prim "IntInf_andb": int * int * C_Size.t -> int;
+ val ~>> = _prim "IntInf_arshift": int * Word32.word * C_Size.t -> int;
+ val compare = _prim "IntInf_compare": int * int -> Int32.int;
+ val fromVector = _prim "WordVector_toIntInf": C_MPLimb.t vector -> int;
+ val fromWord = _prim "Word_toIntInf": ObjptrWord.word -> int;
+ val gcd = _prim "IntInf_gcd": int * int * C_Size.t -> int;
+ val << = _prim "IntInf_lshift": int * Word32.word * C_Size.t -> int;
+ val * = _prim "IntInf_mul": int * int * C_Size.t -> int;
+ val ~ = _prim "IntInf_neg": int * C_Size.t -> int;
+ val notb = _prim "IntInf_notb": int * C_Size.t -> int;
+ val orb = _prim "IntInf_orb": int * int * C_Size.t -> int;
+ val quot = _prim "IntInf_quot": int * int * C_Size.t -> int;
+ val rem = _prim "IntInf_rem": int * int * C_Size.t -> int;
+ val - = _prim "IntInf_sub": int * int * C_Size.t -> int;
+ val toString =
+ _prim "IntInf_toString": int * Int32.int * C_Size.t -> String8.string;
+ val toVector = _prim "IntInf_toVector": int -> C_MPLimb.t vector;
+ val toWord = _prim "IntInf_toWord": int -> ObjptrWord.word;
+ val xorb = _prim "IntInf_xorb": int * int * C_Size.t -> int;
+ end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,297 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure MLton = struct
+
+val bug = _import "MLton_bug": NullString8.t -> unit;
+val eq = _prim "MLton_eq": 'a * 'a -> bool;
+(* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
+val halt = _prim "MLton_halt": C_Status.t -> unit;
+(* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
+val share = _prim "MLton_share": 'a -> unit;
+val size = _prim "MLton_size": 'a ref -> C_Size.t;
+
+val installSignalHandler =
+ _prim "MLton_installSignalHandler": unit -> unit;
+
+structure GCState =
+ struct
+ type t = Pointer.t
+
+ val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
+ end
+
+structure Callcc =
+ struct
+ val usesCallcc: bool ref = ref false
+ end
+
+structure CallStack =
+ struct
+ (* The most recent caller is at index 0 in the array. *)
+ datatype t = T of Word32.word array
+
+ val callStack =
+ _import "GC_callStack": GCState.t * Word32.word array -> unit;
+ val frameIndexSourceSeq =
+ _import "GC_frameIndexSourceSeq": GCState.t * Word32.word -> Pointer.t;
+ val keep = _command_line_const "CallStack.keep": bool = false;
+ val numStackFrames =
+ _import "GC_numStackFrames": GCState.t -> Word32.word;
+ val sourceName = _import "GC_sourceName": GCState.t * Word32.word -> C_String.t;
+ end
+
+structure Codegen =
+ struct
+ datatype t = Bytecode | C | Native
+
+ val codegen =
+ case _build_const "MLton_Codegen_codegen": Int32.int; of
+ 0 => Bytecode
+ | 1 => C
+ | 2 => Native
+ | _ => raise Primitive.Exn.Fail8 "MLton_Codegen_codegen"
+
+ val isBytecode = codegen = Bytecode
+ val isC = codegen = C
+ val isNative = codegen = Native
+ end
+
+structure Exn =
+ struct
+ (* The polymorphism with extra and setInitExtra is because primitives
+ * are only supposed to deal with basic types. The polymorphism
+ * allows the various passes like monomorphisation to translate
+ * the types appropriately.
+ *)
+ type extra = CallStack.t option
+
+ val extra = _prim "Exn_extra": exn -> 'a;
+ val extra: exn -> extra = extra
+ val keepHistory = _command_line_const "Exn.keepHistory": bool = false;
+ val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
+ val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
+ val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
+ val setInitExtra: extra -> unit = setInitExtra
+ end
+
+structure FFI =
+ struct
+ val getOp = #1 _symbol "MLton_FFI_op": Int32.t GetSet.t;
+ val int8Array = #1 _symbol "MLton_FFI_Int8": Pointer.t GetSet.t; ()
+ val int16Array = #1 _symbol "MLton_FFI_Int16": Pointer.t GetSet.t; ()
+ val int32Array = #1 _symbol "MLton_FFI_Int32": Pointer.t GetSet.t; ()
+ val int64Array = #1 _symbol "MLton_FFI_Int64": Pointer.t GetSet.t; ()
+ val numExports = _build_const "MLton_FFI_numExports": Int32.int;
+ val pointerArray = #1 _symbol "MLton_FFI_Pointer": Pointer.t GetSet.t; ()
+ val real32Array = #1 _symbol "MLton_FFI_Real32": Pointer.t GetSet.t; ()
+ val real64Array = #1 _symbol "MLton_FFI_Real64": Pointer.t GetSet.t; ()
+ val word8Array = #1 _symbol "MLton_FFI_Word8": Pointer.t GetSet.t; ()
+ val word16Array = #1 _symbol "MLton_FFI_Word16": Pointer.t GetSet.t; ()
+ val word32Array = #1 _symbol "MLton_FFI_Word32": Pointer.t GetSet.t; ()
+ val word64Array = #1 _symbol "MLton_FFI_Word64": Pointer.t GetSet.t; ()
+ end
+
+structure Finalizable =
+ struct
+ val touch = _prim "MLton_touch": 'a -> unit;
+ end
+
+structure GC =
+ struct
+ val collect = _prim "GC_collect": unit -> unit;
+ val pack = _import "GC_pack": GCState.t -> unit;
+ val setHashConsDuringGC =
+ _import "GC_setHashConsDuringGC": GCState.t * bool -> unit;
+ val setMessages = _import "GC_setMessages": GCState.t * bool -> unit;
+ val setRusageMeasureGC =
+ _import "GC_setRusageMeasureGC": GCState.t * bool -> unit;
+ val setSummary = _import "GC_setSummary": GCState.t * bool -> unit;
+ val unpack = _import "GC_unpack": GCState.t -> unit;
+ end
+
+structure Platform =
+ struct
+ structure Arch =
+ struct
+ datatype t =
+ Alpha
+ | AMD64
+ | ARM
+ | HPPA
+ | IA64
+ | m68k
+ | MIPS
+ | PowerPC
+ | S390
+ | Sparc
+ | X86
+
+ val host: t =
+ case _const "MLton_Platform_Arch_host": String8.string; of
+ "alpha" => Alpha
+ | "amd64" => AMD64
+ | "arm" => ARM
+ | "hppa" => HPPA
+ | "ia64" => IA64
+ | "m68k" => m68k
+ | "mips" => MIPS
+ | "powerpc" => PowerPC
+ | "s390" => S390
+ | "sparc" => Sparc
+ | "x86" => X86
+ | _ => raise Primitive.Exn.Fail8 "strange MLton_Platform_Arch_host"
+
+ val hostIsBigEndian = _const "MLton_Platform_Arch_bigendian": bool;
+ end
+
+ structure OS =
+ struct
+ datatype t =
+ Cygwin
+ | Darwin
+ | FreeBSD
+ | Linux
+ | MinGW
+ | NetBSD
+ | OpenBSD
+ | Solaris
+
+ val host: t =
+ case _const "MLton_Platform_OS_host": String8.string; of
+ "cygwin" => Cygwin
+ | "darwin" => Darwin
+ | "freebsd" => FreeBSD
+ | "linux" => Linux
+ | "mingw" => MinGW
+ | "netbsd" => NetBSD
+ | "openbsd" => OpenBSD
+ | "solaris" => Solaris
+ | _ => raise Primitive.Exn.Fail8 "strange MLton_Platform_OS_host"
+
+ val forkIsEnabled =
+ case host of
+ Cygwin =>
+ #1 _symbol "MLton_Platform_CygwinUseMmap": bool GetSet.t; ()
+ | MinGW => false
+ | _ => true
+
+ val useWindowsProcess = not forkIsEnabled
+ end
+ end
+
+structure Pointer =
+ struct
+ open Pointer
+
+ 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;
+ structure Data =
+ struct
+ type t = Pointer.t
+
+ (* val dummy:t = 0w0 *)
+ val free = _import "GC_profileFree": GCState.t * t -> unit;
+ val malloc = _import "GC_profileMalloc": GCState.t -> t;
+ val write = _import "GC_profileWrite": GCState.t * t * C_Fd.t -> unit;
+ end
+ val done = _import "GC_profileDone": GCState.t -> unit;
+ val getCurrent = _import "GC_getProfileCurrent": GCState.t -> Data.t;
+ val setCurrent = _import "GC_setProfileCurrent" : GCState.t * Data.t -> unit;
+ end
+
+structure Thread =
+ struct
+ type preThread = PreThread.t
+ type thread = Thread.t
+
+ val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
+ val canHandle = _prim "Thread_canHandle": unit -> Word32.word;
+ fun atomicEnd () =
+ if canHandle () = 0w0
+ then raise Primitive.Exn.Fail8 "Thread.atomicEnd"
+ else _prim "Thread_atomicEnd": unit -> unit; ()
+ val copy = _prim "Thread_copy": preThread -> thread;
+ (* copyCurrent's result is accesible via savedPre ().
+ * It is not possible to have the type of copyCurrent as
+ * unit -> preThread, because there are two different ways to
+ * return from the call to copyCurrent. One way is the direct
+ * obvious way, in the thread that called copyCurrent. That one,
+ * of course, wants to call savedPre (). However, another way to
+ * return is by making a copy of the preThread and then switching
+ * to it. In that case, there is no preThread to return. Making
+ * copyCurrent return a preThread creates nasty bugs where the
+ * return code from the CCall expects to see a preThread result
+ * according to the C return convention, but there isn't one when
+ * switching to a copy.
+ *)
+ val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
+ val current = _import "GC_getCurrentThread": GCState.t -> thread;
+ val finishSignalHandler = _import "GC_finishSignalHandler": GCState.t -> unit;
+ val returnToC = _prim "Thread_returnToC": unit -> unit;
+ val saved = _import "GC_getSavedThread": GCState.t -> thread;
+ val savedPre = _import "GC_getSavedThread": GCState.t -> preThread;
+ val setCallFromCHandler =
+ _import "GC_setCallFromCHandlerThread": GCState.t * thread -> unit;
+ val setSignalHandler =
+ _import "GC_setSignalHandlerThread": GCState.t * thread -> unit;
+ val setSaved = _import "GC_setSavedThread": GCState.t * thread -> unit;
+ val startSignalHandler = _import "GC_startSignalHandler": GCState.t -> unit;
+ val switchTo = _prim "Thread_switchTo": thread -> unit;
+ end
+
+structure Weak =
+ struct
+ open Weak
+
+ val canGet = _prim "Weak_canGet": 'a t -> bool;
+ val get = _prim "Weak_get": 'a t -> 'a;
+ val new = _prim "Weak_new": 'a -> 'a t;
+ end
+
+structure World =
+ struct
+ val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
+ val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
+ val save = _prim "World_save": C_Fd.t -> unit;
+ end
+
+end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-nullstring.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-nullstring.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,39 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+(* NullString is used for strings that must be passed to C and hence must be
+ * null terminated. After the Primitive structure is defined,
+ * NullString.fromString is replaced by a version that checks that the string
+ * is indeed null terminated. See the bottom of this file.
+ *)
+structure NullString8 :>
+ sig
+ type t
+
+ val empty: String8.string
+ val fromString: String8.string -> t
+ end =
+ struct
+ type t = String8.string
+
+ fun fromString s =
+ if #"\000" = Vector.sub (s, SeqIndex.- (Vector.length s, 1))
+ then s
+ else raise Exn.Fail8 "NullString.fromString"
+
+ val empty = fromString "\000"
+ end
+structure NullString8Array = struct type t = NullString8.t array end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,42 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure Array =
+ struct
+ open Array
+ val array = _prim "Array_array": SeqIndex.int -> 'a array;
+ val array =
+ fn n => if Controls.safe andalso SeqIndex.< (n, 0)
+ then raise Exn.Size
+ else array n
+ val array0Const = _prim "Array_array0Const": unit -> 'a array;
+ val length = _prim "Array_length": 'a array -> SeqIndex.int;
+ (* There is no maximum length on arrays, so maxLen = maxInt. *)
+ val maxLen': SeqIndex.int = SeqIndex.maxInt'
+ val sub = _prim "Array_sub": 'a array * SeqIndex.int -> 'a;
+ val update = _prim "Array_update": 'a array * SeqIndex.int * 'a -> unit;
+ end
+
+structure Vector =
+ struct
+ open Vector
+ val sub = _prim "Vector_sub": 'a vector * SeqIndex.int -> 'a;
+ val length = _prim "Vector_length": 'a vector -> SeqIndex.int;
+ (* Don't mutate the array after you apply fromArray, because vectors
+ * are supposed to be immutable and the optimizer depends on this.
+ *)
+ val fromArray = _prim "Array_toVector": 'a array -> 'a vector;
+ end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,642 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+signature PRIM_WORD =
+ sig
+ eqtype word
+ type t = word
+
+ val wordSize': Primitive.Int32.int
+
+ val + : word * word -> word
+ val andb : word * word -> word
+ val <<? : word * Primitive.Word32.word -> word
+ val * : word * word -> word
+ val ~ : word -> word
+ val notb : word -> word
+ val orb : word * word -> word
+ val quotUnsafe : word * word -> word
+ val remUnsafe: word * word -> word
+ val rolUnsafe: word * Primitive.Word32.word -> word
+ val rorUnsafe: word * Primitive.Word32.word -> word
+ val ~>>? : word * Primitive.Word32.word -> word
+ val >>? : word * Primitive.Word32.word -> word
+ val - : word * word -> word
+ val xorb: word * word -> word
+
+ val < : word * word -> bool
+ val <= : word * word -> bool
+ val > : word * word -> bool
+ val >= : word * word -> bool
+ val compare: word * word -> Primitive.Order.order
+ val min: word * word -> word
+ val max: word * word -> word
+
+ type intEq
+
+ val fromInt8Unsafe: Primitive.Int8.int -> word
+ val fromInt16Unsafe: Primitive.Int16.int -> word
+ val fromInt32Unsafe: Primitive.Int32.int -> word
+ val fromInt64Unsafe: Primitive.Int64.int -> word
+ val fromIntEqUnsafe: intEq -> word
+
+ val fromIntZ8Unsafe: Primitive.Int8.int -> word
+ val fromIntZ16Unsafe: Primitive.Int16.int -> word
+ val fromIntZ32Unsafe: Primitive.Int32.int -> word
+ val fromIntZ64Unsafe: Primitive.Int64.int -> word
+ val fromIntZEqUnsafe: intEq -> word
+
+ val fromWord8Unsafe: Primitive.Word8.word -> word
+ val fromWord16Unsafe: Primitive.Word16.word -> word
+ val fromWord32Unsafe: Primitive.Word32.word -> word
+ val fromWord64Unsafe: Primitive.Word64.word -> word
+
+ val fromWordX8Unsafe: Primitive.Word8.word -> word
+ val fromWordX16Unsafe: Primitive.Word16.word -> word
+ val fromWordX32Unsafe: Primitive.Word32.word -> word
+ val fromWordX64Unsafe: Primitive.Word64.word -> word
+
+ val toInt8Unsafe: word -> Primitive.Int8.int
+ val toInt16Unsafe: word -> Primitive.Int16.int
+ val toInt32Unsafe: word -> Primitive.Int32.int
+ val toInt64Unsafe: word -> Primitive.Int64.int
+ val toIntEqUnsafe: word -> intEq
+
+ val toIntX8Unsafe: word -> Primitive.Int8.int
+ val toIntX16Unsafe: word -> Primitive.Int16.int
+ val toIntX32Unsafe: word -> Primitive.Int32.int
+ val toIntX64Unsafe: word -> Primitive.Int64.int
+ val toIntXEqUnsafe: word -> intEq
+
+ val toWord8Unsafe: word -> Primitive.Word8.word
+ val toWord16Unsafe: word -> Primitive.Word16.word
+ val toWord32Unsafe: word -> Primitive.Word32.word
+ val toWord64Unsafe: word -> Primitive.Word64.word
+
+ val toWordX8Unsafe: word -> Primitive.Word8.word
+ val toWordX16Unsafe: word -> Primitive.Word16.word
+ val toWordX32Unsafe: word -> Primitive.Word32.word
+ val toWordX64Unsafe: word -> Primitive.Word64.word
+ end
+
+structure Primitive = struct
+
+open Primitive
+
+structure Word1 =
+ struct
+ open Word1
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
+ val toBig = _prim "WordU1_toWord8": word -> big;
+ val wordSize' : Int32.int = 1
+ end
+structure Word2 =
+ struct
+ open Word2
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
+ val toBig = _prim "WordU2_toWord8": word -> big;
+ val wordSize' : Int32.int = 2
+ end
+structure Word3 =
+ struct
+ open Word3
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
+ val toBig = _prim "WordU3_toWord8": word -> big;
+ val wordSize' : Int32.int = 3
+ end
+structure Word4 =
+ struct
+ open Word4
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
+ val toBig = _prim "WordU4_toWord8": word -> big;
+ val wordSize' : Int32.int = 4
+ end
+structure Word5 =
+ struct
+ open Word5
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
+ val toBig = _prim "WordU5_toWord8": word -> big;
+ val wordSize' : Int32.int = 5
+ end
+structure Word6 =
+ struct
+ open Word6
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
+ val toBig = _prim "WordU6_toWord8": word -> big;
+ val wordSize' : Int32.int = 6
+ end
+structure Word7 =
+ struct
+ open Word7
+ type big = Word8.word
+ val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
+ val toBig = _prim "WordU7_toWord8": word -> big;
+ val wordSize' : Int32.int = 7
+ end
+structure Word8 =
+ struct
+ open Word8
+
+ val wordSize' : Int32.int = 8
+
+ val + = _prim "Word8_add": word * word -> word;
+ val andb = _prim "Word8_andb": word * word -> word;
+ val <<? = _prim "Word8_lshift": word * Word32.word -> word;
+ val * = _prim "WordU8_mul": word * word -> word;
+ val ~ = _prim "Word8_neg": word -> word;
+ val notb = _prim "Word8_notb": word -> word;
+ val orb = _prim "Word8_orb": word * word -> word;
+ val quotUnsafe = _prim "WordU8_quot": word * word -> word;
+ val remUnsafe = _prim "WordU8_rem": word * word -> word;
+ val rolUnsafe = _prim "Word8_rol": word * Word32.word -> word;
+ val rorUnsafe = _prim "Word8_ror": word * Word32.word -> word;
+ val ~>>? = _prim "WordS8_rshift": word * Word32.word -> word;
+ val >>? = _prim "WordU8_rshift": word * Word32.word -> word;
+ val - = _prim "Word8_sub": word * word -> word;
+ val xorb = _prim "Word8_xorb": word * word -> word;
+
+ val < = _prim "WordU8_lt": word * word -> bool;
+
+ type intEq = Int8.int
+
+ val fromInt8Unsafe = _prim "WordS8_toWord8": Int8.int -> word;
+ val fromInt16Unsafe = _prim "WordS16_toWord8": Int16.int -> word;
+ val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> word;
+ val fromInt64Unsafe = _prim "WordS64_toWord8": Int64.int -> word;
+ val fromIntEqUnsafe = fromInt8Unsafe
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord8": Int8.int -> word;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord8": Int16.int -> word;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord8": Int32.int -> word;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord8": Int64.int -> word;
+ val fromIntZEqUnsafe = fromIntZ8Unsafe
+
+ val fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> word;
+ val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> word;
+ val fromWord32Unsafe = _prim "WordU32_toWord8": Word32.word -> word;
+ val fromWord64Unsafe = _prim "WordU64_toWord8": Word64.word -> word;
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord8": Word8.word -> word;
+ val fromWordX16Unsafe = _prim "WordS16_toWord8": Word16.word -> word;
+ val fromWordX32Unsafe = _prim "WordS32_toWord8": Word32.word -> word;
+ val fromWordX64Unsafe = _prim "WordS64_toWord8": Word64.word -> word;
+
+ val toInt8Unsafe = _prim "WordU8_toWord8": word -> Int8.int;
+ val toInt16Unsafe = _prim "WordU8_toWord16": word -> Int16.int;
+ val toInt32Unsafe = _prim "WordU8_toWord32": word -> Int32.int;
+ val toInt64Unsafe = _prim "WordU8_toWord64": word -> Int64.int;
+ val toIntEqUnsafe = toInt8Unsafe
+
+ val toIntX8Unsafe = _prim "WordS8_toWord8": word -> Int8.int;
+ val toIntX16Unsafe = _prim "WordS8_toWord16": word -> Int16.int;
+ val toIntX32Unsafe = _prim "WordS8_toWord32": word -> Int32.int;
+ val toIntX64Unsafe = _prim "WordS8_toWord64": word -> Int64.int;
+ val toIntXEqUnsafe = toIntX8Unsafe
+
+ val toWord8Unsafe = _prim "WordU8_toWord8": word -> Word8.word;
+ val toWord16Unsafe = _prim "WordU8_toWord16": word -> Word16.word;
+ val toWord32Unsafe = _prim "WordU8_toWord32": word -> Word32.word;
+ val toWord64Unsafe = _prim "WordU8_toWord64": word -> Word64.word;
+
+ val toWordX8Unsafe = _prim "WordS8_toWord8": word -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS8_toWord16": word -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS8_toWord32": word -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS8_toWord64": word -> Word64.word;
+ end
+structure Word8 : PRIM_WORD =
+ struct
+ open Word8
+ local
+ structure S = IntegralComparisons(Word8)
+ in
+ open S
+ end
+ end
+structure Word9 =
+ struct
+ open Word9
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
+ val toBig = _prim "WordU9_toWord16": word -> big;
+ val wordSize' : Int32.int = 9
+ end
+structure Word10 =
+ struct
+ open Word10
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
+ val toBig = _prim "WordU10_toWord16": word -> big;
+ val wordSize' : Int32.int = 10
+ end
+structure Word11 =
+ struct
+ open Word11
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
+ val toBig = _prim "WordU11_toWord16": word -> big;
+ val wordSize' : Int32.int = 11
+ end
+structure Word12 =
+ struct
+ open Word12
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
+ val toBig = _prim "WordU12_toWord16": word -> big;
+ val wordSize' : Int32.int = 12
+ end
+structure Word13 =
+ struct
+ open Word13
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
+ val toBig = _prim "WordU13_toWord16": word -> big;
+ val wordSize' : Int32.int = 13
+ end
+structure Word14 =
+ struct
+ open Word14
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
+ val toBig = _prim "WordU14_toWord16": word -> big;
+ val wordSize' : Int32.int = 14
+ end
+structure Word15 =
+ struct
+ open Word15
+ type big = Word16.word
+ val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
+ val toBig = _prim "WordU15_toWord16": word -> big;
+ val wordSize' : Int32.int = 15
+ end
+structure Word16 =
+ struct
+ open Word16
+
+ val wordSize' : Int32.int = 16
+
+ val + = _prim "Word16_add": word * word -> word;
+ val andb = _prim "Word16_andb": word * word -> word;
+ val <<? = _prim "Word16_lshift": word * Word32.word -> word;
+ val * = _prim "WordU16_mul": word * word -> word;
+ val ~ = _prim "Word16_neg": word -> word;
+ val notb = _prim "Word16_notb": word -> word;
+ val orb = _prim "Word16_orb": word * word -> word;
+ val quotUnsafe = _prim "WordU16_quot": word * word -> word;
+ val remUnsafe = _prim "WordU16_rem": word * word -> word;
+ val rolUnsafe = _prim "Word16_rol": word * Word32.word -> word;
+ val rorUnsafe = _prim "Word16_ror": word * Word32.word -> word;
+ val ~>>? = _prim "WordS16_rshift": word * Word32.word -> word;
+ val >>? = _prim "WordU16_rshift": word * Word32.word -> word;
+ val - = _prim "Word16_sub": word * word -> word;
+ val xorb = _prim "Word16_xorb": word * word -> word;
+
+ val < = _prim "WordU16_lt": word * word -> bool;
+
+ type intEq = Int16.int
+
+ val fromInt8Unsafe = _prim "WordS8_toWord16": Int8.int -> word;
+ val fromInt16Unsafe = _prim "WordS16_toWord16": Int16.int -> word;
+ val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> word;
+ val fromInt64Unsafe = _prim "WordS64_toWord16": Int64.int -> word;
+ val fromIntEqUnsafe = fromInt16Unsafe
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord16": Int8.int -> word;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord16": Int16.int -> word;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord16": Int32.int -> word;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord16": Int64.int -> word;
+ val fromIntZEqUnsafe = fromIntZ16Unsafe
+
+ val fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> word;
+ val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> word;
+ val fromWord32Unsafe = _prim "WordU32_toWord16": Word32.word -> word;
+ val fromWord64Unsafe = _prim "WordU64_toWord16": Word64.word -> word;
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord16": Word8.word -> word;
+ val fromWordX16Unsafe = _prim "WordS16_toWord16": Word16.word -> word;
+ val fromWordX32Unsafe = _prim "WordS32_toWord16": Word32.word -> word;
+ val fromWordX64Unsafe = _prim "WordS64_toWord16": Word64.word -> word;
+
+ val toInt8Unsafe = _prim "WordU16_toWord8": word -> Int8.int;
+ val toInt16Unsafe = _prim "WordU16_toWord16": word -> Int16.int;
+ val toInt32Unsafe = _prim "WordU16_toWord32": word -> Int32.int;
+ val toInt64Unsafe = _prim "WordU16_toWord64": word -> Int64.int;
+ val toIntEqUnsafe = toInt16Unsafe
+
+ val toIntX8Unsafe = _prim "WordS16_toWord8": word -> Int8.int;
+ val toIntX16Unsafe = _prim "WordS16_toWord16": word -> Int16.int;
+ val toIntX32Unsafe = _prim "WordS16_toWord32": word -> Int32.int;
+ val toIntX64Unsafe = _prim "WordS16_toWord64": word -> Int64.int;
+ val toIntXEqUnsafe = toIntX16Unsafe
+
+ val toWord8Unsafe = _prim "WordU16_toWord8": word -> Word8.word;
+ val toWord16Unsafe = _prim "WordU16_toWord16": word -> Word16.word;
+ val toWord32Unsafe = _prim "WordU16_toWord32": word -> Word32.word;
+ val toWord64Unsafe = _prim "WordU16_toWord64": word -> Word64.word;
+
+ val toWordX8Unsafe = _prim "WordS16_toWord8": word -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS16_toWord16": word -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS16_toWord32": word -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS16_toWord64": word -> Word64.word;
+ end
+structure Word16 : PRIM_WORD =
+ struct
+ open Word16
+ local
+ structure S = IntegralComparisons(Word16)
+ in
+ open S
+ end
+ end
+structure Word17 =
+ struct
+ open Word17
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
+ val toBig = _prim "WordU17_toWord32": word -> big;
+ val wordSize' : Int32.int = 17
+ end
+structure Word18 =
+ struct
+ open Word18
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
+ val toBig = _prim "WordU18_toWord32": word -> big;
+ val wordSize' : Int32.int = 18
+ end
+structure Word19 =
+ struct
+ open Word19
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
+ val toBig = _prim "WordU19_toWord32": word -> big;
+ val wordSize' : Int32.int = 19
+ end
+structure Word20 =
+ struct
+ open Word20
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
+ val toBig = _prim "WordU20_toWord32": word -> big;
+ val wordSize' : Int32.int = 20
+ end
+structure Word21 =
+ struct
+ open Word21
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
+ val toBig = _prim "WordU21_toWord32": word -> big;
+ val wordSize' : Int32.int = 21
+ end
+structure Word22 =
+ struct
+ open Word22
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
+ val toBig = _prim "WordU22_toWord32": word -> big;
+ val wordSize' : Int32.int = 22
+ end
+structure Word23 =
+ struct
+ open Word23
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
+ val toBig = _prim "WordU23_toWord32": word -> big;
+ val wordSize' : Int32.int = 23
+ end
+structure Word24 =
+ struct
+ open Word24
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
+ val toBig = _prim "WordU24_toWord32": word -> big;
+ val wordSize' : Int32.int = 24
+ end
+structure Word25 =
+ struct
+ open Word25
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
+ val toBig = _prim "WordU25_toWord32": word -> big;
+ val wordSize' : Int32.int = 25
+ end
+structure Word26 =
+ struct
+ open Word26
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
+ val toBig = _prim "WordU26_toWord32": word -> big;
+ val wordSize' : Int32.int = 26
+ end
+structure Word27 =
+ struct
+ open Word27
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
+ val toBig = _prim "WordU27_toWord32": word -> big;
+ val wordSize' : Int32.int = 27
+ end
+structure Word28 =
+ struct
+ open Word28
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
+ val toBig = _prim "WordU28_toWord32": word -> big;
+ val wordSize' : Int32.int = 28
+ end
+structure Word29 =
+ struct
+ open Word29
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
+ val toBig = _prim "WordU29_toWord32": word -> big;
+ val wordSize' : Int32.int = 29
+ end
+structure Word30 =
+ struct
+ open Word30
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
+ val toBig = _prim "WordU30_toWord32": word -> big;
+ val wordSize' : Int32.int = 30
+ end
+structure Word31 =
+ struct
+ open Word31
+ type big = Word32.word
+ val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
+ val toBig = _prim "WordU31_toWord32": word -> big;
+ val wordSize' : Int32.int = 31
+ end
+structure Word32 =
+ struct
+ open Word32
+
+ val wordSize' : Int32.int = 32
+
+ val + = _prim "Word32_add": word * word -> word;
+ val andb = _prim "Word32_andb": word * word -> word;
+ val <<? = _prim "Word32_lshift": word * Word32.word -> word;
+ val * = _prim "WordU32_mul": word * word -> word;
+ val ~ = _prim "Word32_neg": word -> word;
+ val notb = _prim "Word32_notb": word -> word;
+ val orb = _prim "Word32_orb": word * word -> word;
+ val quotUnsafe = _prim "WordU32_quot": word * word -> word;
+ val remUnsafe = _prim "WordU32_rem": word * word -> word;
+ val rolUnsafe = _prim "Word32_rol": word * Word32.word -> word;
+ val rorUnsafe = _prim "Word32_ror": word * Word32.word -> word;
+ val ~>>? = _prim "WordS32_rshift": word * Word32.word -> word;
+ val >>? = _prim "WordU32_rshift": word * Word32.word -> word;
+ val - = _prim "Word32_sub": word * word -> word;
+ val xorb = _prim "Word32_xorb": word * word -> word;
+
+ val < = _prim "WordU32_lt": word * word -> bool;
+
+ type intEq = Int32.int
+
+ val fromInt8Unsafe = _prim "WordS8_toWord32": Int8.int -> word;
+ val fromInt16Unsafe = _prim "WordS16_toWord32": Int16.int -> word;
+ val fromInt32Unsafe = _prim "WordS32_toWord32": Int32.int -> word;
+ val fromInt64Unsafe = _prim "WordS64_toWord32": Int64.int -> word;
+ val fromIntEqUnsafe = fromInt32Unsafe
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord32": Int8.int -> word;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord32": Int16.int -> word;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord32": Int32.int -> word;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord32": Int64.int -> word;
+ val fromIntZEqUnsafe = fromIntZ32Unsafe
+
+ val fromWord8Unsafe = _prim "WordU8_toWord32": Word8.word -> word;
+ val fromWord16Unsafe = _prim "WordU16_toWord32": Word16.word -> word;
+ val fromWord32Unsafe = _prim "WordU32_toWord32": Word32.word -> word;
+ val fromWord64Unsafe = _prim "WordU64_toWord32": Word64.word -> word;
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord32": Word8.word -> word;
+ val fromWordX16Unsafe = _prim "WordS16_toWord32": Word16.word -> word;
+ val fromWordX32Unsafe = _prim "WordS32_toWord32": Word32.word -> word;
+ val fromWordX64Unsafe = _prim "WordS64_toWord32": Word64.word -> word;
+
+ val toInt8Unsafe = _prim "WordU32_toWord8": word -> Int8.int;
+ val toInt16Unsafe = _prim "WordU32_toWord16": word -> Int16.int;
+ val toInt32Unsafe = _prim "WordU32_toWord32": word -> Int32.int;
+ val toInt64Unsafe = _prim "WordU32_toWord64": word -> Int64.int;
+ val toIntEqUnsafe = toInt32Unsafe
+
+ val toIntX8Unsafe = _prim "WordS32_toWord8": word -> Int8.int;
+ val toIntX16Unsafe = _prim "WordS32_toWord16": word -> Int16.int;
+ val toIntX32Unsafe = _prim "WordS32_toWord32": word -> Int32.int;
+ val toIntX64Unsafe = _prim "WordS32_toWord64": word -> Int64.int;
+ val toIntXEqUnsafe = toIntX32Unsafe
+
+ val toWord8Unsafe = _prim "WordU32_toWord8": word -> Word8.word;
+ val toWord16Unsafe = _prim "WordU32_toWord16": word -> Word16.word;
+ val toWord32Unsafe = _prim "WordU32_toWord32": word -> Word32.word;
+ val toWord64Unsafe = _prim "WordU32_toWord64": word -> Word64.word;
+
+ val toWordX8Unsafe = _prim "WordS32_toWord8": word -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS32_toWord16": word -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS32_toWord32": word -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS32_toWord64": word -> Word64.word;
+ end
+structure Word32 : PRIM_WORD =
+ struct
+ open Word32
+ local
+ structure S = IntegralComparisons(Word32)
+ in
+ open S
+ end
+ end
+structure Word64 =
+ struct
+ open Word64
+
+ val wordSize' : Int32.int = 64
+
+ val + = _prim "Word64_add": word * word -> word;
+ val andb = _prim "Word64_andb": word * word -> word;
+ val <<? = _prim "Word64_lshift": word * Word32.word -> word;
+ val * = _prim "WordU64_mul": word * word -> word;
+ val ~ = _prim "Word64_neg": word -> word;
+ val notb = _prim "Word64_notb": word -> word;
+ val orb = _prim "Word64_orb": word * word -> word;
+ val quotUnsafe = _prim "WordU64_quot": word * word -> word;
+ val remUnsafe = _prim "WordU64_rem": word * word -> word;
+ val rolUnsafe = _prim "Word64_rol": word * Word32.word -> word;
+ val rorUnsafe = _prim "Word64_ror": word * Word32.word -> word;
+ val ~>>? = _prim "WordS64_rshift": word * Word32.word -> word;
+ val >>? = _prim "WordU64_rshift": word * Word32.word -> word;
+ val - = _prim "Word64_sub": word * word -> word;
+ val xorb = _prim "Word64_xorb": word * word -> word;
+
+ val < = _prim "WordU64_lt": word * word -> bool;
+
+ type intEq = Int64.int
+
+ val fromInt8Unsafe = _prim "WordS8_toWord64": Int8.int -> word;
+ val fromInt16Unsafe = _prim "WordS16_toWord64": Int16.int -> word;
+ val fromInt32Unsafe = _prim "WordS32_toWord64": Int32.int -> word;
+ val fromInt64Unsafe = _prim "WordS64_toWord64": Int64.int -> word;
+ val fromIntEqUnsafe = fromInt64Unsafe
+
+ val fromIntZ8Unsafe = _prim "WordU8_toWord64": Int8.int -> word;
+ val fromIntZ16Unsafe = _prim "WordU16_toWord64": Int16.int -> word;
+ val fromIntZ32Unsafe = _prim "WordU32_toWord64": Int32.int -> word;
+ val fromIntZ64Unsafe = _prim "WordU64_toWord64": Int64.int -> word;
+ val fromIntZEqUnsafe = fromIntZ64Unsafe
+
+ val fromWord8Unsafe = _prim "WordU8_toWord64": Word8.word -> word;
+ val fromWord16Unsafe = _prim "WordU16_toWord64": Word16.word -> word;
+ val fromWord32Unsafe = _prim "WordU32_toWord64": Word32.word -> word;
+ val fromWord64Unsafe = _prim "WordU64_toWord64": Word64.word -> word;
+
+ val fromWordX8Unsafe = _prim "WordS8_toWord64": Word8.word -> word;
+ val fromWordX16Unsafe = _prim "WordS16_toWord64": Word16.word -> word;
+ val fromWordX32Unsafe = _prim "WordS32_toWord64": Word32.word -> word;
+ val fromWordX64Unsafe = _prim "WordS64_toWord64": Word64.word -> word;
+
+ val toInt8Unsafe = _prim "WordU64_toWord8": word -> Int8.int;
+ val toInt16Unsafe = _prim "WordU64_toWord16": word -> Int16.int;
+ val toInt32Unsafe = _prim "WordU64_toWord32": word -> Int32.int;
+ val toInt64Unsafe = _prim "WordU64_toWord64": word -> Int64.int;
+ val toIntEqUnsafe = toInt64Unsafe
+
+ val toIntX8Unsafe = _prim "WordS64_toWord8": word -> Int8.int;
+ val toIntX16Unsafe = _prim "WordS64_toWord16": word -> Int16.int;
+ val toIntX32Unsafe = _prim "WordS64_toWord32": word -> Int32.int;
+ val toIntX64Unsafe = _prim "WordS64_toWord64": word -> Int64.int;
+ val toIntXEqUnsafe = toIntX64Unsafe
+
+ val toWord8Unsafe = _prim "WordU64_toWord8": word -> Word8.word;
+ val toWord16Unsafe = _prim "WordU64_toWord16": word -> Word16.word;
+ val toWord32Unsafe = _prim "WordU64_toWord32": word -> Word32.word;
+ val toWord64Unsafe = _prim "WordU64_toWord64": word -> Word64.word;
+
+ val toWordX8Unsafe = _prim "WordS64_toWord8": word -> Word8.word;
+ val toWordX16Unsafe = _prim "WordS64_toWord16": word -> Word16.word;
+ val toWordX32Unsafe = _prim "WordS64_toWord32": word -> Word32.word;
+ val toWordX64Unsafe = _prim "WordS64_toWord64": word -> Word64.word;
+ end
+structure Word64 : PRIM_WORD =
+ struct
+ open Word64
+ local
+ structure S = IntegralComparisons(Word64)
+ in
+ open S
+ end
+ end
+
+end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,99 @@
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(* Primitive names are special -- see atoms/prim.fun. *)
+
+structure Primitive = struct
+
+open Primitive
+
+structure GetSet =
+ struct
+ type 'a t = (unit -> 'a) * ('a -> unit)
+ end
+
+structure PreThread :> sig type t end = struct type t = Thread.t end
+structure Thread :> sig type t end = struct type t = Thread.t end
+
+(**************************************************************************)
+
+structure Bool =
+ struct
+ open Bool
+ fun not b = if b then false else true
+ end
+
+structure Controls =
+ struct
+ val debug = _command_line_const "MLton.debug": bool = false;
+ val detectOverflow = _command_line_const "MLton.detectOverflow": bool = true;
+ val safe = _command_line_const "MLton.safe": bool = true;
+ end
+
+structure Exn =
+ struct
+ open Exn
+
+ val name = _prim "Exn_name": exn -> String8.string;
+
+ exception Div
+ exception Fail8 of String8.string
+ (* exception Fail = Fail8 *)
+ exception Fail16 of String16.string
+ exception Fail32 of String32.string
+ exception Overflow
+ exception Size
+ exception Subscript
+
+ val wrapOverflow: ('a -> 'b) -> ('a -> 'b) =
+ fn f => fn a => f a handle PrimOverflow => raise Overflow
+ end
+
+structure Order =
+ struct
+ datatype t = LESS | EQUAL | GREATER
+ datatype order = datatype t
+ end
+
+structure Option =
+ struct
+ datatype 'a t = NONE | SOME of 'a
+ datatype option = datatype t
+ end
+
+structure Ref =
+ struct
+ open Ref
+ val deref = _prim "Ref_deref": 'a ref -> 'a;
+ val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
+ end
+
+structure TopLevel =
+ struct
+ val setHandler = _prim "TopLevel_setHandler": (exn -> unit) -> unit;
+ val setSuffix = _prim "TopLevel_setSuffix": (unit -> unit) -> unit;
+ end
+
+end
+
+val not = Primitive.Bool.not
+
+exception Bind = Primitive.Exn.Bind
+exception Div = Primitive.Exn.Div
+(* exception Fail = Primitive.Exn.Fail *)
+exception Match = Primitive.Exn.Match
+exception Overflow = Primitive.Exn.Overflow
+exception Size = Primitive.Exn.Size
+exception Subscript = Primitive.Exn.Subscript
+
+datatype option = datatype Primitive.Option.option
+datatype order = datatype Primitive.Order.order
+
+infix 4 = <>
+val op = = _prim "MLton_equal": ''a * ''a -> bool;
+val op <> = fn (x, y) => not (x = y)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,59 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+structure Primitive =
+ struct
+ open Primitive
+
+ val dontInline: (unit -> 'a) -> 'a =
+ fn f =>
+ let
+ val rec recur: Int32.int -> 'a =
+ fn i =>
+ if i = 0
+ then f ()
+ else let
+ val _ = recur (Int32.- (i, 1))
+ in
+ recur (Int32.- (i, 2))
+ end
+ in
+ recur 0
+ end
+ end
+
+(* Install an emergency exception handler. *)
+local
+ structure P = Primitive
+ structure PFFI = PrimitiveFFI
+ val _ =
+ P.TopLevel.setHandler
+ (fn exn =>
+ (PFFI.Stdio.print "unhandled exception: "
+ ; case exn of
+ P.Exn.Fail8 msg => (PFFI.Stdio.print "Fail "
+ ; PFFI.Stdio.print msg)
+ | _ => PFFI.Stdio.print (P.Exn.name exn)
+ ; PFFI.Stdio.print "\n"
+ ; P.MLton.bug (P.NullString8.fromString
+ "unhandled exception in Basis Library\000")))
+in
+end
+
+(* Install an emergency suffix. *)
+local
+ structure P = Primitive
+ structure PFFI = PrimitiveFFI
+ val _ =
+ P.TopLevel.setSuffix
+ (fn () =>
+ (P.MLton.halt 0
+ ; P.MLton.bug (P.NullString8.fromString
+ "missing suffix in Basis Library\000")))
+in
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-02-05 15:30:17 UTC (rev 4348)
@@ -9,7 +9,6 @@
"allowConstant true"
"allowFFI true"
"allowPrim true"
- "allowRebindEquals true"
"deadCode true"
"nonexhaustiveMatch warn"
"redundantMatch warn"
@@ -17,12 +16,28 @@
"warnUnused false"
in
prim-basis.mlb
- ann "forceUsed" in
+ ann "allowRebindEquals true" in
+ prim1.sml
+ end
+ local
+ ../util/integral-comparisons.sml
+ in
+ prim-char.sml
+ prim-word.sml
+ prim-int.sml
+ end
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
../config/choose.sml
- ../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
- end
- primitive.sml
- ann "forceUsed" in
- basis-ffi.sml
- end
+ end end
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
+ ../config/c/misc/$(CTYPES)
+ ../config/objptr/$(OBJPTR_REP)
+ ../config/seq/$(SEQ_INDEX)
+ end end
+ prim-intinf.sml
+ prim-seq.sml
+ prim-nullstring.sml
+ prim-mlton.sml
+ basis-ffi.sml
+ prim2.sml
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -8,10 +8,6 @@
(* Primitive names are special -- see atoms/prim.fun. *)
-infix 4 = (* <> > >= < <= *)
-
-val op = = fn z => _prim "MLton_equal": ''a * ''a -> bool; z
-
structure Char = Char8
type char = Char.char
structure Int = Int32
@@ -22,830 +18,13 @@
structure String = String8
type string = String.string
-structure PreThread :> sig type t end = struct type t = Thread.t end
-structure Thread :> sig type t end = struct type t = Thread.t end
-
structure Word = Word32
type word = Word.word
structure LargeWord = Word64
-(* NullString is used for strings that must be passed to C and hence must be
- * null terminated. After the Primitive structure is defined,
- * NullString.fromString is replaced by a version that checks that the string
- * is indeed null terminated. See the bottom of this file.
- *)
-structure NullString :>
- sig
- type t
-
- val fromString: string -> t
- end =
- struct
- type t = string
-
- val fromString = fn s => s
- end
-
-structure GetSet =
- struct
- type 'a t = (unit -> 'a) * ('a -> unit)
- end
-
-structure Pid : sig
- eqtype t
-
- val fromInt: int -> t
- val toInt: t -> int
- end =
- struct
- type t = int
-
- val fromInt = fn i => i
- val toInt = fn i => i
- val _ = fromInt
- end
-
-exception Bind = Exn.Bind
-exception Fail of string
-exception Match = Exn.Match
-exception PrimOverflow = Exn.PrimOverflow
-exception Overflow
-exception Size
-
-val wrapOverflow: ('a -> 'b) -> ('a -> 'b) =
- fn f => fn a => f a handle PrimOverflow => raise Overflow
-
-datatype 'a option = NONE | SOME of 'a
-
-fun not b = if b then false else true
-
-functor Comparisons (type t
- val < : t * t -> bool) =
- struct
- fun <= (a, b) = not (< (b, a))
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
-functor RealComparisons (type t
- val < : t * t -> bool
- val <= : t * t -> bool) =
- struct
- fun > (a, b) = < (b, a)
- fun >= (a, b) = <= (b, a)
- end
-
structure Primitive =
struct
- val bug = _import "MLton_bug": NullString.t -> unit;
- val debug = _command_line_const "MLton.debug": bool = false;
- val detectOverflow =
- _command_line_const "MLton.detectOverflow": bool = true;
- val eq = _prim "MLton_eq": 'a * 'a -> bool;
- val installSignalHandler =
- _prim "MLton_installSignalHandler": unit -> unit;
- val safe = _command_line_const "MLton.safe": bool = true;
- val touch = _prim "MLton_touch": 'a -> unit;
- val usesCallcc: bool ref = ref false;
- structure Stdio =
- struct
- val print = _import "Stdio_print": string -> unit;
- end
-
- structure Array =
- struct
- val array0Const = _prim "Array_array0Const": unit -> 'a array;
- val length = _prim "Array_length": 'a array -> int;
- (* There is no maximum length on arrays, so maxLen = maxInt. *)
- val maxLen: int = 0x7FFFFFFF
- val sub = _prim "Array_sub": 'a array * int -> 'a;
- val update = _prim "Array_update": 'a array * int * 'a -> unit;
- end
-
- structure CString =
- struct
- type t = Pointer.t
- end
-
- structure GCState =
- struct
- type t = Pointer.t
-
- val gcState = #1 _symbol "gcStateAddress": t GetSet.t; ()
- end
-
- structure CallStack =
- struct
- (* The most recent caller is at index 0 in the array. *)
- datatype t = T of int array
-
- val callStack =
- _import "GC_callStack": GCState.t * int array -> unit;
- val frameIndexSourceSeq =
- _import "GC_frameIndexSourceSeq": GCState.t * int -> Pointer.t;
- val keep = _command_line_const "CallStack.keep": bool = false;
- val numStackFrames =
- _import "GC_numStackFrames": GCState.t -> int;
- val sourceName = _import "GC_sourceName": GCState.t * int -> CString.t;
- end
-
- structure Char =
- struct
- open Char
-
- val op < = _prim "WordU8_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord8": int -> char;
- val ord = _prim "WordU8_toWord32": char -> int;
- val toInt8 = _prim "WordS8_toWord8": char -> Int8.int;
- val fromInt8 = _prim "WordS8_toWord8": Int8.int -> char;
- val toWord8 = _prim "WordU8_toWord8": char -> Word8.word;
- val fromWord8 = _prim "WordU8_toWord8": Word8.word -> char;
- end
-
- structure Char =
- struct
- open Char
- local
- structure S = Comparisons (Char)
- in
- open S
- end
- end
-
- structure Char2 =
- struct
- open Char16
-
- val op < = _prim "WordU16_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord16": int -> char;
- val ord = _prim "WordU16_toWord32": char -> int;
- val toInt16 = _prim "WordS16_toWord16": char -> Int16.int;
- val fromInt16 = _prim "WordS16_toWord16": Int16.int -> char;
- (* val toWord16 = _prim "WordU16_toWord16": char -> Word16.word; *)
- (* val fromWord16 = _prim "WordU16_toWord16": Word16.word -> char; *)
- end
-
- structure Char4 =
- struct
- open Char32
-
- val op < = _prim "WordU32_lt": char * char -> bool;
- val chr = _prim "WordS32_toWord32": int -> char;
- val ord = _prim "WordU32_toWord32": char -> int;
- val toInt32 = _prim "WordS32_toWord32": char -> Int32.int;
- val fromInt32 = _prim "WordS32_toWord32": Int32.int -> char;
- (* val toWord32 = _prim "WordU32_toWord32": char -> Word32.word; *)
- (* val fromWord32 = _prim "WordU32_toWord32": Word32.word -> char; *)
- end
-
- structure Exn =
- struct
- (* The polymorphism with extra and setInitExtra is because primitives
- * are only supposed to deal with basic types. The polymorphism
- * allows the various passes like monomorphisation to translate
- * the types appropriately.
- *)
- type extra = CallStack.t option
-
- val extra = _prim "Exn_extra": exn -> 'a;
- val extra: exn -> extra = extra
- val name = _prim "Exn_name": exn -> string;
- val keepHistory =
- _command_line_const "Exn.keepHistory": bool = false;
- val setExtendExtra = _prim "Exn_setExtendExtra": ('a -> 'a) -> unit;
- val setExtendExtra: (extra -> extra) -> unit = setExtendExtra
- val setInitExtra = _prim "Exn_setInitExtra": 'a -> unit;
- val setInitExtra: extra -> unit = setInitExtra
- end
-
- structure FFI =
- struct
- val getOp = #1 _symbol "MLton_FFI_op": int GetSet.t;
- val int8Array = #1 _symbol "MLton_FFI_Int8": Pointer.t GetSet.t; ()
- val int16Array = #1 _symbol "MLton_FFI_Int16": Pointer.t GetSet.t; ()
- val int32Array = #1 _symbol "MLton_FFI_Int32": Pointer.t GetSet.t; ()
- val int64Array = #1 _symbol "MLton_FFI_Int64": Pointer.t GetSet.t; ()
- val numExports = _build_const "MLton_FFI_numExports": int;
- val pointerArray = #1 _symbol "MLton_FFI_Pointer": Pointer.t GetSet.t; ()
- val real32Array = #1 _symbol "MLton_FFI_Real32": Pointer.t GetSet.t; ()
- val real64Array = #1 _symbol "MLton_FFI_Real64": Pointer.t GetSet.t; ()
- val word8Array = #1 _symbol "MLton_FFI_Word8": Pointer.t GetSet.t; ()
- val word16Array = #1 _symbol "MLton_FFI_Word16": Pointer.t GetSet.t; ()
- val word32Array = #1 _symbol "MLton_FFI_Word32": Pointer.t GetSet.t; ()
- val word64Array = #1 _symbol "MLton_FFI_Word64": Pointer.t GetSet.t; ()
- end
-
- structure GC =
- struct
- val collect = _prim "GC_collect": unit -> unit;
- val pack = _import "GC_pack": GCState.t -> unit;
- val setHashConsDuringGC =
- _import "GC_setHashConsDuringGC": GCState.t * bool -> unit;
- val setMessages =
- _import "GC_setMessages": GCState.t * bool -> unit;
- val setRusageMeasureGC =
- _import "GC_setRusageMeasureGC": GCState.t * bool -> unit;
- val setSummary =
- _import "GC_setSummary": GCState.t * bool -> unit;
- val unpack =
- _import "GC_unpack": GCState.t -> unit;
- end
-
- structure Int1 =
- struct
- open Int1
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord1": big -> int;
- val precision' = 1
- val toBig = _prim "WordU1_toWord8": int -> big;
- end
- structure Int2 =
- struct
- open Int2
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord2": big -> int;
- val precision' = 2
- val toBig = _prim "WordU2_toWord8": int -> big;
- end
- structure Int3 =
- struct
- open Int3
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord3": big -> int;
- val precision' = 3
- val toBig = _prim "WordU3_toWord8": int -> big;
- end
- structure Int4 =
- struct
- open Int4
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord4": big -> int;
- val precision' = 4
- val toBig = _prim "WordU4_toWord8": int -> big;
- end
- structure Int5 =
- struct
- open Int5
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord5": big -> int;
- val precision' = 5
- val toBig = _prim "WordU5_toWord8": int -> big;
- end
- structure Int6 =
- struct
- open Int6
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord6": big -> int;
- val precision' = 6
- val toBig = _prim "WordU6_toWord8": int -> big;
- end
- structure Int7 =
- struct
- open Int7
- type big = Int8.int
- val fromBigUnsafe = _prim "WordU8_toWord7": big -> int;
- val precision' = 7
- val toBig = _prim "WordU7_toWord8": int -> big;
- end
- structure Int8 =
- struct
- type t = Int8.int
- type int = t
-
- val precision' : Int.int = 8
- val maxInt' : int = 0x7f
- val minInt' : int = ~0x80
-
- val *? = _prim "WordS8_mul": int * int -> int;
- val * =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_mulCheck": int * int -> int;)
- else *?
- val +? = _prim "Word8_add": int * int -> int;
- val + =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_addCheck": int * int -> int;)
- else +?
- val -? = _prim "Word8_sub": int * int -> int;
- val - =
- if detectOverflow
- then wrapOverflow (_prim "WordS8_subCheck": int * int -> int;)
- else -?
- val op < = _prim "WordS8_lt": int * int -> bool;
- val quot = _prim "WordS8_quot": int * int -> int;
- val rem = _prim "WordS8_rem": int * int -> int;
- val << = _prim "Word8_lshift": int * Word.word -> int;
- val >> = _prim "WordU8_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS8_rshift": int * Word.word -> int;
- val ~? = _prim "Word8_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word8_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word8_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord8": Int.int -> int;
- val toInt = _prim "WordS8_toWord32": int -> Int.int;
- end
- structure Int8 =
- struct
- open Int8
- local
- structure S = Comparisons (Int8)
- in
- open S
- end
- end
- structure Int9 =
- struct
- open Int9
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord9": big -> int;
- val precision' = 9
- val toBig = _prim "WordU9_toWord16": int -> big;
- end
- structure Int10 =
- struct
- open Int10
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord10": big -> int;
- val precision' = 10
- val toBig = _prim "WordU10_toWord16": int -> big;
- end
- structure Int11 =
- struct
- open Int11
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord11": big -> int;
- val precision' = 11
- val toBig = _prim "WordU11_toWord16": int -> big;
- end
- structure Int12 =
- struct
- open Int12
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord12": big -> int;
- val precision' = 12
- val toBig = _prim "WordU12_toWord16": int -> big;
- end
- structure Int13 =
- struct
- open Int13
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord13": big -> int;
- val precision' = 13
- val toBig = _prim "WordU13_toWord16": int -> big;
- end
- structure Int14 =
- struct
- open Int14
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord14": big -> int;
- val precision' = 14
- val toBig = _prim "WordU14_toWord16": int -> big;
- end
- structure Int15 =
- struct
- open Int15
- type big = Int16.int
- val fromBigUnsafe = _prim "WordU16_toWord15": big -> int;
- val precision' = 15
- val toBig = _prim "WordU15_toWord16": int -> big;
- end
- structure Int16 =
- struct
- type t = Int16.int
- type int = t
-
- val precision' : Int.int = 16
- val maxInt' : int = 0x7fff
- val minInt' : int = ~0x8000
-
- val *? = _prim "WordS16_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word16_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word16_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS16_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS16_lt": int * int -> bool;
- val quot = _prim "WordS16_quot": int * int -> int;
- val rem = _prim "WordS16_rem": int * int -> int;
- val << = _prim "Word16_lshift": int * Word.word -> int;
- val >> = _prim "WordU16_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS16_rshift": int * Word.word -> int;
- val ~? = _prim "Word16_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word16_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word16_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord16": Int.int -> int;
- val toInt = _prim "WordS16_toWord32": int -> Int.int;
- end
- structure Int16 =
- struct
- open Int16
- local
- structure S = Comparisons (Int16)
- in
- open S
- end
- end
- structure Int17 =
- struct
- open Int17
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord17": big -> int;
- val precision' = 17
- val toBig = _prim "WordU17_toWord32": int -> big;
- end
- structure Int18 =
- struct
- open Int18
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord18": big -> int;
- val precision' = 18
- val toBig = _prim "WordU18_toWord32": int -> big;
- end
- structure Int19 =
- struct
- open Int19
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord19": big -> int;
- val precision' = 19
- val toBig = _prim "WordU19_toWord32": int -> big;
- end
- structure Int20 =
- struct
- open Int20
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord20": big -> int;
- val precision' = 20
- val toBig = _prim "WordU20_toWord32": int -> big;
- end
- structure Int21 =
- struct
- open Int21
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord21": big -> int;
- val precision' = 21
- val toBig = _prim "WordU21_toWord32": int -> big;
- end
- structure Int22 =
- struct
- open Int22
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord22": big -> int;
- val precision' = 22
- val toBig = _prim "WordU22_toWord32": int -> big;
- end
- structure Int23 =
- struct
- open Int23
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord23": big -> int;
- val precision' = 23
- val toBig = _prim "WordU23_toWord32": int -> big;
- end
- structure Int24 =
- struct
- open Int24
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord24": big -> int;
- val precision' = 24
- val toBig = _prim "WordU24_toWord32": int -> big;
- end
- structure Int25 =
- struct
- open Int25
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord25": big -> int;
- val precision' = 25
- val toBig = _prim "WordU25_toWord32": int -> big;
- end
- structure Int26 =
- struct
- open Int26
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord26": big -> int;
- val precision' = 26
- val toBig = _prim "WordU26_toWord32": int -> big;
- end
- structure Int27 =
- struct
- open Int27
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord27": big -> int;
- val precision' = 27
- val toBig = _prim "WordU27_toWord32": int -> big;
- end
- structure Int28 =
- struct
- open Int28
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord28": big -> int;
- val precision' = 28
- val toBig = _prim "WordU28_toWord32": int -> big;
- end
- structure Int29 =
- struct
- open Int29
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord29": big -> int;
- val precision' = 29
- val toBig = _prim "WordU29_toWord32": int -> big;
- end
- structure Int30 =
- struct
- open Int30
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord30": big -> int;
- val precision' = 30
- val toBig = _prim "WordU30_toWord32": int -> big;
- end
- structure Int31 =
- struct
- open Int31
- type big = Int32.int
- val fromBigUnsafe = _prim "WordU32_toWord31": big -> int;
- val precision' = 31
- val toBig = _prim "WordU31_toWord32": int -> big;
- end
- structure Int32 =
- struct
- type t = Int32.int
- type int = t
-
- val precision' : Int.int = 32
- val maxInt' : int = 0x7fffffff
- val minInt' : int = ~0x80000000
-
- val *? = _prim "WordS32_mul": int * int -> int;
- val * =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_mulCheck": int * int -> int;))
- else *?
- val +? = _prim "Word32_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word32_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS32_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS32_lt": int * int -> bool;
- val quot = _prim "WordS32_quot": int * int -> int;
- val rem = _prim "WordS32_rem": int * int -> int;
- val << = _prim "Word32_lshift": int * Word.word -> int;
- val >> = _prim "WordU32_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS32_rshift": int * Word.word -> int;
- val ~? = _prim "Word32_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word32_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word32_andb": int * int -> int;
- val fromInt : int -> int = fn x => x
- val toInt : int -> int = fn x => x
- end
- structure Int32 =
- struct
- open Int32
- local
- structure S = Comparisons (Int32)
- in
- open S
- end
- end
- structure Int = Int32
- structure Int64 =
- struct
- type t = Int64.int
- type int = t
-
- val precision' : Int.int = 64
- val maxInt' : int = 0x7FFFFFFFFFFFFFFF
- val minInt' : int = ~0x8000000000000000
-
- val *? = _prim "WordS64_mul": int * int -> int;
- val * = fn _ => raise Fail "Int64.* unimplemented"
-(*
- val * =
- if detectOverflow
- then _prim "WordS64_mulCheck": int * int -> int;
- else *?
-*)
- val +? = _prim "Word64_add": int * int -> int;
- val + =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_addCheck": int * int -> int;))
- else +?
- val -? = _prim "Word64_sub": int * int -> int;
- val - =
- if detectOverflow
- then (wrapOverflow
- (_prim "WordS64_subCheck": int * int -> int;))
- else -?
- val op < = _prim "WordS64_lt": int * int -> bool;
- val << = _prim "Word64_lshift": int * Word.word -> int;
- val >> = _prim "WordU64_rshift": int * Word.word -> int;
- val ~>> = _prim "WordS64_rshift": int * Word.word -> int;
- val quot = _prim "WordS64_quot": int * int -> int;
- val rem = _prim "WordS64_rem": int * int -> int;
- val ~? = _prim "Word64_neg": int -> int;
- val ~ =
- if detectOverflow
- then wrapOverflow (_prim "Word64_negCheck": int -> int;)
- else ~?
- val andb = _prim "Word64_andb": int * int -> int;
- val fromInt = _prim "WordS32_toWord64": Int.int -> int;
- val fromWord = _prim "WordU32_toWord64": word -> int;
- val toInt = _prim "WordU64_toWord32": int -> Int.int;
- val toWord = _prim "WordU64_toWord32": int -> word;
- end
- structure Int64 =
- struct
- open Int64
- local
- structure S = Comparisons (Int64)
- in
- open S
- end
- end
-
- structure Array =
- struct
- open Array
-
- val array = _prim "Array_array": int -> 'a array;
- val array =
- fn n => if safe andalso Int.< (n, 0)
- then raise Size
- else array n
- end
-
- structure IntInf =
- struct
- open IntInf
-
- val + = _prim "IntInf_add": int * int * word -> int;
- val andb = _prim "IntInf_andb": int * int * word -> int;
- val ~>> = _prim "IntInf_arshift": int * word * word -> int;
- val compare = _prim "IntInf_compare": int * int -> Int.int;
- val fromVector = _prim "WordVector_toIntInf": word vector -> int;
- val fromWord = _prim "Word_toIntInf": word -> int;
- val gcd = _prim "IntInf_gcd": int * int * word -> int;
- val << = _prim "IntInf_lshift": int * word * word -> int;
- val * = _prim "IntInf_mul": int * int * word -> int;
- val ~ = _prim "IntInf_neg": int * word -> int;
- val notb = _prim "IntInf_notb": int * word -> int;
- val orb = _prim "IntInf_orb": int * int * word -> int;
- val quot = _prim "IntInf_quot": int * int * word -> int;
- val rem = _prim "IntInf_rem": int * int * word -> int;
- val - = _prim "IntInf_sub": int * int * word -> int;
- val toString
- = _prim "IntInf_toString": int * Int.int * word -> string;
- val toVector = _prim "IntInf_toVector": int -> word vector;
- val toWord = _prim "IntInf_toWord": int -> word;
- val xorb = _prim "IntInf_xorb": int * int * word -> int;
- end
-
- structure MLton =
- struct
- structure Codegen =
- struct
- datatype t = Bytecode | C | Native
-
- val codegen =
- case _build_const "MLton_Codegen_codegen": int; of
- 0 => Bytecode
- | 1 => C
- | 2 => Native
- | _ => raise Fail "MLton_Codegen_codegen"
-
- val isBytecode = codegen = Bytecode
- (* val isC = codegen = C *)
- val isNative = codegen = Native
- end
-
- (* val deserialize = _prim "MLton_deserialize": Word8Vector.vector -> 'a ref; *)
- (* val serialize = _prim "MLton_serialize": 'a ref -> Word8Vector.vector; *)
- val share = _prim "MLton_share": 'a -> unit;
- val size = _prim "MLton_size": 'a ref -> int;
-
- structure Platform =
- struct
- structure Arch =
- struct
- datatype t = Alpha | AMD64 | ARM | HPPA | IA64 | m68k |
- MIPS | PowerPC | S390 | Sparc | X86
-
- val host: t =
- case _const "MLton_Platform_Arch_host": string; of
- "alpha" => Alpha
- | "amd64" => AMD64
- | "arm" => ARM
- | "hppa" => HPPA
- | "ia64" => IA64
- | "m68k" => m68k
- | "mips" => MIPS
- | "powerpc" => PowerPC
- | "s390" => S390
- | "sparc" => Sparc
- | "x86" => X86
- | _ => raise Fail "strange MLton_Platform_Arch_host"
-
- val hostIsBigEndian =
- _const "MLton_Platform_Arch_bigendian": bool;
- end
-
- structure OS =
- struct
- datatype t =
- Cygwin
- | Darwin
- | FreeBSD
- | Linux
- | MinGW
- | NetBSD
- | OpenBSD
- | Solaris
-
- val host: t =
- case _const "MLton_Platform_OS_host": string; of
- "cygwin" => Cygwin
- | "darwin" => Darwin
- | "freebsd" => FreeBSD
- | "linux" => Linux
- | "mingw" => MinGW
- | "netbsd" => NetBSD
- | "openbsd" => OpenBSD
- | "solaris" => Solaris
- | _ => raise Fail "strange MLton_Platform_OS_host"
-
- val forkIsEnabled =
- case host of
- Cygwin =>
- #1 _symbol "MLton_Platform_CygwinUseMmap": bool GetSet.t; ()
- | MinGW => false
- | _ => true
-
- val useWindowsProcess = not forkIsEnabled
- end
- end
-
- structure Profile =
- struct
- val isOn = _build_const "MLton_Profile_isOn": bool;
- structure Data =
- struct
- type t = word
-
- val dummy:t = 0w0
- val free =
- _import "GC_profileFree": GCState.t * t -> unit;
- val malloc =
- _import "GC_profileMalloc": GCState.t -> t;
- val write =
- _import "GC_profileWrite"
- : GCState.t * t * word (* fd *) -> unit;
- end
- val done = _import "GC_profileDone": GCState.t -> unit;
- val getCurrent =
- _import "GC_getProfileCurrent": GCState.t -> Data.t;
- val setCurrent =
- _import "GC_setProfileCurrent"
- : GCState.t * Data.t -> unit;
- end
-
- structure Weak =
- struct
- open Weak
-
- val canGet = _prim "Weak_canGet": 'a t -> bool;
- val get = _prim "Weak_get": 'a t -> 'a;
- val new = _prim "Weak_new": 'a -> 'a t;
- end
- end
-
structure PackReal32 =
struct
type real = Real32.real
@@ -872,54 +51,6 @@
_import "PackReal64_updateRev": Word8.word array * int * real -> unit;
end
- structure Pointer =
- struct
- open Pointer
-
- val fromWord = _prim "WordU32_toWord32": word -> t;
- val toWord = _prim "WordU32_toWord32": t -> word;
-
- val null: t = fromWord 0w0
-
- fun isNull p = p = null
-
- (* val + = _prim "Pointer_add": t * t -> t; *)
- (* val op < = _prim "Pointer_lt": t * t -> bool; *)
- (* val - = _prim "Pointer_sub": t * t -> t; *)
-(* val free = _import "free": t -> unit; *)
- val getInt8 = _prim "Pointer_getWord8": t * int -> Int8.int;
- val getInt16 = _prim "Pointer_getWord16": t * int -> Int16.int;
- val getInt32 = _prim "Pointer_getWord32": t * int -> Int32.int;
- val getInt64 = _prim "Pointer_getWord64": t * int -> Int64.int;
- val getPointer = _prim "Pointer_getPointer": t * int -> 'a;
- val getReal32 = _prim "Pointer_getReal32": t * int -> Real32.real;
- val getReal64 = _prim "Pointer_getReal64": t * int -> Real64.real;
- val getWord8 = _prim "Pointer_getWord8": t * int -> Word8.word;
- val getWord16 = _prim "Pointer_getWord16": t * int -> Word16.word;
- val getWord32 = _prim "Pointer_getWord32": t * int -> Word32.word;
- val getWord64 = _prim "Pointer_getWord64": t * int -> Word64.word;
- val setInt8 = _prim "Pointer_setWord8": t * int * Int8.int -> unit;
- val setInt16 =
- _prim "Pointer_setWord16": t * int * Int16.int -> unit;
- val setInt32 =
- _prim "Pointer_setWord32": t * int * Int32.int -> unit;
- val setInt64 =
- _prim "Pointer_setWord64": t * int * Int64.int -> unit;
- val setPointer = _prim "Pointer_setPointer": t * int * 'a -> unit;
- val setReal32 =
- _prim "Pointer_setReal32": t * int * Real32.real -> unit;
- val setReal64 =
- _prim "Pointer_setReal64": t * int * Real64.real -> unit;
- val setWord8 =
- _prim "Pointer_setWord8": t * int * Word8.word -> unit;
- val setWord16 =
- _prim "Pointer_setWord16": t * int * Word16.word -> unit;
- val setWord32 =
- _prim "Pointer_setWord32": t * int * Word32.word -> unit;
- val setWord64 =
- _prim "Pointer_setWord64": t * int * Word64.word -> unit;
- end
-
structure Real64 =
struct
open Real64
@@ -1080,32 +211,7 @@
end
end
- structure Ref =
- struct
- val deref = _prim "Ref_deref": 'a ref -> 'a;
- val assign = _prim "Ref_assign": 'a ref * 'a -> unit;
- end
- structure Status:
- sig
- eqtype t
-
- val failure: t
- val fromInt: int -> t
- val success: t
- val toInt: t -> int
- end =
- struct
- type t = int
-
- val failure = 1
- val fromInt = fn i => i
- val success = 0
- val toInt = fn i => i
- end
-
- val halt = _prim "MLton_halt": Status.t -> unit;
-
structure String =
struct
val fromWord8Vector =
@@ -1118,159 +224,7 @@
struct
val bufSize = _command_line_const "TextIO.bufSize": int = 4096;
end
-
- structure Thread =
- struct
- type preThread = PreThread.t
- type thread = Thread.t
- val atomicBegin = _prim "Thread_atomicBegin": unit -> unit;
- val canHandle = _prim "Thread_canHandle": unit -> int;
- fun atomicEnd () =
- if Int.<= (canHandle (), 0)
- then raise Fail "Thread.atomicEnd with no atomicBegin"
- else _prim "Thread_atomicEnd": unit -> unit; ()
- val copy = _prim "Thread_copy": preThread -> thread;
- (* copyCurrent's result is accesible via savedPre ().
- * It is not possible to have the type of copyCurrent as
- * unit -> preThread, because there are two different ways to
- * return from the call to copyCurrent. One way is the direct
- * obvious way, in the thread that called copyCurrent. That one,
- * of course, wants to call savedPre (). However, another way to
- * return is by making a copy of the preThread and then switching
- * to it. In that case, there is no preThread to return. Making
- * copyCurrent return a preThread creates nasty bugs where the
- * return code from the CCall expects to see a preThread result
- * according to the C return convention, but there isn't one when
- * switching to a copy.
- *)
- val copyCurrent = _prim "Thread_copyCurrent": unit -> unit;
- val current = _import "GC_getCurrentThread": GCState.t -> thread;
- val finishSignalHandler = _import "GC_finishSignalHandler": GCState.t -> unit;
- val returnToC = _prim "Thread_returnToC": unit -> unit;
- val saved = _import "GC_getSavedThread": GCState.t -> thread;
- val savedPre = _import "GC_getSavedThread": GCState.t -> preThread;
- val setCallFromCHandler =
- _import "GC_setCallFromCHandlerThread": GCState.t * thread -> unit;
- val setSignalHandler = _import "GC_setSignalHandlerThread": GCState.t * thread -> unit;
- val setSaved = _import "GC_setSavedThread": GCState.t * thread -> unit;
- val startSignalHandler = _import "GC_startSignalHandler": GCState.t -> unit;
- val switchTo = _prim "Thread_switchTo": thread -> unit;
- end
-
- structure TopLevel =
- struct
- val setHandler =
- _prim "TopLevel_setHandler": (exn -> unit) -> unit;
- val setSuffix =
- _prim "TopLevel_setSuffix": (unit -> unit) -> unit;
- end
-
- structure Vector =
- struct
- val sub = _prim "Vector_sub": 'a vector * int -> 'a;
- val length = _prim "Vector_length": 'a vector -> int;
-
- (* Don't mutate the array after you apply fromArray, because vectors
- * are supposed to be immutable and the optimizer depends on this.
- *)
- val fromArray = _prim "Array_toVector": 'a array -> 'a vector;
- end
-
- structure Word1 =
- struct
- open Word1
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
- val toBig = _prim "WordU1_toWord8": word -> big;
- val wordSize = 1
- end
- structure Word2 =
- struct
- open Word2
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
- val toBig = _prim "WordU2_toWord8": word -> big;
- val wordSize = 2
- end
- structure Word3 =
- struct
- open Word3
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
- val toBig = _prim "WordU3_toWord8": word -> big;
- val wordSize = 3
- end
- structure Word4 =
- struct
- open Word4
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
- val toBig = _prim "WordU4_toWord8": word -> big;
- val wordSize = 4
- end
- structure Word5 =
- struct
- open Word5
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
- val toBig = _prim "WordU5_toWord8": word -> big;
- val wordSize = 5
- end
- structure Word6 =
- struct
- open Word6
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
- val toBig = _prim "WordU6_toWord8": word -> big;
- val wordSize = 6
- end
- structure Word7 =
- struct
- open Word7
- type big = Word8.word
- val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
- val toBig = _prim "WordU7_toWord8": word -> big;
- val wordSize = 7
- end
- structure Word8 =
- struct
- open Word8
-
- val wordSize: int = 8
-
- val + = _prim "Word8_add": word * word -> word;
- val andb = _prim "Word8_andb": word * word -> word;
- val ~>> = _prim "WordS8_rshift": word * Word.word -> word;
- val div = _prim "WordU8_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord8": int -> word;
- val fromLarge = _prim "WordU64_toWord8": LargeWord.word -> word;
- val << = _prim "Word8_lshift": word * Word.word -> word;
- val op < = _prim "WordU8_lt": word * word -> bool;
- val mod = _prim "WordU8_rem": word * word -> word;
- val * = _prim "WordU8_mul": word * word -> word;
- val ~ = _prim "Word8_neg": word -> word;
- val notb = _prim "Word8_notb": word -> word;
- val orb = _prim "Word8_orb": word * word -> word;
- val rol = _prim "Word8_rol": word * Word.word -> word;
- val ror = _prim "Word8_ror": word * Word.word -> word;
- val >> = _prim "WordU8_rshift": word * Word.word -> word;
- val - = _prim "Word8_sub": word * word -> word;
- val toInt = _prim "WordU8_toWord32": word -> int;
- val toIntX = _prim "WordS8_toWord32": word -> int;
- val toLarge = _prim "WordU8_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS8_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word8_xorb": word * word -> word;
- end
- structure Word8 =
- struct
- open Word8
- local
- structure S = Comparisons (Word8)
- in
- open S
- end
- end
structure Word8Array =
struct
val subWord =
@@ -1289,405 +243,11 @@
val subWordRev =
_import "Word8Vector_subWord32Rev": Word8.word vector * int -> word;
end
- structure Word9 =
- struct
- open Word9
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
- val toBig = _prim "WordU9_toWord16": word -> big;
- val wordSize = 9
- end
- structure Word10 =
- struct
- open Word10
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
- val toBig = _prim "WordU10_toWord16": word -> big;
- val wordSize = 10
- end
- structure Word11 =
- struct
- open Word11
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
- val toBig = _prim "WordU11_toWord16": word -> big;
- val wordSize = 11
- end
- structure Word12 =
- struct
- open Word12
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
- val toBig = _prim "WordU12_toWord16": word -> big;
- val wordSize = 12
- end
- structure Word13 =
- struct
- open Word13
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
- val toBig = _prim "WordU13_toWord16": word -> big;
- val wordSize = 13
- end
- structure Word14 =
- struct
- open Word14
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
- val toBig = _prim "WordU14_toWord16": word -> big;
- val wordSize = 14
- end
- structure Word15 =
- struct
- open Word15
- type big = Word16.word
- val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
- val toBig = _prim "WordU15_toWord16": word -> big;
- val wordSize = 15
- end
- structure Word16 =
- struct
- open Word16
-
- val wordSize: int = 16
- val + = _prim "Word16_add": word * word -> word;
- val andb = _prim "Word16_andb": word * word -> word;
- val ~>> = _prim "WordS16_rshift": word * Word.word -> word;
- val div = _prim "WordU16_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord16": int -> word;
- val fromLarge = _prim "WordU64_toWord16": LargeWord.word -> word;
- val << = _prim "Word16_lshift": word * Word.word -> word;
- val op < = _prim "WordU16_lt": word * word -> bool;
- val mod = _prim "WordU16_rem": word * word -> word;
- val * = _prim "WordU16_mul": word * word -> word;
- val ~ = _prim "Word16_neg": word -> word;
- val notb = _prim "Word16_notb": word -> word;
- val orb = _prim "Word16_orb": word * word -> word;
- val >> = _prim "WordU16_rshift": word * Word.word -> word;
- val - = _prim "Word16_sub": word * word -> word;
- val toInt = _prim "WordU16_toWord32": word -> int;
- val toIntX = _prim "WordS16_toWord32": word -> int;
- val toLarge = _prim "WordU16_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS16_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word16_xorb": word * word -> word;
-
- val toInt16 = _prim "WordU16_toWord16": word -> Int16.int;
- val fromInt16 = _prim "WordU16_toWord16": Int16.int -> word;
- end
- structure Word16 =
- struct
- open Word16
- local
- structure S = Comparisons (Word16)
- in
- open S
- end
- end
- structure Word17 =
- struct
- open Word17
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
- val toBig = _prim "WordU17_toWord32": word -> big;
- val wordSize = 17
- end
- structure Word18 =
- struct
- open Word18
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
- val toBig = _prim "WordU18_toWord32": word -> big;
- val wordSize = 18
- end
- structure Word19 =
- struct
- open Word19
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
- val toBig = _prim "WordU19_toWord32": word -> big;
- val wordSize = 19
- end
- structure Word20 =
- struct
- open Word20
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
- val toBig = _prim "WordU20_toWord32": word -> big;
- val wordSize = 20
- end
- structure Word21 =
- struct
- open Word21
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
- val toBig = _prim "WordU21_toWord32": word -> big;
- val wordSize = 21
- end
- structure Word22 =
- struct
- open Word22
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
- val toBig = _prim "WordU22_toWord32": word -> big;
- val wordSize = 22
- end
- structure Word23 =
- struct
- open Word23
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
- val toBig = _prim "WordU23_toWord32": word -> big;
- val wordSize = 23
- end
- structure Word24 =
- struct
- open Word24
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord24": big -> word;
- val toBig = _prim "WordU24_toWord32": word -> big;
- val wordSize = 24
- end
- structure Word25 =
- struct
- open Word25
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord25": big -> word;
- val toBig = _prim "WordU25_toWord32": word -> big;
- val wordSize = 25
- end
- structure Word26 =
- struct
- open Word26
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord26": big -> word;
- val toBig = _prim "WordU26_toWord32": word -> big;
- val wordSize = 26
- end
- structure Word27 =
- struct
- open Word27
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord27": big -> word;
- val toBig = _prim "WordU27_toWord32": word -> big;
- val wordSize = 27
- end
- structure Word28 =
- struct
- open Word28
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord28": big -> word;
- val toBig = _prim "WordU28_toWord32": word -> big;
- val wordSize = 28
- end
- structure Word29 =
- struct
- open Word29
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord29": big -> word;
- val toBig = _prim "WordU29_toWord32": word -> big;
- val wordSize = 29
- end
- structure Word30 =
- struct
- open Word30
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord30": big -> word;
- val toBig = _prim "WordU30_toWord32": word -> big;
- val wordSize = 30
- end
- structure Word31 =
- struct
- open Word31
- type big = Word32.word
- val fromBigUnsafe = _prim "WordU32_toWord31": big -> word;
- val toBig = _prim "WordU31_toWord32": word -> big;
- val wordSize = 31
- end
- structure Word32 =
- struct
- open Word32
-
- val wordSize: int = 32
-
- val + = _prim "Word32_add": word * word -> word;
- val andb = _prim "Word32_andb": word * word -> word;
- val ~>> = _prim "WordS32_rshift": word * word -> word;
- val div = _prim "WordU32_quot": word * word -> word;
- val fromInt = _prim "WordU32_toWord32": int -> word;
- val fromLarge = _prim "WordU64_toWord32": LargeWord.word -> word;
- val << = _prim "Word32_lshift": word * word -> word;
- val op < = _prim "WordU32_lt": word * word -> bool;
- val mod = _prim "WordU32_rem": word * word -> word;
- val * = _prim "WordU32_mul": word * word -> word;
- val ~ = _prim "Word32_neg": word -> word;
- val notb = _prim "Word32_notb": word -> word;
- val orb = _prim "Word32_orb": word * word -> word;
- val rol = _prim "Word32_rol": word * word -> word;
- val ror = _prim "Word32_ror": word * word -> word;
- val >> = _prim "WordU32_rshift": word * word -> word;
- val - = _prim "Word32_sub": word * word -> word;
- val toInt = _prim "WordU32_toWord32": word -> int;
- val toIntX = _prim "WordS32_toWord32": word -> int;
- val toLarge = _prim "WordU32_toWord64": word -> LargeWord.word;
- val toLargeX = _prim "WordS32_toWord64": word -> LargeWord.word;
- val xorb = _prim "Word32_xorb": word * word -> word;
-
- val toInt32 = _prim "WordU32_toWord32": word -> Int32.int;
- val fromInt32 = _prim "WordU32_toWord32": Int32.int -> word;
- end
- structure Word32 =
- struct
- open Word32
- local
- structure S = Comparisons (Word32)
- in
- open S
- end
- end
- structure Word = Word32
- structure Word64 =
- struct
- open Word64
-
- val wordSize: int = 64
-
- val + = _prim "Word64_add": word * word -> word;
- val andb = _prim "Word64_andb": word * word -> word;
- val ~>> = _prim "WordS64_rshift": word * Word.word -> word;
- val div = _prim "WordU64_quot": word * word -> word;
- val fromInt = _prim "WordS32_toWord64": int -> word;
- val fromLarge: LargeWord.word -> word = fn x => x
- val << = _prim "Word64_lshift": word * Word.word -> word;
- val op < = _prim "WordU64_lt": word * word -> bool;
- val mod = _prim "WordU64_rem": word * word -> word;
- val * = _prim "WordU64_mul": word * word -> word;
- val ~ = _prim "Word64_neg": word -> word;
- val notb = _prim "Word64_notb": word -> word;
- val orb = _prim "Word64_orb": word * word -> word;
- val >> = _prim "WordU64_rshift": word * Word.word -> word;
- val - = _prim "Word64_sub": word * word -> word;
- val toInt = _prim "WordU64_toWord32": word -> int;
- val toIntX = _prim "WordU64_toWord32": word -> int;
- val toLarge: word -> LargeWord.word = fn x => x
- val toLargeX: word -> LargeWord.word = fn x => x
- val xorb = _prim "Word64_xorb": word * word -> word;
- end
- structure Word64 =
- struct
- open Word64
- local
- structure S = Comparisons (Word64)
- in
- open S
- end
- end
-
structure Cygwin =
struct
val toFullWindowsPath =
_import "Cygwin_toFullWindowsPath": NullString.t -> CString.t;
end
- structure FileDesc:
- sig
- eqtype t
-
- val fromWord: word -> t
- val fromInt: int -> t
- val toInt: t -> int
- val toWord: t -> word
- end =
- struct
- type t = int
-
- val fromWord = Word32.toInt
- fun fromInt i = i
- fun toInt i = i
- val toWord = Word32.fromInt
- end
-
- structure World =
- struct
- val getAmOriginal = _import "GC_getAmOriginal": GCState.t -> bool;
- val setAmOriginal = _import "GC_setAmOriginal": GCState.t * bool -> unit;
- val save = _prim "World_save": FileDesc.t -> unit;
- end
end
-
-structure Primitive =
- struct
- open Primitive
-
- structure Int32 =
- struct
- open Int32
-
- local
- fun make f (i: int, i': int): bool =
- f (Primitive.Word32.fromInt i, Primitive.Word32.fromInt i')
- in
- val geu = make Primitive.Word32.>=
- val gtu = make Primitive.Word32.>
- end
- end
- structure Int = Int32
- end
-
-structure NullString =
- struct
- open NullString
-
- fun fromString s =
- if #"\000" = let
- open Primitive
- in
- Vector.sub (s, Int.- (Vector.length s, 1))
- end
- then NullString.fromString s
- else raise Fail "NullString.fromString"
-
- val empty = fromString "\000"
- end
-structure NullString8 = NullString
-structure NullString8Array = struct type t = NullString8.t array end
-
-(* Quell unused warnings. *)
-local
- val _ = #"a": Char16.t: Char16.char
- val _ = #"a": Char32.t: Char32.char
- val _ = "a": String16.t: String16.string
- val _ = "a": String32.t: String32.string
- open Primitive
- open Char2
- val _ = op <
- val _ = chr
- val _ = ord
- open Char4
- val _ = op <
- val _ = chr
- val _ = ord
- open Int64
- val _ = <<
- val _ = >>
- val _ = ~>>
- val _ = andb
-in
-end
-
-(* Install an emergency exception handler. *)
-local
- open Primitive
- val _ =
- TopLevel.setHandler
- (fn exn =>
- (Stdio.print "unhandled exception: "
- ; case exn of
- Fail msg => (Stdio.print "Fail "
- ; Stdio.print msg)
- | _ => Stdio.print (Exn.name exn)
- ; Stdio.print "\n"
- ; bug (NullString.fromString
- "unhandled exception in Basis Library\000")))
-in
-end
Property changes on: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test
___________________________________________________________________
Name: svn:ignore
+ test
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/.ignore
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/.ignore 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/.ignore 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1 @@
+test
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/Makefile (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/Makefile 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,38 @@
+## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ # Jagannathan, and Stephen Weeks.
+ # Copyright (C) 1997-2000 NEC Research Institute.
+ #
+ # MLton is released under a BSD-style license.
+ # See the file MLton-LICENSE for details.
+ ##
+
+SRC = $(shell cd ../.. && pwd)
+BUILD = $(SRC)/build
+BIN = $(BUILD)/bin
+MLTON = mlton
+PATH = $(BIN):$(shell echo $$PATH)
+
+all: test
+
+.PHONY: clean
+clean:
+ find . -type f | egrep '.(old|ast|core-ml)$$' | xargs rm -f
+ ../bin/clean
+
+
+CTYPES_MAPS = c-types.m32.map
+DEFAULT_CHAR_MAPS = default-char8.map
+DEFAULT_INT_MAPS = default-int32.map default-int64.map default-intinf.map
+DEFAULT_WORD_MAPS = default-word32.map default-word64.map
+OBJPTR_REP_MAPS = objptr-rep32.map
+SEQ_INDEX_MAPS = seq-index32.map
+
+test: test.mlb $(shell $(MLTON) -mlb-path-map "../maps/c-types.m32.map" -mlb-path-map "../maps/default-char8.map" -mlb-path-map "../maps/default-int32.map" -mlb-path-map "../maps/default-word32.map" -mlb-path-map "../maps/objptr-rep32.map" -mlb-path-map "../maps/seq-index32.map" -stop f test.mlb)
+ $(MLTON) \
+ -mlb-path-map "../maps/c-types.m32.map" \
+ -mlb-path-map "../maps/default-char8.map" \
+ -mlb-path-map "../maps/default-int32.map" \
+ -mlb-path-map "../maps/default-word32.map" \
+ -mlb-path-map "../maps/objptr-rep32.map" \
+ -mlb-path-map "../maps/seq-index32.map" \
+ test.mlb
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.mlb 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.mlb 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,3 @@
+
+../build/sources.mlb
+test.sml
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,21 @@
+
+fun printString s =
+ PrimitiveFFI.Stdio.print s
+
+fun printIntInf i =
+ let
+ val s = Primitive.IntInf.toString8 i
+ in
+ printString s
+ end
+
+local
+ open Primitive.IntInf
+in
+ fun fact n =
+ if n = 0 then 1 else n * (fact (n - 1))
+end
+
+val () = (printString "fact 40 = "
+ ; printIntInf (fact 40)
+ ; printString "\n")
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/top-level/infixes-unsafe.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/basic.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/basic.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/top-level/infixes-unsafe.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,10 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+infix 7 *?
+infix 6 +? -?
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/dynamic-wind.sig (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sig)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/dynamic-wind.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/dynamic-wind.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/integral-comparisons.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/integral-comparisons.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,38 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor IntegralComparisons (type t
+ val < : t * t -> bool) =
+ struct
+ val < = <
+ fun <= (a, b) = not (< (b, a))
+ fun > (a, b) = < (b, a)
+ fun >= (a, b) = <= (b, a)
+
+ fun compare (i, j) =
+ if < (i, j) then LESS
+ else if < (j, i) then GREATER
+ else EQUAL
+ fun min (x, y) = if < (x, y) then x else y
+ fun max (x, y) = if < (x, y) then y else x
+ end
+functor UnsignedIntegralComparisons (type int
+ type word
+ val fromInt : int -> word
+ val < : word * word -> bool) =
+ struct
+ local
+ fun ltu (i: int, i': int) = < (fromInt i, fromInt i')
+ structure S = IntegralComparisons (type t = int
+ val < = ltu)
+ in
+ val ltu = S.<
+ val leu = S.<=
+ val gtu = S.>
+ val geu = S.>=
+ end
+ end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/real-comparisons.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/real-comparisons.sml 2006-02-05 15:30:17 UTC (rev 4348)
@@ -0,0 +1,45 @@
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+functor Comparisons (type t
+ val < : t * t -> bool) =
+ struct
+ val < = <
+ fun <= (a, b) = not (< (b, a))
+ fun > (a, b) = < (b, a)
+ fun >= (a, b) = <= (b, a)
+
+ fun compare (i, j) =
+ if i < j then LESS
+ else if j < i then GREATER
+ else EQUAL
+ fun min (x, y) = if x < y then x else y
+ fun max (x, y) = if x < y then y else x
+ end
+functor RealComparisons (type t
+ val < : t * t -> bool
+ val <= : t * t -> bool) =
+ struct
+ fun > (a, b) = < (b, a)
+ fun >= (a, b) = <= (b, a)
+ end
+functor UnsignedComparisons (type int
+ type word
+ val fromInt : int -> word
+ val < : word * word -> bool) =
+ struct
+ local
+ fun ltu (i: int, i': int) = < (fromInt i, fromInt i')
+ structure S = Comparisons (type t = int
+ val < = ltu)
+ in
+ val ltu = S.<
+ val leu = S.<=
+ val gtu = S.>
+ val geu = S.>=
+ end
+ end