Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Matthew F. <fl...@ml...> - 2006-02-14 19:30:32
|
Almost done refactoring integer and word
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word-global.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.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/text/char.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-15 03:30:28 UTC (rev 4358)
@@ -89,20 +89,31 @@
../general/bool.sig
../general/bool.sml
../integer/integer.sig
+ ../integer/int.sml
+ ../integer/word.sig
+ ../integer/word.sml
+ ../integer/int-inf.sig
(*
- ../../integer/int.sml
- ../../text/char.sig
- ../../text/char.sml
- ../../text/substring.sig
- ../../text/substring.sml
- ../../text/string.sig
- ../../text/string.sml
+ ../integer/int-inf.sml
+ local in ann "forceUsed" in
+ ../config/default/$(DEFAULT_INT)
+ ../config/default/$(DEFAULT_WORD)
+ ../config/default/large-int.sml
+ ../config/default/large-word.sml
+ end end
+ ../integer/int-global.sml
+ ../integer/word-global.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
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-global.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/int-global.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -0,0 +1,10 @@
+(* 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 IntGlobal: INTEGER_GLOBAL = Int
+open IntGlobal
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sig 2006-02-15 03:30:28 UTC (rev 4358)
@@ -11,20 +11,21 @@
val andb: int * int -> int
val notb: int -> int
val << : int * Word.word -> int
- val ~>> : int * Word.word -> int
+ val ~>> : int * Word.word -> int
end
signature INT_INF_EXTRA =
sig
include INT_INF
+ structure BigWord : WORD
+ structure SmallInt : INTEGER
+
val areSmall: int * int -> bool
- val fromInt64: Int64.int -> int
val gcd: int * int -> int
val isSmall: int -> bool
datatype rep =
- Big of Word.word Vector.vector
- | Small of Int.int
+ Big of BigWord.word Vector.vector
+ | Small of SmallInt.int
val rep: int -> rep
- val toInt64: int -> Int64.int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -47,6 +47,10 @@
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
@@ -242,16 +246,16 @@
local
fun 'a make {toMPLimb: 'a -> MPLimb.word,
toObjptrWord: 'a -> ObjptrWord.word,
- other : {wordSize': Int32.int,
+ other : {wordSize: Int32.int,
zero: 'a,
eq: 'a * 'a -> bool,
rshift: 'a * Word32.word -> 'a}}
(isneg, w) =
- if Int32.> (ObjptrWord.wordSize', #wordSize' other)
+ if Int32.> (ObjptrWord.wordSize, #wordSize other)
orelse let
val upperBits =
(#rshift other)
- (w, Word32.- (ObjptrWord.wordSizeWord', 0w2))
+ (w, Word32.- (ObjptrWord.wordSizeWord, 0w2))
in
(#eq other) (upperBits, #zero other)
end
@@ -270,7 +274,7 @@
val limb = toMPLimb w
val w =
(#rshift other)
- (w, MPLimb.wordSizeWord')
+ (w, MPLimb.wordSizeWord)
in
loop (w, S.+ (i, 1), (i, limb) :: acc)
end
@@ -290,7 +294,7 @@
val fromWordAux8 =
make {toMPLimb = MPLimb.fromWord8,
toObjptrWord = ObjptrWord.fromWord8,
- other = {wordSize' = Word8.wordSize',
+ other = {wordSize = Word8.wordSize,
zero = Word8.zero,
eq = ((op =) : Word8.word * Word8.word -> bool),
rshift = Word8.>>}}
@@ -308,7 +312,7 @@
val fromWordAux16 =
make {toMPLimb = MPLimb.fromWord16,
toObjptrWord = ObjptrWord.fromWord16,
- other = {wordSize' = Word16.wordSize',
+ other = {wordSize = Word16.wordSize,
zero = Word16.zero,
eq = ((op =) : Word16.word * Word16.word -> bool),
rshift = Word16.>>}}
@@ -325,7 +329,7 @@
val fromWordAux32 =
make {toMPLimb = MPLimb.fromWord32,
toObjptrWord = ObjptrWord.fromWord32,
- other = {wordSize' = Word32.wordSize',
+ other = {wordSize = Word32.wordSize,
zero = Word32.zero,
eq = ((op =) : Word32.word * Word32.word -> bool),
rshift = Word32.>>}}
@@ -342,7 +346,7 @@
val fromWordAux64 =
make {toMPLimb = MPLimb.fromWord64,
toObjptrWord = ObjptrWord.fromWord64,
- other = {wordSize' = Word64.wordSize',
+ other = {wordSize = Word64.wordSize,
zero = Word64.zero,
eq = ((op =) : Word64.word * Word64.word -> bool),
rshift = Word64.>>}}
@@ -377,8 +381,8 @@
Big of bool * bool * 'a
| Small of ObjptrWord.word
fun 'a make {fromMPLimb: MPLimb.word -> 'a,
- other : {wordSize': Int32.int,
- wordSizeWord': Word32.word,
+ other : {wordSize: Int32.int,
+ wordSizeWord: Word32.word,
zero: 'a,
lshift: 'a * Word32.word -> 'a,
orb: 'a * 'a -> 'a}} i =
@@ -389,22 +393,22 @@
val n = V.length v
val isneg = V.subUnsafe (v, 0) <> 0w0
in
- if Int32.>= (MPLimb.wordSize', #wordSize' other)
+ if Int32.>= (MPLimb.wordSize, #wordSize other)
then let
val limbsPer = 1
val limb = V.subUnsafe (v, 1)
val extra =
S.> (n, S.+ (limbsPer, 1))
orelse
- (MPLimb.>> (limb, #wordSizeWord' other)) <> 0w0
+ (MPLimb.>> (limb, #wordSizeWord other)) <> 0w0
val ans = fromMPLimb limb
in
Big (isneg, extra, ans)
end
else let
val limbsPer =
- S.fromInt32 (Int32.quot (#wordSize' other,
- MPLimb.wordSize'))
+ S.fromInt32 (Int32.quot (#wordSize other,
+ MPLimb.wordSize))
val extra =
S.> (n, S.+ (limbsPer, 1))
val ans =
@@ -416,7 +420,7 @@
val ans =
(#orb other)
((#lshift other)
- (ans, MPLimb.wordSizeWord'),
+ (ans, MPLimb.wordSizeWord),
fromMPLimb limb)
in
loop (S.- (i, 1), ans)
@@ -432,8 +436,8 @@
in
val toWordAux8 =
make {fromMPLimb = MPLimb.toWord8,
- other = {wordSize' = Word8.wordSize',
- wordSizeWord' = Word8.wordSizeWord',
+ other = {wordSize = Word8.wordSize,
+ wordSizeWord = Word8.wordSizeWord,
zero = Word8.zero,
lshift = Word8.<<,
orb = Word8.orb}}
@@ -463,8 +467,8 @@
val toWordAux16 =
make {fromMPLimb = MPLimb.toWord16,
- other = {wordSize' = Word16.wordSize',
- wordSizeWord' = Word16.wordSizeWord',
+ other = {wordSize = Word16.wordSize,
+ wordSizeWord = Word16.wordSizeWord,
zero = Word16.zero,
lshift = Word16.<<,
orb = Word16.orb}}
@@ -494,8 +498,8 @@
val toWordAux32 =
make {fromMPLimb = MPLimb.toWord32,
- other = {wordSize' = Word32.wordSize',
- wordSizeWord' = Word32.wordSizeWord',
+ other = {wordSize = Word32.wordSize,
+ wordSizeWord = Word32.wordSizeWord,
zero = Word32.zero,
lshift = Word32.<<,
orb = Word32.orb}}
@@ -525,8 +529,8 @@
val toWordAux64 =
make {fromMPLimb = MPLimb.toWord64,
- other = {wordSize' = Word64.wordSize',
- wordSizeWord' = Word64.wordSizeWord',
+ other = {wordSize = Word64.wordSize,
+ wordSizeWord = Word64.wordSizeWord,
zero = Word64.zero,
lshift = Word64.<<,
orb = Word64.orb}}
@@ -559,10 +563,10 @@
end
local
- val bytesPerMPLimb = Sz.fromInt32 (Int32.quot (MPLimb.wordSize', 8))
+ 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 (Int32.quot (HeaderWord.wordSize', 8))
+ val bytesPerHeader = Sz.fromInt32 (Int32.quot (HeaderWord.wordSize, 8))
in
val bytesPerArrayHeader =
Sz.+ (bytesPerCounter, Sz.+ (bytesPerLength, bytesPerHeader))
@@ -582,7 +586,7 @@
* 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 badObjptrInt: I.int = I.~>>? (I.minInt', 0w1)
val badObjptrWord: W.word = W.fromObjptrInt badObjptrInt
val badObjptrWordTagged: W.word = addTag badObjptrWord
val badObjptrIntTagged: I.int = W.toObjptrIntX badObjptrWordTagged
@@ -703,7 +707,7 @@
open I
fun mod2 x = I.andb (x, 1)
- fun div2 x = I.>> (x, 0w1)
+ fun div2 x = I.>>? (x, 0w1)
fun gcdInt (a, b, acc) =
case (a, b) of
@@ -786,6 +790,7 @@
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)
@@ -795,8 +800,27 @@
fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
bigSign' lhs = bigSign' rhs
+*)
local
+ fun bigLTU (lhs, rhs) =
+ case (bigCompare (lhs, 0), bigCompare (rhs, 0)) of
+ (LESS, LESS) => bigLT (lhs, rhs)
+ | (LESS, GREATER) => false
+ | (_, EQUAL) => false
+ | (EQUAL, _) => true
+ | (GREATER, LESS) => true
+ | (GREATER, GREATER) => bigLT (lhs, rhs)
+ structure S = IntegralComparisons(type t = bigInt
+ val op < = bigLTU)
+ in
+ val bigLTU = S.<
+ val bigLEU = S.<=
+ val bigGTU = S.>
+ val bigGEU = S.>=
+ end
+
+ local
val op + = bigAdd
val op - = bigSub
val op > = bigGT
@@ -864,7 +888,7 @@
else Prim.notb (arg, reserve (numLimbs arg, 0))
local
- val bitsPerLimb = MPLimb.wordSizeWord'
+ val bitsPerLimb = MPLimb.wordSizeWord
fun shiftSize shift = S.fromWord32 (Word32.div (shift, bitsPerLimb))
in
fun bigLshift (arg: bigInt, shift: Word32.word): bigInt =
@@ -915,6 +939,10 @@
val compare = bigCompare
val min = bigMin
val max = bigMax
+ val ltu = bigLTU
+ val leu = bigLEU
+ val gtu = bigGTU
+ val geu = bigGEU
val andb = bigAndb
val << = bigLshift
Modified: 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-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -6,88 +6,17 @@
* See the file MLton-LICENSE for details.
*)
-functor Integer (I: PRE_INTEGER_EXTRA) =
+functor Integer (I: PRE_INTEGER_EXTRA) : INTEGER_EXTRA =
struct
open I
-structure PI = Primitive.Int
-val detectOverflow = Primitive.detectOverflow
-
-val (toInt, fromInt) =
- if detectOverflow andalso
- precision' <> PI.precision'
- then if PI.<(precision', PI.precision')
- then (I.toInt,
- fn i =>
- if (PI.<= (I.toInt minInt', i)
- andalso PI.<= (i, I.toInt maxInt'))
- then I.fromInt i
- else raise Overflow)
- else (fn i =>
- if (I.<= (I.fromInt PI.minInt', i)
- andalso I.<= (i, I.fromInt PI.maxInt'))
- then I.toInt i
- else raise Overflow,
- I.fromInt)
- else (I.toInt, I.fromInt)
-
+val precision': Int.int = Primitive.Int32.toInt precision'
val precision: Int.int option = SOME precision'
val maxInt: int option = SOME maxInt'
val minInt: int option = SOME minInt'
-val one: int = fromInt 1
-val zero: int = fromInt 0
-
-fun quot (x, y) =
- if y = zero
- then raise Div
- else if detectOverflow andalso x = minInt' andalso y = ~one
- then raise Overflow
- else I.quot (x, y)
-
-fun rem (x, y) =
- if y = zero
- then raise Div
- else if x = minInt' andalso y = ~one
- then zero
- else I.rem (x, y)
-
-fun x div y =
- if x >= zero
- then if y > zero
- then I.quot (x, y)
- else if y < zero
- then if x = zero
- then zero
- else I.quot (x - one, y) -? one
- else raise Div
- else if y < zero
- then if detectOverflow andalso x = minInt' andalso y = ~one
- then raise Overflow
- else I.quot (x, y)
- else if y > zero
- then I.quot (x + one, y) -? one
- else raise Div
-
-fun x mod y =
- if x >= zero
- then if y > zero
- then I.rem (x, y)
- else if y < zero
- then if x = zero
- then zero
- else I.rem (x - one, y) +? (y + one)
- else raise Div
- else if y < zero
- then if x = minInt' andalso y = ~one
- then zero
- else I.rem (x, y)
- else if y > zero
- then I.rem (x + one, y) +? (y - one)
- else raise Div
-
val sign: int -> Int.int =
fn i => if i = zero
then (0: Int.int)
@@ -97,10 +26,6 @@
fun sameSign (x, y) = sign x = sign y
-fun abs (x: int) = if x < zero then ~ x else x
-
-val {compare, min, max} = Util.makeCompare (op <)
-
(* fmt constructs a string to represent the integer by building it into a
* statically allocated buffer. For the most part, this is a textbook
* algorithm: loop starting at the end of the buffer; we use rem to
@@ -118,7 +43,7 @@
(* Allocate a buffer large enough to hold any formatted integer in any radix.
* The most that will be required is for minInt in binary.
*)
- val maxNumDigits = PI.+ (precision', 1)
+ val maxNumDigits = Int.+ (precision', 1)
val buf = CharArray.array (maxNumDigits, #"\000")
in
fun fmt radix (n: int): string =
@@ -138,7 +63,7 @@
if n < zero
then
let
- val i = PI.- (i, 1)
+ val i = Int.- (i, 1)
val () = CharArray.update (buf, i, #"~")
in
i
@@ -148,10 +73,10 @@
CharArraySlice.vector
(CharArraySlice.slice (buf, start, NONE))
end
- else loop (q, PI.- (i, 1))
+ else loop (q, Int.- (i, 1))
end
in
- loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
+ loop (if n < zero then n else ~? n, Int.- (maxNumDigits, 1))
end
end
@@ -212,34 +137,9 @@
val fromString = StringCvt.scanString (scan StringCvt.DEC)
-fun power {base, exp} =
- if Primitive.safe andalso exp < zero
- then raise Fail "Int.power"
- else let
- fun loop (exp, accum) =
- if exp <= zero
- then accum
- else loop (exp - one, base * accum)
- in loop (exp, one)
- end
end
structure Int8 = Integer (Primitive.Int8)
-
structure Int16 = Integer (Primitive.Int16)
-
structure Int32 = Integer (Primitive.Int32)
-structure Int = Int32
-structure IntGlobal: INTEGER_GLOBAL = Int
-open IntGlobal
-
-structure Int64 =
- struct
- local
- structure P = Primitive.Int64
- structure I = Integer (P)
- in
- open I
- val toWord = P.toWord
- end
- end
+structure Int64 = Integer (Primitive.Int64)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -21,19 +21,16 @@
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 power: {base:int, exp: int} -> 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 >> : int * Primitive.Word32.word -> int
- val sign': int -> Primitive.Int32.int
- val sameSign: int * int -> bool
-
(* Overflow checking, signed interp. *)
val fromInt8: Primitive.Int8.int -> int
val fromInt16: Primitive.Int16.int -> int
@@ -177,16 +174,6 @@
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,
@@ -244,19 +231,19 @@
local
fun 'a make {fromWordUnsafe: 'a -> int, fromWordXUnsafe: 'a -> int,
toWordUnsafe: int -> 'a, toWordXUnsafe: int -> 'a,
- other : {wordSize': Primitive.Int32.int,
+ 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 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 Primitive.Int32.> (#wordSize other, precision')
andalso (#lt other) (toWordUnsafe maxInt', w)
andalso (#lt other) (w, toWordUnsafe maxInt')
then raise Overflow
@@ -273,7 +260,7 @@
fromWordXUnsafe = fromWord8XUnsafe,
toWordUnsafe = toWord8Unsafe,
toWordXUnsafe =toWord8XUnsafe,
- other = {wordSize' = Primitive.Word8.wordSize',
+ other = {wordSize = Primitive.Word8.wordSize,
lt = Primitive.Word8.<,
gt = Primitive.Word8.>}}
val (fromWord16, fromWord16X, toWord16, toWord16X) =
@@ -281,7 +268,7 @@
fromWordXUnsafe = fromWord16XUnsafe,
toWordUnsafe = toWord16Unsafe,
toWordXUnsafe =toWord16XUnsafe,
- other = {wordSize' = Primitive.Word16.wordSize',
+ other = {wordSize = Primitive.Word16.wordSize,
lt = Primitive.Word16.<,
gt = Primitive.Word16.>}}
val (fromWord32, fromWord32X, toWord32, toWord32X) =
@@ -289,7 +276,7 @@
fromWordXUnsafe = fromWord32XUnsafe,
toWordUnsafe = toWord32Unsafe,
toWordXUnsafe =toWord32XUnsafe,
- other = {wordSize' = Primitive.Word32.wordSize',
+ other = {wordSize = Primitive.Word32.wordSize,
lt = Primitive.Word32.<,
gt = Primitive.Word32.>}}
val (fromWord64, fromWord64X, toWord64, toWord64X) =
@@ -297,7 +284,7 @@
fromWordXUnsafe = fromWord64XUnsafe,
toWordUnsafe = toWord64Unsafe,
toWordXUnsafe =toWord64XUnsafe,
- other = {wordSize' = Primitive.Word64.wordSize',
+ other = {wordSize = Primitive.Word64.wordSize,
lt = Primitive.Word64.<,
gt = Primitive.Word64.>}}
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-02-15 03:30:28 UTC (rev 4358)
@@ -1,13 +1,3 @@
-structure Int =
- struct
- type int = int
- end
-
-structure LargeInt =
- struct
- type int = Primitive.IntInf.int
- end
-
signature INTEGER_GLOBAL =
sig
eqtype int
@@ -17,76 +7,103 @@
sig
include INTEGER_GLOBAL
+ val toLarge: int -> LargeInt.int
+ val fromLarge: LargeInt.int -> int
+ val toInt: int -> Int.int
+ val fromInt: Int.int -> int
+
+ val minInt: int option
+ val maxInt: int option
+
+ val + : int * int -> int
+ val - : int * int -> int
val * : int * int -> int
- val + : int * int -> int
- val - : int * int -> int
+ val div: int * int -> int
+ val mod: int * int -> int
+ val quot: int * int -> int
+ val rem: int * int -> int
+
+ val compare: int * int -> order
val < : int * int -> bool
val <= : int * int -> bool
val > : int * int -> bool
val >= : int * int -> bool
- val fromInt : Int.int -> int
- val quot : int * int -> int
- val rem : int * int -> int
- val toInt : int -> Int.int
+
val ~ : int -> int
+ val abs: int -> int
+ val min: int * int -> int
+ val max: int * int -> int
end
signature PRE_INTEGER_EXTRA =
sig
include PRE_INTEGER
- val << : int * Word.word -> int
- val >> : int * Word.word -> int
- val ~>> : int * Word.word -> int
+ val zero: int
+ val one: 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 andb : int * int -> int
- val maxInt' : int
- val minInt' : int
- val precision' : Int.int
val ~? : int -> int
+ val power: {base: int, exp: int} -> int
+
+ val andb: int * int -> int
+ val << : int * Primitive.Word32.word -> int
+ val notb: int -> int
+ val orb: int * int -> int
+ val rol: int * Primitive.Word32.word -> int
+ val ror: int * Primitive.Word32.word -> int
+ val ~>> : int * Primitive.Word32.word -> int
+ val >> : int * Primitive.Word32.word -> int
+ val xorb: int * int -> int
end
signature INTEGER =
sig
include PRE_INTEGER
- val abs: int -> int
- val compare: int * int -> order
- val div: int * int -> int
- val fmt: StringCvt.radix -> int -> string
- val fromLarge: LargeInt.int -> int
- val fromString: string -> int option
- val max: int * int -> int
- val maxInt: int option
- val min: int * int -> int
- val minInt: int option
- val mod: int * int -> int
- val precision: Int.int option
- val sameSign: int * int -> bool
- val scan: (StringCvt.radix
- -> (char, 'a) StringCvt.reader
+ val precision: Int.int option
+ val sign: int -> Int.int
+ val sameSign: int * int -> bool
+
+ val fmt: StringCvt.radix -> int -> string
+ val toString: int -> string
+ val scan: (StringCvt.radix
+ -> (char, 'a) StringCvt.reader
-> (int, 'a) StringCvt.reader)
- val sign: int -> Int.int
- val toLarge: int -> LargeInt.int
- val toString: int -> string
+ val fromString: string -> int option
end
signature INTEGER_EXTRA =
sig
include INTEGER
- val << : int * Word.word -> int
- val >> : int * Word.word -> int
- val ~>> : int * Word.word -> int
+ val precision' : Int.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 andb : int * int -> int
- val maxInt' : int
- val minInt' : int
- val power: {base: int, exp: int} -> int
- val precision' : Int.int
+
+ val andb: int * int -> int
+(*
+ val << : int * Word.word -> int
+*)
+ val notb: int -> int
+ val orb: int * int -> int
+(*
+ val rol: int * Word.word -> int
+ val ror: int * Word.word -> int
+ val ~>> : int * Word.word -> int
+ val >> : int * Word.word -> int
+*)
+ val xorb: int * int -> int
end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word-global.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/word-global.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -0,0 +1,10 @@
+(* 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 WordGlobal: WORD_GLOBAL = Word
+open WordGlobal
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig 2006-02-15 03:30:28 UTC (rev 4358)
@@ -1,13 +1,3 @@
-structure Word =
- struct
- type word = word
- end
-
-structure LargeWord =
- struct
- type word = Primitive.Word64.word
- end
-
signature WORD_GLOBAL =
sig
eqtype word
@@ -17,66 +7,79 @@
sig
include WORD_GLOBAL
- val * : word * word -> word
- val + : word * word -> word
- val - : word * word -> word
- val < : word * word -> bool
- val << : word * Word.word -> word
- val <= : word * word -> bool
- val > : word * word -> bool
- val >= : word * word -> bool
- val >> : word * Word.word -> word
- val andb: word * word -> word
- val div: word * word -> word
- val fromInt: Int.int -> word
- val fromLarge: LargeWord.word -> word
- val mod: word * word -> word
- val notb: word -> word
- val orb: word * word -> word
- val toInt: word -> Int.int
- val toIntX: word -> Int.int
val toLarge: word -> LargeWord.word
val toLargeX: word -> LargeWord.word
- val wordSize: int
- val xorb: word * word -> word
+ val toLargeWord: word -> LargeWord.word
+ val toLargeWordX: word -> LargeWord.word
+ val fromLarge: LargeWord.word -> word
+ val fromLargeWord: LargeWord.word -> word
+ val toLargeInt: word -> LargeInt.int
+ val toLargeIntX: word -> LargeInt.int
+ val fromLargeInt: LargeInt.int -> word
+ val toInt: word -> int
+ val toIntX: word -> int
+ val fromInt: int -> word
+
+ val andb: word * word -> word
+ val orb: word * word -> word
+ val xorb: word * word -> word
+ val notb: word -> word
+
+ val + : word * word -> word
+ val - : word * word -> word
+ val * : word * word -> word
+ val div: word * word -> word
+ val mod: word * word -> word
+
+ val compare: word * word -> order
+ val < : word * word -> bool
+ val <= : word * word -> bool
+ val > : word * word -> bool
+ val >= : word * word -> bool
+
val ~ : word -> word
- val ~>> : word * Word.word -> word
+ val min: word * word -> word
+ val max: word * word -> word
end
signature PRE_WORD_EXTRA =
sig
include PRE_WORD
+
+ val zero: word
+
+ val wordSize: Primitive.Int32.int
+
+ val << : word * Primitive.Word32.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
end
signature WORD =
sig
include PRE_WORD
+
+ val wordSize: Int.int
+
+(*
+ val << : word * Word.word -> word
+ val >> : word * Word.word -> word
+ val ~>> : word * Word.word -> word
+*)
- val compare: word * word -> order
- val fmt: StringCvt.radix -> word -> string
- val fromLargeInt: LargeInt.int -> word
- val fromLargeWord: LargeWord.word -> word
- val fromString: string -> word option
- val max: word * word -> word
- val min: word * word -> word
+ val fmt: StringCvt.radix -> word -> string
+ val toString: word -> string
val scan: (StringCvt.radix
-> (char, 'a) StringCvt.reader
-> (word, 'a) StringCvt.reader)
- val toLargeInt: word -> LargeInt.int
- val toLargeIntX: word -> LargeInt.int
- val toLargeWord: word -> LargeWord.word
- val toLargeWordX: word -> LargeWord.word
- val toString: word -> string
+ val fromString: string -> word option
end
signature WORD_EXTRA =
sig
include WORD
- (* include PRE_WORD_EXTRA *)
- end
-signature WORD32_EXTRA =
- sig
- include WORD_EXTRA
-
-(* val toReal: word -> real *)
+ val rol: word * Word.word -> word
+ val ror: word * Word.word -> word
end
Modified: 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-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -10,48 +10,10 @@
struct
open W
-structure PW = Primitive.Word
-val detectOverflow = Primitive.detectOverflow
+val wordSize = Primitive.Int32.toInt wordSize
-(* These are overriden in patch.sml after int-inf.sml has been defined. *)
-val toLargeInt: word -> LargeInt.int = fn _ => raise Fail "toLargeInt"
-val toLargeIntX: word -> LargeInt.int = fn _ => raise Fail "toLargeIntX"
-val fromLargeInt: LargeInt.int -> word = fn _ => raise Fail "fromLargeInt"
-
-val wordSizeWord: Word.word = PW.fromInt wordSize
-val wordSizeMinusOneWord: Word.word = PW.fromInt (Int.-? (wordSize, 1))
-val zero: word = fromInt 0
-
-val toLargeWord = toLarge
-val toLargeWordX = toLargeX
-val fromLargeWord = fromLarge
-
-fun toInt w =
- if detectOverflow
- andalso Int.>= (wordSize, Int.precision')
- andalso w > fromInt Int.maxInt'
- then raise Overflow
- else W.toInt w
-
-fun toIntX w =
- if detectOverflow
- andalso Int.> (wordSize, Int.precision')
- andalso fromInt Int.maxInt' < w
- andalso w < fromInt Int.minInt'
- then raise Overflow
- else W.toIntX w
-
-local
- fun make f (w, w') =
- if Primitive.safe andalso w' = zero
- then raise Div
- else f (w, w')
-in
- val op div = make (op div)
- val op mod = make (op mod)
-end
-
+(*
fun << (i, n)
= if PW.>=(n ,wordSizeWord)
then zero
@@ -66,9 +28,8 @@
= if PW.<(n, wordSizeWord)
then W.~>>(i, n)
else W.~>>(i, wordSizeMinusOneWord)
+*)
-val {compare, min, max} = Util.makeCompare(op <)
-
fun fmt radix (w: word): string =
let val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, chars) =
@@ -154,6 +115,3 @@
structure Word16 = Word (Primitive.Word16)
structure Word32 = Word (Primitive.Word32)
structure Word64 = Word (Primitive.Word64)
-structure Word = Word32
-structure WordGlobal: WORD_GLOBAL = Word
-open WordGlobal
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -10,7 +10,7 @@
sig
include PRIM_WORD
- val wordSizeWord': Primitive.Word32.word
+ val wordSizeWord: Primitive.Word32.word
val zero: word
val one: word
@@ -30,11 +30,13 @@
val fromInt32: Primitive.Int32.int -> word
val fromInt64: Primitive.Int64.int -> word
+(*
(* Lowbits or zero extend. *)
val fromInt8Z: Primitive.Int8.int -> word
val fromInt16Z: Primitive.Int16.int -> word
val fromInt32Z: Primitive.Int32.int -> word
val fromInt64Z: Primitive.Int64.int -> word
+*)
(* Lowbits or zero extend. *)
val fromWord8: Primitive.Word8.word -> word
@@ -80,8 +82,8 @@
val detectOverflow = Primitive.Controls.detectOverflow
- val wordSizeWord' = Primitive.Word32.fromInt32Unsafe wordSize'
- val wordSizeMinusOneWord' = Primitive.Word32.- (wordSizeWord', 0w1)
+ val wordSizeWord = Primitive.Word32.fromInt32Unsafe wordSize
+ val wordSizeMinusOneWord = Primitive.Word32.- (wordSizeWord, 0w1)
val zero: word = fromWord32Unsafe 0w0
val one: word = fromWord32Unsafe 0w1
@@ -97,20 +99,20 @@
end
fun << (w, n) =
- if Primitive.Word32.>= (n, wordSizeWord')
+ if Primitive.Word32.>= (n, wordSizeWord)
then zero
else <<? (w, n)
fun >> (w, n) =
- if Primitive.Word32.>= (n, wordSizeWord')
+ if Primitive.Word32.>= (n, wordSizeWord)
then zero
else >>? (w, n)
fun ~>> (w, n) =
- if Primitive.Word32.< (n, wordSizeWord')
+ if Primitive.Word32.< (n, wordSizeWord)
then ~>>? (w, n)
- else ~>>? (w, wordSizeMinusOneWord')
+ else ~>>? (w, wordSizeMinusOneWord)
fun rol (w, n) =
let
- val n = Primitive.Word32.remUnsafe (n, wordSizeWord')
+ val n = Primitive.Word32.remUnsafe (n, wordSizeWord)
in
if n = 0w0
then w
@@ -118,7 +120,7 @@
end
fun ror (w, n) =
let
- val n = Primitive.Word32.remUnsafe (n, wordSizeWord')
+ val n = Primitive.Word32.remUnsafe (n, wordSizeWord)
in
if n = 0w0
then w
@@ -126,7 +128,7 @@
end
local
- fun 'a make {fromIntUnsafe: 'a -> word, fromIntZUnsafe: 'a -> word,
+ fun 'a make {fromIntUnsafe: 'a -> word, (* fromIntZUnsafe: 'a -> word, *)
toIntUnsafe: word -> 'a, toIntXUnsafe: word -> 'a,
other : {precision': Primitive.Int32.int,
maxInt': 'a,
@@ -134,51 +136,51 @@
let
fun toInt w =
if detectOverflow
- andalso Primitive.Int32.>= (wordSize', #precision' other)
+ 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 Primitive.Int32.> (wordSize, #precision' other)
andalso fromIntUnsafe (#maxInt' other) < w
andalso w < fromIntUnsafe (#minInt' other)
then raise Overflow
else toIntXUnsafe w
in
(fromIntUnsafe,
- fromIntZUnsafe,
+ (* fromIntZUnsafe, *)
toInt,
toIntX)
end
in
- val (fromInt8, fromInt8Z, toInt8, toInt8X) =
+ val (fromInt8, (* fromInt8Z, *) toInt8, toInt8X) =
make {fromIntUnsafe = fromInt8Unsafe,
- fromIntZUnsafe = fromInt8ZUnsafe,
+ (* fromIntZUnsafe = fromInt8ZUnsafe, *)
toIntUnsafe = toInt8Unsafe,
toIntXUnsafe = toInt8XUnsafe,
other = {precision' = Primitive.Int8.precision',
maxInt' = Primitive.Int8.maxInt',
minInt' = Primitive.Int8.minInt'}}
- val (fromInt16, fromInt16Z, toInt16, toInt16X) =
+ val (fromInt16, (* fromInt16Z, *) toInt16, toInt16X) =
make {fromIntUnsafe = fromInt16Unsafe,
- fromIntZUnsafe = fromInt16ZUnsafe,
+ (* fromIntZUnsafe = fromInt16ZUnsafe, *)
toIntUnsafe = toInt16Unsafe,
toIntXUnsafe = toInt16XUnsafe,
other = {precision' = Primitive.Int16.precision',
maxInt' = Primitive.Int16.maxInt',
minInt' = Primitive.Int16.minInt'}}
- val (fromInt32, fromInt32Z, toInt32, toInt32X) =
+ val (fromInt32, (* fromInt32Z, *) toInt32, toInt32X) =
make {fromIntUnsafe = fromInt32Unsafe,
- fromIntZUnsafe = fromInt32ZUnsafe,
+ (* fromIntZUnsafe = fromInt32ZUnsafe, *)
toIntUnsafe = toInt32Unsafe,
toIntXUnsafe = toInt32XUnsafe,
other = {precision' = Primitive.Int32.precision',
maxInt' = Primitive.Int32.maxInt',
minInt' = Primitive.Int32.minInt'}}
- val (fromInt64, fromInt64Z, toInt64, toInt64X) =
+ val (fromInt64, (* fromInt64Z, *) toInt64, toInt64X) =
make {fromIntUnsafe = fromInt64Unsafe,
- fromIntZUnsafe = fromInt64ZUnsafe,
+ (* fromIntZUnsafe = fromInt64ZUnsafe, *)
toIntUnsafe = toInt64Unsafe,
toIntXUnsafe = toInt64XUnsafe,
other = {precision' = Primitive.Int64.precision',
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -56,11 +56,13 @@
val fromInt32Unsafe: Primitive.Int32.int -> int
val fromInt64Unsafe: Primitive.Int64.int -> int
+(*
(* Lowbits or zero extend. *)
val fromInt8ZUnsafe: Primitive.Int8.int -> int
val fromInt16ZUnsafe: Primitive.Int16.int -> int
val fromInt32ZUnsafe: Primitive.Int32.int -> int
val fromInt64ZUnsafe: Primitive.Int64.int -> int
+*)
(* Lowbits or zero extend. *)
val fromWord8Unsafe: Primitive.Word8.word -> int
@@ -80,11 +82,13 @@
val toInt32Unsafe: int -> Primitive.Int32.int
val toInt64Unsafe: int -> Primitive.Int64.int
+(*
(* Lowbits or zero extend. *)
val toInt8ZUnsafe: int -> Primitive.Int8.int
val toInt16ZUnsafe: int -> Primitive.Int16.int
val toInt32ZUnsafe: int -> Primitive.Int32.int
val toInt64ZUnsafe: int -> Primitive.Int64.int
+*)
(* Lowbits or zero extend. *)
val toWord8Unsafe: int -> Primitive.Word8.word
@@ -206,10 +210,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> int;
val fromInt64Unsafe = _prim "WordS64_toWord8": Int64.int -> int;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord8": Int8.int -> int;
val fromInt16ZUnsafe = _prim "WordU16_toWord8": Int16.int -> int;
val fromInt32ZUnsafe = _prim "WordU32_toWord8": Int32.int -> int;
val fromInt64ZUnsafe = _prim "WordU64_toWord8": Int64.int -> int;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> int;
val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> int;
@@ -226,10 +232,12 @@
val toInt32Unsafe = _prim "WordS8_toWord32": int -> Int32.int;
val toInt64Unsafe = _prim "WordS8_toWord64": int -> Int64.int;
+(*
val toInt8ZUnsafe = _prim "WordU8_toWord8": int -> Int8.int;
val toInt16ZUnsafe = _prim "WordU8_toWord16": int -> Int16.int;
val toInt32ZUnsafe = _prim "WordU8_toWord32": int -> Int32.int;
val toInt64ZUnsafe = _prim "WordU8_toWord64": int -> Int64.int;
+*)
val toWord8Unsafe = _prim "WordU8_toWord8": int -> Word8.word;
val toWord16Unsafe = _prim "WordU8_toWord16": int -> Word16.word;
@@ -362,10 +370,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> int;
val fromInt64Unsafe = _prim "WordS64_toWord16": Int64.int -> int;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord16": Int8.int -> int;
val fromInt16ZUnsafe = _prim "WordU16_toWord16": Int16.int -> int;
val fromInt32ZUnsafe = _prim "WordU32_toWord16": Int32.int -> int;
val fromInt64ZUnsafe = _prim "WordU64_toWord16": Int64.int -> int;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> int;
val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> int;
@@ -382,10 +392,12 @@
val toInt32Unsafe = _prim "WordS16_toWord32": int -> Int32.int;
val toInt64Unsafe = _prim "WordS16_toWord64": int -> Int64.int;
+(*
val toInt8ZUnsafe = _prim "WordU16_toWord8": int -> Int8.int;
val toInt16ZUnsafe = _prim "WordU16_toWord16": int -> Int16.int;
val toInt32ZUnsafe = _prim "WordU16_toWord32": int -> Int32.int;
val toInt64ZUnsafe = _prim "WordU16_toWord64": int -> Int64.int;
+*)
val toWord8Unsafe = _prim "WordU16_toWord8": int -> Word8.word;
val toWord16Unsafe = _prim "WordU16_toWord16": int -> Word16.word;
@@ -582,10 +594,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord32": Int32.int -> int;
val fromInt64Unsafe = _prim "WordS64_toWord32": Int64.int -> int;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord32": Int8.int -> int;
val fromInt16ZUnsafe = _prim "WordU16_toWord32": Int16.int -> int;
val fromInt32ZUnsafe = _prim "WordU32_toWord32": Int32.int -> int;
val fromInt64ZUnsafe = _prim "WordU64_toWord32": Int64.int -> int;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord32": Word8.word -> int;
val fromWord16Unsafe = _prim "WordU16_toWord32": Word16.word -> int;
@@ -602,10 +616,12 @@
val toInt32Unsafe = _prim "WordS32_toWord32": int -> Int32.int;
val toInt64Unsafe = _prim "WordS32_toWord64": int -> Int64.int;
+(*
val toInt8ZUnsafe = _prim "WordU32_toWord8": int -> Int8.int;
val toInt16ZUnsafe = _prim "WordU32_toWord16": int -> Int16.int;
val toInt32ZUnsafe = _prim "WordU32_toWord32": int -> Int32.int;
val toInt64ZUnsafe = _prim "WordU32_toWord64": int -> Int64.int;
+*)
val toWord8Unsafe = _prim "WordU32_toWord8": int -> Word8.word;
val toWord16Unsafe = _prim "WordU32_toWord16": int -> Word16.word;
@@ -682,10 +698,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord64": Int32.int -> int;
val fromInt64Unsafe = _prim "WordS64_toWord64": Int64.int -> int;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord64": Int8.int -> int;
val fromInt16ZUnsafe = _prim "WordU16_toWord64": Int16.int -> int;
val fromInt32ZUnsafe = _prim "WordU32_toWord64": Int32.int -> int;
val fromInt64ZUnsafe = _prim "WordU64_toWord64": Int64.int -> int;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord64": Word8.word -> int;
val fromWord16Unsafe = _prim "WordU16_toWord64": Word16.word -> int;
@@ -702,10 +720,12 @@
val toInt32Unsafe = _prim "WordS64_toWord32": int -> Int32.int;
val toInt64Unsafe = _prim "WordS64_toWord64": int -> Int64.int;
+(*
val toInt8ZUnsafe = _prim "WordU64_toWord8": int -> Int8.int;
val toInt16ZUnsafe = _prim "WordU64_toWord16": int -> Int16.int;
val toInt32ZUnsafe = _prim "WordU64_toWord32": int -> Int32.int;
val toInt64ZUnsafe = _prim "WordU64_toWord64": int -> Int64.int;
+*)
val toWord8Unsafe = _prim "WordU64_toWord8": int -> Word8.word;
val toWord16Unsafe = _prim "WordU64_toWord16": int -> Word16.word;
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml 2006-02-14 03:58:19 UTC (rev 4357)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml 2006-02-15 03:30:28 UTC (rev 4358)
@@ -13,7 +13,7 @@
eqtype word
type t = word
- val wordSize': Primitive.Int32.int
+ val wordSize: Primitive.Int32.int
val + : word * word -> word
val andb : word * word -> word
@@ -45,11 +45,13 @@
val fromInt32Unsafe: Primitive.Int32.int -> word
val fromInt64Unsafe: Primitive.Int64.int -> word
+(*
(* Lowbits or zero extend. *)
val fromInt8ZUnsafe: Primitive.Int8.int -> word
val fromInt16ZUnsafe: Primitive.Int16.int -> word
val fromInt32ZUnsafe: Primitive.Int32.int -> word
val fromInt64ZUnsafe: Primitive.Int64.int -> word
+*)
(* Lowbits or zero extend. *)
val fromWord8Unsafe: Primitive.Word8.word -> word
@@ -98,7 +100,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord1": big -> word;
val toBig = _prim "WordU1_toWord8": word -> big;
- val wordSize' : Int32.int = 1
+ val wordSize: Int32.int = 1
end
structure Word2 =
struct
@@ -106,7 +108,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord2": big -> word;
val toBig = _prim "WordU2_toWord8": word -> big;
- val wordSize' : Int32.int = 2
+ val wordSize: Int32.int = 2
end
structure Word3 =
struct
@@ -114,7 +116,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord3": big -> word;
val toBig = _prim "WordU3_toWord8": word -> big;
- val wordSize' : Int32.int = 3
+ val wordSize: Int32.int = 3
end
structure Word4 =
struct
@@ -122,7 +124,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord4": big -> word;
val toBig = _prim "WordU4_toWord8": word -> big;
- val wordSize' : Int32.int = 4
+ val wordSize: Int32.int = 4
end
structure Word5 =
struct
@@ -130,7 +132,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord5": big -> word;
val toBig = _prim "WordU5_toWord8": word -> big;
- val wordSize' : Int32.int = 5
+ val wordSize: Int32.int = 5
end
structure Word6 =
struct
@@ -138,7 +140,7 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord6": big -> word;
val toBig = _prim "WordU6_toWord8": word -> big;
- val wordSize' : Int32.int = 6
+ val wordSize: Int32.int = 6
end
structure Word7 =
struct
@@ -146,13 +148,13 @@
type big = Word8.word
val fromBigUnsafe = _prim "WordU8_toWord7": big -> word;
val toBig = _prim "WordU7_toWord8": word -> big;
- val wordSize' : Int32.int = 7
+ val wordSize: Int32.int = 7
end
structure Word8 =
struct
open Word8
- val wordSize' : Int32.int = 8
+ val wordSize: Int32.int = 8
val + = _prim "Word8_add": word * word -> word;
val andb = _prim "Word8_andb": word * word -> word;
@@ -177,10 +179,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord8": Int64.int -> word;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord8": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord8": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord8": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord8": Int64.int -> word;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> word;
@@ -227,7 +231,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord9": big -> word;
val toBig = _prim "WordU9_toWord16": word -> big;
- val wordSize' : Int32.int = 9
+ val wordSize: Int32.int = 9
end
structure Word10 =
struct
@@ -235,7 +239,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord10": big -> word;
val toBig = _prim "WordU10_toWord16": word -> big;
- val wordSize' : Int32.int = 10
+ val wordSize: Int32.int = 10
end
structure Word11 =
struct
@@ -243,7 +247,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord11": big -> word;
val toBig = _prim "WordU11_toWord16": word -> big;
- val wordSize' : Int32.int = 11
+ val wordSize: Int32.int = 11
end
structure Word12 =
struct
@@ -251,7 +255,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord12": big -> word;
val toBig = _prim "WordU12_toWord16": word -> big;
- val wordSize' : Int32.int = 12
+ val wordSize: Int32.int = 12
end
structure Word13 =
struct
@@ -259,7 +263,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord13": big -> word;
val toBig = _prim "WordU13_toWord16": word -> big;
- val wordSize' : Int32.int = 13
+ val wordSize: Int32.int = 13
end
structure Word14 =
struct
@@ -267,7 +271,7 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord14": big -> word;
val toBig = _prim "WordU14_toWord16": word -> big;
- val wordSize' : Int32.int = 14
+ val wordSize: Int32.int = 14
end
structure Word15 =
struct
@@ -275,13 +279,13 @@
type big = Word16.word
val fromBigUnsafe = _prim "WordU16_toWord15": big -> word;
val toBig = _prim "WordU15_toWord16": word -> big;
- val wordSize' : Int32.int = 15
+ val wordSize: Int32.int = 15
end
structure Word16 =
struct
open Word16
- val wordSize' : Int32.int = 16
+ val wordSize: Int32.int = 16
val + = _prim "Word16_add": word * word -> word;
val andb = _prim "Word16_andb": word * word -> word;
@@ -306,10 +310,12 @@
val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> word;
val fromInt64Unsafe = _prim "WordS64_toWord16": Int64.int -> word;
+(*
val fromInt8ZUnsafe = _prim "WordU8_toWord16": Int8.int -> word;
val fromInt16ZUnsafe = _prim "WordU16_toWord16": Int16.int -> word;
val fromInt32ZUnsafe = _prim "WordU32_toWord16": Int32.int -> word;
val fromInt64ZUnsafe = _prim "WordU64_toWord16": Int64.int -> word;
+*)
val fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> word;
val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> word;
@@ -356,7 +362,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord17": big -> word;
val toBig = _prim "WordU17_toWord32": word -> big;
- val wordSize' : Int32.int = 17
+ val wordSize: Int32.int = 17
end
structure Word18 =
struct
@@ -364,7 +370,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord18": big -> word;
val toBig = _prim "WordU18_toWord32": word -> big;
- val wordSize' : Int32.int = 18
+ val wordSize: Int32.int = 18
end
structure Word19 =
struct
@@ -372,7 +378,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord19": big -> word;
val toBig = _prim "WordU19_toWord32": word -> big;
- val wordSize' : Int32.int = 19
+ val wordSize: Int32.int = 19
end
structure Word20 =
struct
@@ -380,7 +386,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord20": big -> word;
val toBig = _prim "WordU20_toWord32": word -> big;
- val wordSize' : Int32.int = 20
+ val wordSize: Int32.int = 20
end
structure Word21 =
struct
@@ -388,7 +394,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord21": big -> word;
val toBig = _prim "WordU21_toWord32": word -> big;
- val wordSize' : Int32.int = 21
+ val wordSize: Int32.int = 21
end
structure Word22 =
struct
@@ -396,7 +402,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord22": big -> word;
val toBig = _prim "WordU22_toWord32": word -> big;
- val wordSize' : Int32.int = 22
+ val wordSize: Int32.int = 22
end
structure Word23 =
struct
@@ -404,7 +410,7 @@
type big = Word32.word
val fromBigUnsafe = _prim "WordU32_toWord23": big -> word;
val toBig = _prim "WordU23_toWord32": word -> big;
- val wordSize' : Int32.int = 23
+ val wordSize: Int32.in...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-13 19:58:22
|
More refactoring
----------------------------------------------------------------------
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string-cvt.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/reader.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/reader.sml
----------------------------------------------------------------------
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -1,46 +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 SeqIndex =
- struct
- open SeqIndex
-
- local
- open Primitive
- structure S =
- SeqIndex_ChooseIntN
- (type 'a t = IntInf.int -> 'a
- val fInt8 = fn i => Word8.toInt8X (IntInf.toWord8X i)
- val fInt16 = fn i => Word16.toInt16X (IntInf.toWord16X i)
- val fInt32 = fn i => Word32.toInt32X (IntInf.toWord32X i)
- val fInt64 = fn i => Word64.toInt64X (IntInf.toWord64X i))
- structure S =
- Int_ChooseInt
- (type 'a t = 'a -> int
- val fInt8 = fromInt8Unsafe
- val fInt16 = fromInt16Unsafe
- val fInt32 = fromInt32Unsafe
- val fInt64 = fromInt64Unsafe
- val fIntInf = S.f)
- in
- val fromIntUnsafe = S.f
- end
-
- local
- structure S =
- Int_ChooseInt
- (type 'a t = int -> 'a
- val fInt8 = toInt8Unsafe
- val fInt16 = toInt16Unsafe
- val fInt32 = toInt32Unsafe
- val fInt64 = toInt64Unsafe
- val fIntInf = toIntInf)
- in
- val toIntUnsafe = S.f
- end
- end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-14 03:58:19 UTC (rev 4357)
@@ -62,7 +62,6 @@
../list/list-pair.sml
../arrays-and-vectors/slice.sig
../arrays-and-vectors/sequence.sig
- ../arrays-and-vectors/seq-index1.sml
../arrays-and-vectors/sequence.fun
../arrays-and-vectors/vector-slice.sig
../arrays-and-vectors/vector.sig
@@ -81,16 +80,16 @@
../arrays-and-vectors/mono-array2.sig
../arrays-and-vectors/mono-array2.fun
../arrays-and-vectors/mono.sml
+ ../text/string0.sml
+ ../text/char0.sml
+ ../util/reader.sig
+ ../util/reader.sml
+ ../text/string-cvt.sig
+ ../text/string-cvt.sml
+ ../general/bool.sig
+ ../general/bool.sml
+ ../integer/integer.sig
(*
- ../../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
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -58,6 +58,13 @@
val toString8: int -> Primitive.String8.string
(* Sign extend. *)
+ 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 fromIntInfUnsafe: Primitive.IntInf.int -> int
+
+ (* Sign extend. *)
val fromInt8: Primitive.Int8.int -> int
val fromInt16: Primitive.Int16.int -> int
val fromInt32: Primitive.Int32.int -> int
@@ -65,17 +72,36 @@
val fromIntInf: Primitive.IntInf.int -> int
(* Zero extend. *)
+ val fromWord8Unsafe: Primitive.Word8.word -> int
+ val fromWord16Unsafe: Primitive.Word16.word -> int
+ val fromWord32Unsafe: Primitive.Word32.word -> int
+ val fromWord64Unsafe: Primitive.Word64.word -> int
+
+ (* Zero extend. *)
val fromWord8: Primitive.Word8.word -> int
val fromWord16: Primitive.Word16.word -> int
val fromWord32: Primitive.Word32.word -> int
val fromWord64: Primitive.Word64.word -> int
(* Sign extend. *)
+ val fromWord8XUnsafe: Primitive.Word8.word -> int
+ val fromWord16XUnsafe: Primitive.Word16.word -> int
+ val fromWord32XUnsafe: Primitive.Word32.word -> int
+ val fromWord64XUnsafe: Primitive.Word64.word -> int
+
+ (* Sign extend. *)
val fromWord8X: Primitive.Word8.word -> int
val fromWord16X: Primitive.Word16.word -> int
val fromWord32X: Primitive.Word32.word -> int
val fromWord64X: Primitive.Word64.word -> int
+ (* Lowbits. *)
+ 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 toIntInfUnsafe: int -> Primitive.IntInf.int
+
(* Overflow checking. *)
val toInt8: int -> Primitive.Int8.int
val toInt16: int -> Primitive.Int16.int
@@ -84,12 +110,24 @@
val toIntInf: int -> Primitive.IntInf.int
(* Lowbits. *)
+ val toWord8Unsafe: int -> Primitive.Word8.word
+ val toWord16Unsafe: int -> Primitive.Word16.word
+ val toWord32Unsafe: int -> Primitive.Word32.word
+ val toWord64Unsafe: int -> Primitive.Word64.word
+
+ (* Lowbits. *)
val toWord8: int -> Primitive.Word8.word
val toWord16: int -> Primitive.Word16.word
val toWord32: int -> Primitive.Word32.word
val toWord64: int -> Primitive.Word64.word
(* Lowbits. *)
+ val toWord8XUnsafe: int -> Primitive.Word8.word
+ val toWord16XUnsafe: int -> Primitive.Word16.word
+ val toWord32XUnsafe: int -> Primitive.Word32.word
+ val toWord64XUnsafe: int -> Primitive.Word64.word
+
+ (* Lowbits. *)
val toWord8X: int -> Primitive.Word8.word
val toWord16X: int -> Primitive.Word16.word
val toWord32X: int -> Primitive.Word32.word
@@ -262,7 +300,11 @@
then fromWordAux8 (false, Word8.fromInt8 i)
else fromWordAux8 (true, Word8.~ (Word8.fromInt8 i))
fun fromWord8X w = fromInt8 (Word8.toInt8X w)
+ val fromInt8Unsafe = fromInt8
+ val fromWord8Unsafe = fromWord8
+ val fromWord8XUnsafe = fromWord8X
+
val fromWordAux16 =
make {toMPLimb = MPLimb.fromWord16,
toObjptrWord = ObjptrWord.fromWord16,
@@ -276,6 +318,9 @@
then fromWordAux16 (false, Word16.fromInt16 i)
else fromWordAux16 (true, Word16.~ (Word16.fromInt16 i))
fun fromWord16X w = fromInt16 (Word16.toInt16X w)
+ val fromInt16Unsafe = fromInt16
+ val fromWord16Unsafe = fromWord16
+ val fromWord16XUnsafe = fromWord16X
val fromWordAux32 =
make {toMPLimb = MPLimb.fromWord32,
@@ -290,6 +335,9 @@
then fromWordAux32 (false, Word32.fromInt32 i)
else fromWordAux32 (true, Word32.~ (Word32.fromInt32 i))
fun fromWord32X w = fromInt32 (Word32.toInt32X w)
+ val fromInt32Unsafe = fromInt32
+ val fromWord32Unsafe = fromWord32
+ val fromWord32XUnsafe = fromWord32X
val fromWordAux64 =
make {toMPLimb = MPLimb.fromWord64,
@@ -304,8 +352,12 @@
then fromWordAux64 (false, Word64.fromInt64 i)
else fromWordAux64 (true, Word64.~ (Word64.fromInt64 i))
fun fromWord64X w = fromInt64 (Word64.toInt64X w)
+ val fromInt64Unsafe = fromInt64
+ val fromWord64Unsafe = fromWord64
+ val fromWord64XUnsafe = fromWord64X
fun fromIntInf i = i
+ fun fromIntInfUnsafe i = i
end
local
@@ -405,6 +457,9 @@
else ans
end
else Word8.toInt8 ans
+ val toWord8Unsafe = toWord8
+ val toWord8XUnsafe = toWord8X
+ fun toInt8Unsafe i = Word8.toInt8X (toWord8X i)
val toWordAux16 =
make {fromMPLimb = MPLimb.toWord16,
@@ -433,6 +488,9 @@
else ans
end
else Word16.toInt16 ans
+ val toWord16Unsafe = toWord16
+ val toWord16XUnsafe = toWord16X
+ fun toInt16Unsafe i = Word16.toInt16X (toWord16X i)
val toWordAux32 =
make {fromMPLimb = MPLimb.toWord32,
@@ -461,6 +519,9 @@
else ans
end
else Word32.toInt32 ans
+ val toWord32Unsafe = toWord32
+ val toWord32XUnsafe = toWord32X
+ fun toInt32Unsafe i = Word32.toInt32X (toWord32X i)
val toWordAux64 =
make {fromMPLimb = MPLimb.toWord64,
@@ -489,8 +550,12 @@
else ans
end
else Word64.toInt64 ans
+ val toWord64Unsafe = toWord64
+ val toWord64XUnsafe = toWord64X
+ fun toInt64Unsafe i = Word64.toInt64X (toWord64X i)
fun toIntInf i = i
+ fun toIntInfUnsafe i = i
end
local
@@ -861,56 +926,94 @@
val toString8 = bigToString8
end
+structure Char8 =
+ struct
+ open Char8
+ fun fromIntInfUnsafe i = fromInt8Unsafe (IntInf.toInt8Unsafe i)
+ fun toIntInfUnsafe c = IntInf.fromInt8Unsafe (toInt8Unsafe c)
+ end
+structure Char16 =
+ struct
+ open Char16
+ fun fromIntInfUnsafe i = fromInt16Unsafe (IntInf.toInt16Unsafe i)
+ fun toIntInfUnsafe c = IntInf.fromInt16Unsafe (toInt16Unsafe c)
+ end
+structure Char32 =
+ struct
+ open Char32
+ fun fromIntInfUnsafe i = fromInt32Unsafe (IntInf.toInt32Unsafe i)
+ fun toIntInfUnsafe c = IntInf.fromInt32Unsafe (toInt32Unsafe c)
+ end
structure Int8 =
struct
open Int8
+ val fromIntInfUnsafe = IntInf.toInt8Unsafe
val fromIntInf = IntInf.toInt8
+ val toIntInfUnsafe = IntInf.fromInt8Unsafe
val toIntInf = IntInf.fromInt8
end
structure Int16 =
struct
open Int16
+ val fromIntInfUnsafe = IntInf.toInt16Unsafe
val fromIntInf = IntInf.toInt16
+ val toIntInfUnsafe = IntInf.fromInt16Unsafe
val toIntInf = IntInf.fromInt16
end
structure Int32 =
struct
open Int32
+ val fromIntInfUnsafe = IntInf.toInt32Unsafe
val fromIntInf = IntInf.toInt32
+ val toIntInfUnsafe = IntInf.fromInt32Unsafe
val toIntInf = IntInf.fromInt32
end
structure Int64 =
struct
open Int64
+ val fromIntInfUnsafe = IntInf.toInt64Unsafe
val fromIntInf = IntInf.toInt64
+ val toIntInfUnsafe = IntInf.fromInt64Unsafe
val toIntInf = IntInf.fromInt64
end
structure Word8 =
struct
open Word8
+ val fromIntInfUnsafe = IntInf.toWord8Unsafe
val fromIntInf = IntInf.toWord8
+ val toIntInfUnsafe = IntInf.fromWord8Unsafe
val toIntInf = IntInf.fromWord8
+ val toIntInfXUnsafe = IntInf.fromWord8XUnsafe
val toIntInfX = IntInf.fromWord8X
end
structure Word16 =
struct
open Word16
+ val fromIntInfUnsafe = IntInf.toWord16Unsafe
val fromIntInf = IntInf.toWord16
+ val toIntInfUnsafe = IntInf.fromWord16Unsafe
val toIntInf = IntInf.fromWord16
+ val toIntInfXUnsafe = IntInf.fromWord16XUnsafe
val toIntInfX = IntInf.fromWord16X
end
structure Word32 =
struct
open Word32
+ val fromIntInfUnsafe = IntInf.toWord32Unsafe
val fromIntInf = IntInf.toWord32
+ val toIntInfUnsafe = IntInf.fromWord32Unsafe
val toIntInf = IntInf.fromWord32
+ val toIntInfXUnsafe = IntInf.fromWord32XUnsafe
val toIntInfX = IntInf.fromWord32X
end
structure Word64 =
struct
open Word64
+ val fromIntInfUnsafe = IntInf.toWord64Unsafe
val fromIntInf = IntInf.toWord64
+ val toIntInfUnsafe = IntInf.fromWord64Unsafe
val toIntInf = IntInf.fromWord64
+ val toIntInfXUnsafe = IntInf.fromWord64XUnsafe
val toIntInfX = IntInf.fromWord64X
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -9,12 +9,24 @@
signature INT_FROM_TO_ARG =
sig
type int
+ (* Lowbits or sign-extend. *)
+ 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 fromIntInfUnsafe: Primitive.IntInf.int -> int
(* Overflow checking, signed interp. *)
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
+ (* Lowbits or sign-extend. *)
+ 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 toIntInfUnsafe: int -> Primitive.IntInf.int
(* Overflow checking. *)
val toInt8: int -> Primitive.Int8.int
val toInt16: int -> Primitive.Int16.int
@@ -26,8 +38,12 @@
signature INT_FROM_TO_RES =
sig
type int
+ val fromIntUnsafe: Int.int -> int
+ val fromLargeUnsafe: LargeInt.int -> int
val fromInt: Int.int -> int
val fromLarge: LargeInt.int -> int
+ val toIntUnsafe: int -> Int.int
+ val toLargeUnsafe: int -> LargeInt.int
val toInt: int -> Int.int
val toLarge: int -> LargeInt.int
end
@@ -40,6 +56,30 @@
structure S =
Int_ChooseInt
(type 'a t = 'a -> int
+ val fInt8 = I.fromInt8Unsafe
+ val fInt16 = I.fromInt16Unsafe
+ val fInt32 = I.fromInt32Unsafe
+ val fInt64 = I.fromInt64Unsafe
+ val fIntInf = I.fromIntInfUnsafe)
+ in
+ val fromIntUnsafe = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> int
+ val fInt8 = I.fromInt8Unsafe
+ val fInt16 = I.fromInt16Unsafe
+ val fInt32 = I.fromInt32Unsafe
+ val fInt64 = I.fromInt64Unsafe
+ val fIntInf = I.fromIntInfUnsafe)
+ in
+ val fromLargeUnsafe = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> int
val fInt8 = I.fromInt8
val fInt16 = I.fromInt16
val fInt32 = I.fromInt32
@@ -64,6 +104,30 @@
structure S =
Int_ChooseInt
(type 'a t = int -> 'a
+ val fInt8 = I.toInt8Unsafe
+ val fInt16 = I.toInt16Unsafe
+ val fInt32 = I.toInt32Unsafe
+ val fInt64 = I.toInt64Unsafe
+ val fIntInf = I.toIntInfUnsafe)
+ in
+ val toIntUnsafe = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = int -> 'a
+ val fInt8 = I.toInt8Unsafe
+ val fInt16 = I.toInt16Unsafe
+ val fInt32 = I.toInt32Unsafe
+ val fInt64 = I.toInt64Unsafe
+ val fIntInf = I.toIntInfUnsafe)
+ in
+ val toLargeUnsafe = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = int -> 'a
val fInt8 = I.toInt8
val fInt16 = I.toInt16
val fInt32 = I.toInt32
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig 2006-02-14 03:58:19 UTC (rev 4357)
@@ -1,30 +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.
- *)
-
-signature READER =
- sig
- type ('a, 'b) reader = 'b -> ('a * 'b) option
-
- (* read as many items as possible (never returns NONE) *)
- val list: ('a, 'b) reader -> ('a list, 'b) reader
-
- (* never return NONE *)
- (* val tokens: ('a -> bool) -> ('a, 'b) reader -> ('a list list, 'b) reader *)
- (* val fields: ('a -> bool) -> ('a, 'b) reader -> ('a list list, 'b) reader *)
-
- val map: ('a -> 'c) -> ('a, 'b) reader -> ('c, 'b) reader
- val mapOpt: ('a -> 'c option) -> ('a, 'b) reader -> ('c, 'b) reader
-
- val ignore: ('a -> bool) -> ('a, 'b) reader -> ('a, 'b) reader
-
- (* read excatly N items *)
- val readerN: ('a, 'b) reader * int -> ('a list, 'b) reader
- val reader2: ('a, 'b) reader -> ('a * 'a, 'b) reader
- val reader3: ('a, 'b) reader -> ('a * 'a * 'a, 'b) reader
- val reader4: ('a, 'b) reader -> ('a * 'a * 'a * 'a, 'b) reader
- end
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -1,103 +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 Reader: READER =
-struct
-
-open Primitive.Int
-
-type ('a, 'b) reader = 'b -> ('a * 'b) option
-
-(* local
- * fun make finish p reader state =
- * let
- * fun loop (state, token, tokens) =
- * case reader state of
- * NONE => SOME (rev (finish (token, tokens)), state)
- * | SOME (x, state) =>
- * let
- * val (token, tokens) =
- * if p x then ([], finish (token, tokens))
- * else (x :: token, tokens)
- * in loop (state, token, tokens)
- * end
- * in loop (state, [], [])
- * end
- * in
- * fun tokens p = make (fn (token, tokens) =>
- * case token of
- * [] => tokens
- * | _ => (rev token) :: tokens) p
- * fun fields p = make (fn (field, fields) => (rev field) :: fields) p
- * end
- *)
-
-fun list (reader: ('a, 'b) reader): ('a list, 'b) reader =
- fn state =>
- let
- fun loop (state, accum) =
- case reader state of
- NONE => SOME (rev accum, state)
- | SOME (a, state) => loop (state, a :: accum)
- in loop (state, [])
- end
-
-fun readerN (reader: ('a, 'b) reader, n: int): ('a list, 'b) reader =
- fn (state :'b) =>
- let
- fun loop (n, state, accum) =
- if n <= 0
- then SOME (rev accum, state)
- else case reader state of
- NONE => NONE
- | SOME (x, state) => loop (n - 1, state, x :: accum)
- in loop (n, state, [])
- end
-
-fun ignore f reader =
- let
- fun loop state =
- case reader state of
- NONE => NONE
- | SOME (x, state) =>
- if f x
- then loop state
- else SOME (x, state)
- in loop
- end
-val _ = ignore
-
-fun map (f: 'a -> 'c) (reader: ('a, 'b) reader): ('c, 'b) reader =
- fn (b: 'b) =>
- case reader b of
- NONE => NONE
- | SOME (a, b) => SOME (f a, b)
-
-fun mapOpt (f: 'a -> 'c option) (reader: ('a, 'b) reader): ('c, 'b) reader =
- fn (b: 'b) =>
- case reader b of
- NONE => NONE
- | SOME (a, b) =>
- case f a of
- NONE => NONE
- | SOME c => SOME (c, b)
-
-fun reader2 reader =
- map (fn [y, z] => (y, z) | _ => raise Fail "Reader.reader2")
- (readerN (reader, 2))
-val _ = reader2
-
-fun reader3 reader =
- map (fn [x, y, z] => (x, y, z) | _ => raise Fail "Reader.reader3")
- (readerN (reader, 3))
-
-fun reader4 reader =
- map (fn [w, x, y, z] => (w, x, y, z) | _ => raise Fail "Reader.reader4")
- (readerN (reader, 4))
-
-end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-char.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -18,25 +18,25 @@
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 fromInt8Unsafe = _prim "WordS8_toWord8": Int8.int -> char;
+ val fromInt16Unsafe = _prim "WordS16_toWord8": Int16.int -> char;
+ val fromInt32Unsafe = _prim "WordS32_toWord8": Int32.int -> char;
+ val fromInt64Unsafe = _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 fromWord8Unsafe = _prim "WordU8_toWord8": Word8.word -> char;
+ val fromWord16Unsafe = _prim "WordU16_toWord8": Word16.word -> char;
+ val fromWord32Unsafe = _prim "WordU32_toWord8": Word32.word -> char;
+ val fromWord64Unsafe = _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 toInt8Unsafe = _prim "WordS8_toWord8": char -> Int8.int;
+ val toInt16Unsafe = _prim "WordS8_toWord16": char -> Int16.int;
+ val toInt32Unsafe = _prim "WordS8_toWord32": char -> Int32.int;
+ val toInt64Unsafe = _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;
+ val toWord8Unsafe = _prim "WordU8_toWord8": char -> Word8.word;
+ val toWord16Unsafe = _prim "WordU8_toWord16": char -> Word16.word;
+ val toWord32Unsafe = _prim "WordU8_toWord32": char -> Word32.word;
+ val toWord64Unsafe = _prim "WordU8_toWord64": char -> Word64.word;
end
structure Char8 =
struct
@@ -54,25 +54,25 @@
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 fromInt8Unsafe = _prim "WordS8_toWord16": Int8.int -> char;
+ val fromInt16Unsafe = _prim "WordS16_toWord16": Int16.int -> char;
+ val fromInt32Unsafe = _prim "WordS32_toWord16": Int32.int -> char;
+ val fromInt64Unsafe = _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 fromWord8Unsafe = _prim "WordU8_toWord16": Word8.word -> char;
+ val fromWord16Unsafe = _prim "WordU16_toWord16": Word16.word -> char;
+ val fromWord32Unsafe = _prim "WordU32_toWord16": Word32.word -> char;
+ val fromWord64Unsafe = _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 toInt8Unsafe = _prim "WordS16_toWord8": char -> Int8.int;
+ val toInt16Unsafe = _prim "WordS16_toWord16": char -> Int16.int;
+ val toInt32Unsafe = _prim "WordS16_toWord32": char -> Int32.int;
+ val toInt64Unsafe = _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;
+ val toWord8Unsafe = _prim "WordU16_toWord8": char -> Word8.word;
+ val toWord16Unsafe = _prim "WordU16_toWord16": char -> Word16.word;
+ val toWord32Unsafe = _prim "WordU16_toWord32": char -> Word32.word;
+ val toWord64Unsafe = _prim "WordU16_toWord64": char -> Word64.word;
end
structure Char16 =
struct
@@ -90,25 +90,25 @@
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 fromInt8Unsafe = _prim "WordS8_toWord32": Int8.int -> char;
+ val fromInt16Unsafe = _prim "WordS16_toWord32": Int16.int -> char;
+ val fromInt32Unsafe = _prim "WordS32_toWord32": Int32.int -> char;
+ val fromInt64Unsafe = _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 fromWord8Unsafe = _prim "WordU8_toWord32": Word8.word -> char;
+ val fromWord16Unsafe = _prim "WordU16_toWord32": Word16.word -> char;
+ val fromWord32Unsafe = _prim "WordU32_toWord32": Word32.word -> char;
+ val fromWord64Unsafe = _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 toInt8Unsafe = _prim "WordS32_toWord8": char -> Int8.int;
+ val toInt16Unsafe = _prim "WordS32_toWord16": char -> Int16.int;
+ val toInt32Unsafe = _prim "WordS32_toWord32": char -> Int32.int;
+ val toInt64Unsafe = _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;
+ val toWord8Unsafe = _prim "WordU32_toWord8": char -> Word8.word;
+ val toWord16Unsafe = _prim "WordU32_toWord16": char -> Word16.word;
+ val toWord32Unsafe = _prim "WordU32_toWord32": char -> Word32.word;
+ val toWord64Unsafe = _prim "WordU32_toWord64": char -> Word64.word;
end
structure Char32 =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -8,38 +8,63 @@
structure Char0 =
struct
- open Primitive.Int Primitive.Char
+ open Char
type char = char
type string = string
- val minChar = #"\000"
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> char
+ val fInt8 = Char.fromInt8Unsafe
+ val fInt16 = Char.fromInt16Unsafe
+ val fInt32 = Char.fromInt32Unsafe
+ val fInt64 = Char.fromInt64Unsafe
+ val fIntInf = Char.fromIntInfUnsafe)
+ in
+ val chrUnsafe = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = char -> 'a
+ val fInt8 = Char.toInt8Unsafe
+ val fInt16 = Char.toInt16Unsafe
+ val fInt32 = Char.toInt32Unsafe
+ val fInt64 = Char.toInt64Unsafe
+ val fIntInf = Char.toIntInfUnsafe)
+ in
+ val ord = S.f
+ end
+
+ val minChar:char = #"\000"
val numChars: int = 256
val maxOrd: int = 255
- val maxChar = #"\255"
+ val maxChar:char = #"\255"
fun succ c =
- if Primitive.safe andalso c = maxChar
+ if Primitive.Controls.safe andalso c = maxChar
then raise Chr
- else Primitive.Char.chr (ord c + 1)
+ else chrUnsafe (Int.+ (ord c, 1))
fun pred c =
- if Primitive.safe andalso c = minChar
+ if Primitive.Controls.safe andalso c = minChar
then raise Chr
- else Primitive.Char.chr (ord c - 1)
+ else chrUnsafe (Int.- (ord c, 1))
fun chrOpt c =
- if Primitive.safe andalso Primitive.Int.gtu (c, maxOrd)
+ if Primitive.Controls.safe
+ andalso (Int.< (c, 0) orelse Int.> (c, maxOrd))
+ (* andalso Int.gtu (c, maxOrd) *)
then NONE
- else SOME (Primitive.Char.chr c)
+ else SOME (chrUnsafe c)
fun chr c =
case chrOpt c of
NONE => raise Chr
| SOME c => c
- val {compare, ...} = Util.makeCompare (op <)
-
structure String = String0
fun oneOf s =
@@ -47,9 +72,9 @@
val a = Array.array (numChars, false)
val n = String.size s
fun loop i =
- if Primitive.Int.>= (i, n) then ()
+ if Int.>= (i, n) then ()
else (Array.update (a, ord (String.sub (s, i)), true)
- ; loop (i + 1))
+ ; loop (Int.+ (i, 1)))
in loop 0
; fn c => Array.sub (a, ord c)
end
@@ -65,20 +90,20 @@
local
val not = fn f => memoize (not o f)
- infix or andd
- fun f or g = memoize (fn c => f c orelse g c)
- fun f andd g = memoize (fn c => f c andalso g c)
+ infix || &&
+ fun f || g = memoize (fn c => f c orelse g c)
+ fun f && g = memoize (fn c => f c andalso g c)
in
val isLower = oneOf "abcdefghijklmnopqrstuvwxyz"
val isUpper = oneOf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
val isDigit = oneOf "0123456789"
- val isAlpha = isUpper or isLower
- val isHexDigit = isDigit or (oneOf "abcdefABCDEF")
- val isAlphaNum = isAlpha or isDigit
+ val isAlpha = isUpper || isLower
+ val isHexDigit = isDigit || (oneOf "abcdefABCDEF")
+ val isAlphaNum = isAlpha || isDigit
val isPrint = fn c => #" " <= c andalso c <= #"~"
val isSpace = oneOf " \t\r\n\v\f"
- val isGraph = (not isSpace) andd isPrint
- val isPunct = isGraph andd (not isAlphaNum)
+ val isGraph = (not isSpace) && isPrint
+ val isPunct = isGraph && (not isAlphaNum)
val isCntrl = not isPrint
val isAscii = fn c => c < #"\128"
end
@@ -86,12 +111,11 @@
local
fun make (lower, upper, diff) =
memoize (fn c => if lower <= c andalso c <= upper
- then chr (ord c +? diff)
+ then chr (Int.+? (ord c, diff))
else c)
- val diff = ord #"A" - ord #"a"
+ val diff = Int.- (ord #"A", ord #"a")
in
- val toLower = make (#"A", #"Z", ~diff)
+ val toLower = make (#"A", #"Z", Int.~ diff)
val toUpper = make (#"a", #"z", diff)
end
end
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string-cvt.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string-cvt.sml 2006-02-13 18:15:50 UTC (rev 4356)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string-cvt.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -10,7 +10,7 @@
struct
open Reader
- val wordFromInt = Primitive.Word32.fromInt
+ val wordFromInt = Word.fromInt
datatype radix = BIN | OCT | DEC | HEX
@@ -29,7 +29,7 @@
type ('a, 'b) reader = 'b -> ('a * 'b) option
- open Primitive.Int
+ open Int
structure Char = Char0
structure String = String0
@@ -177,8 +177,8 @@
fun wdigits radix reader state =
let
- val op + = Primitive.Word32.+
- val op * = Primitive.Word32.*
+ val op + = Word.+
+ val op * = Word.*
val r = radixToWord radix
fun loop (accum, state) =
case reader state of
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/reader.sig (from rev 4350, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/reader.sml (from rev 4347, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sml 2006-02-05 14:22:33 UTC (rev 4347)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/util/reader.sml 2006-02-14 03:58:19 UTC (rev 4357)
@@ -0,0 +1,103 @@
+(* 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 Reader: READER =
+struct
+
+open Int
+
+type ('a, 'b) reader = 'b -> ('a * 'b) option
+
+(* local
+ * fun make finish p reader state =
+ * let
+ * fun loop (state, token, tokens) =
+ * case reader state of
+ * NONE => SOME (rev (finish (token, tokens)), state)
+ * | SOME (x, state) =>
+ * let
+ * val (token, tokens) =
+ * if p x then ([], finish (token, tokens))
+ * else (x :: token, tokens)
+ * in loop (state, token, tokens)
+ * end
+ * in loop (state, [], [])
+ * end
+ * in
+ * fun tokens p = make (fn (token, tokens) =>
+ * case token of
+ * [] => tokens
+ * | _ => (rev token) :: tokens) p
+ * fun fields p = make (fn (field, fields) => (rev field) :: fields) p
+ * end
+ *)
+
+fun list (reader: ('a, 'b) reader): ('a list, 'b) reader =
+ fn state =>
+ let
+ fun loop (state, accum) =
+ case reader state of
+ NONE => SOME (rev accum, state)
+ | SOME (a, state) => loop (state, a :: accum)
+ in loop (state, [])
+ end
+
+fun readerN (reader: ('a, 'b) reader, n: int): ('a list, 'b) reader =
+ fn (state :'b) =>
+ let
+ fun loop (n, state, accum) =
+ if n <= 0
+ then SOME (rev accum, state)
+ else case reader state of
+ NONE => NONE
+ | SOME (x, state) => loop (n - 1, state, x :: accum)
+ in loop (n, state, [])
+ end
+
+fun ignore f reader =
+ let
+ fun loop state =
+ case reader state of
+ NONE => NONE
+ | SOME (x, state) =>
+ if f x
+ then loop state
+ else SOME (x, state)
+ in loop
+ end
+val _ = ignore
+
+fun map (f: 'a -> 'c) (reader: ('a, 'b) reader): ('c, 'b) reader =
+ fn (b: 'b) =>
+ case reader b of
+ NONE => NONE
+ | SOME (a, b) => SOME (f a, b)
+
+fun mapOpt (f: 'a -> 'c option) (reader: ('a, 'b) reader): ('c, 'b) reader =
+ fn (b: 'b) =>
+ case reader b of
+ NONE => NONE
+ | SOME (a, b) =>
+ case f a of
+ NONE => NONE
+ | SOME c => SOME (c, b)
+
+fun reader2 reader =
+ map (fn [y, z] => (y, z) | _ => raise Fail "Reader.reader2")
+ (readerN (reader, 2))
+val _ = reader2
+
+fun reader3 reader =
+ map (fn [x, y, z] => (x, y, z) | _ => raise Fail "Reader.reader3")
+ (readerN (reader, 3))
+
+fun reader4 reader =
+ map (fn [w, x, y, z] => (w, x, y, z) | _ => raise Fail "Reader.reader4")
+ (readerN (reader, 4))
+
+end
|
|
From: Stephen W. <sw...@ml...> - 2006-02-13 10:15:51
|
Added libc6-dev to Debian "Depends".
----------------------------------------------------------------------
U mlton/trunk/package/debian/control
----------------------------------------------------------------------
Modified: mlton/trunk/package/debian/control
===================================================================
--- mlton/trunk/package/debian/control 2006-02-12 21:32:28 UTC (rev 4355)
+++ mlton/trunk/package/debian/control 2006-02-13 18:15:50 UTC (rev 4356)
@@ -7,7 +7,7 @@
Package: mlton
Architecture: hppa i386 powerpc sparc
-Depends: ${shlibs:Depends}, gcc, libgmp3-dev (>= 4.0.1)
+Depends: ${shlibs:Depends}, gcc, libc6-dev, libgmp3-dev (>= 4.0.1)
Description: Optimizing compiler for Standard ML
MLton (mlton.org) is a whole-program optimizing
compiler for Standard ML. MLton generates
|
|
From: Matthew F. <fl...@ml...> - 2006-02-12 13:32:30
|
Refactoring arrays-and-vectors
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig 2006-02-12 21:32:28 UTC (rev 4355)
@@ -48,8 +48,15 @@
val concat: 'a slice list -> 'a array
val toList: 'a slice -> 'a list
+ val slice': 'a array * SeqIndex.int * SeqIndex.int option -> 'a slice
+ val unsafeSlice': 'a array * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSlice: 'a array * int * int option -> 'a slice
+ val sub': 'a slice * SeqIndex.int -> 'a
+ val unsafeSub': 'a slice * SeqIndex.int -> 'a
val unsafeSub: 'a slice * int -> 'a
+ val unsafeSubslice': 'a slice * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSubslice: 'a slice * int * int option -> 'a slice
+ val update': 'a slice * SeqIndex.int * 'a -> unit
+ val unsafeUpdate': 'a slice * SeqIndex.int * 'a -> unit
val unsafeUpdate: 'a slice * int * 'a -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-02-12 21:32:28 UTC (rev 4355)
@@ -40,7 +40,12 @@
structure ArraySlice: ARRAY_SLICE_EXTRA
+ val arrayUninit': SeqIndex.int -> 'a array
+ val arrayUninit: int -> 'a array
+ val array': SeqIndex.int * 'a -> 'a array
+ val unsafeSub': 'a array * SeqIndex.int -> 'a
val unsafeSub: 'a array * int -> 'a
+ val unsafeUpdate': 'a array * SeqIndex.int * 'a -> unit
val unsafeUpdate: 'a array * int * 'a -> unit
val concat: 'a array list -> 'a array
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml 2006-02-12 21:32:28 UTC (rev 4355)
@@ -69,8 +69,6 @@
end
end
- val array = new
-
local
fun make f arr = f (ArraySlice.full arr)
in
@@ -84,7 +82,14 @@
dst = dst, di = di}
end
+ val arrayUninit' = newUninit'
+ val arrayUninit = newUninit
+ val array' = new'
+ val array = new
+
+ fun update' (arr, i, x) = updateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun update (arr, i, x) = updateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate' (arr, i, x) = unsafeUpdateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun unsafeUpdate (arr, i, x) = unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
end
structure ArraySlice: ARRAY_SLICE_EXTRA = Array.ArraySlice
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array2.sml 2006-02-12 21:32:28 UTC (rev 4355)
@@ -6,68 +6,183 @@
* See the file MLton-LICENSE for details.
*)
-structure Array2: ARRAY2 =
+structure Array2 (* : ARRAY2 *) =
struct
- open Primitive.Int
- (* I am careful to use a type here instead of a datatype so that
- * 'a array will be an equality type irrespective of whether 'a is.
- * This is probably just an NJ-ism, but I don't want to think about it.
- *)
- type 'a array = {rows: int,
- cols: int,
- array: 'a Array.array}
+ val op +? = SeqIndex.+?
+ val op + = SeqIndex.+
+ val op -? = SeqIndex.-?
+ val op - = SeqIndex.-
+ val op *? = SeqIndex.*?
+ val op * = SeqIndex.*
+ val op < = SeqIndex.<
+ val op <= = SeqIndex.<=
+ val op > = SeqIndex.>
+ val op >= = SeqIndex.>=
+ val ltu = SeqIndex.ltu
+ val leu = SeqIndex.leu
+ val gtu = SeqIndex.gtu
+ val geu = SeqIndex.geu
- fun dimensions ({rows, cols, ...}: 'a array) = (rows, cols)
- fun nRows ({rows, ...}: 'a array) = rows
- fun nCols ({cols, ...}: 'a array) = cols
+ type 'a array = {array: 'a Array.array,
+ rows: SeqIndex.int,
+ cols: SeqIndex.int}
+ fun dimensions' ({rows, cols, ...}: 'a array) = (rows, cols)
+ fun dimensions ({rows, cols, ...}: 'a array) =
+ (SeqIndex.toIntUnsafe rows, SeqIndex.toIntUnsafe cols)
+ fun nRows' ({rows, ...}: 'a array) = rows
+ fun nRows ({rows, ...}: 'a array) = SeqIndex.toIntUnsafe rows
+ fun nCols' ({cols, ...}: 'a array) = cols
+ fun nCols ({cols, ...}: 'a array) = SeqIndex.toIntUnsafe cols
+
type 'a region = {base: 'a array,
row: int,
col: int,
nrows: int option,
ncols: int option}
- fun checkRegion {base, row, col, nrows, ncols} =
- let val (rows, cols) = dimensions base
- in {stopRow = Array.checkSliceMax (row, nrows, rows),
- stopCol = Array.checkSliceMax (col, ncols, cols)}
- end
-
- fun wholeRegion (a: 'a array): 'a region =
+ local
+ fun checkSliceMax' (start: int,
+ num: SeqIndex.int option,
+ max: SeqIndex.int): SeqIndex.int * SeqIndex.int =
+ case num of
+ NONE => if Primitive.Controls.safe
+ then let
+ val start =
+ (SeqIndex.fromInt start)
+ handle Overflow => raise Subscript
+ in
+ if gtu (start, max)
+ then raise Subscript
+ else (start, max)
+ end
+ else (SeqIndex.fromIntUnsafe start, max)
+ | SOME num => if Primitive.Controls.safe
+ then let
+ val start =
+ (SeqIndex.fromInt start)
+ handle Overflow => raise Subscript
+ in
+ if (start < 0 orelse num < 0
+ orelse start +? num > max)
+ then raise Subscript
+ else (start, start +? num)
+ end
+ else (SeqIndex.fromIntUnsafe start,
+ SeqIndex.fromIntUnsafe start +? num)
+ fun checkSliceMax (start: int,
+ num: int option,
+ max: SeqIndex.int): SeqIndex.int * SeqIndex.int =
+ if Primitive.Controls.safe
+ then (checkSliceMax' (start, Option.map SeqIndex.fromInt num, max))
+ handle Overflow => raise Subscript
+ else checkSliceMax' (start, Option.map SeqIndex.fromIntUnsafe num, max)
+ in
+ fun checkRegion' {base, row, col, nrows, ncols} =
+ let
+ val (rows, cols) = dimensions' base
+ val (startRow, stopRow) = checkSliceMax' (row, nrows, rows)
+ val (startCol, stopCol) = checkSliceMax' (col, ncols, cols)
+ in
+ {startRow = startRow, stopRow = stopRow,
+ startCol = startCol, stopCol = stopCol}
+ end
+ fun checkRegion {base, row, col, nrows, ncols} =
+ let
+ val (rows, cols) = dimensions' base
+ val (startRow, stopRow) = checkSliceMax (row, nrows, rows)
+ val (startCol, stopCol) = checkSliceMax (col, ncols, cols)
+ in
+ {startRow = startRow, stopRow = stopRow,
+ startCol = startCol, stopCol = stopCol}
+ end
+ end
+
+ fun wholeRegion (a as {rows, cols, ...}: 'a array): 'a region =
{base = a, row = 0, col = 0, nrows = NONE, ncols = NONE}
datatype traversal = RowMajor | ColMajor
local
fun make (rows, cols, doit) =
- if Primitive.safe andalso (rows < 0 orelse cols < 0)
+ if Primitive.Controls.safe
+ andalso (rows < 0 orelse cols < 0)
then raise Size
- else {rows = rows,
- cols = cols,
- array = doit (rows * cols handle Overflow => raise Size)}
+ else {array = doit (rows * cols handle Overflow => raise Size),
+ rows = rows,
+ cols = cols}
in
+ fun arrayUninit' (rows, cols) =
+ make (rows, cols, Array.arrayUninit')
+ fun array' (rows, cols, init) =
+ make (rows, cols, fn size => Array.array' (size, init))
+ end
+ local
+ fun make (rows, cols, doit) =
+ if Primitive.Controls.safe
+ then let
+ val rows =
+ (SeqIndex.fromInt rows)
+ handle Overflow => raise Size
+ val cols =
+ (SeqIndex.fromInt cols)
+ handle Overflow => raise Size
+ in
+ doit (rows, cols)
+ end
+ else doit (SeqIndex.fromIntUnsafe rows,
+ SeqIndex.fromIntUnsafe cols)
+ in
fun arrayUninit (rows, cols) =
- make (rows, cols, Primitive.Array.array)
+ make (rows, cols, fn (rows, cols) => arrayUninit' (rows, cols))
fun array (rows, cols, init) =
- make (rows, cols, fn size => Array.array (size, init))
+ make (rows, cols, fn (rows, cols) => array' (rows, cols, init))
end
fun array0 (): 'a array =
- {rows = 0,
- cols = 0,
- array = Primitive.Array.array 0}
+ {array = Array.arrayUninit' 0,
+ rows = 0,
+ cols = 0}
- fun spot ({rows, cols, ...}: 'a array, r, c) =
- if Primitive.safe andalso (geu (r, rows) orelse geu (c, cols))
+ fun unsafeSpot' (a as {cols, ...}: 'a array, r, c) =
+ r *? cols +? c
+ fun spot' (a as {rows, cols, ...}: 'a array, r, c) =
+ if Primitive.Controls.safe
+ andalso (geu (r, rows) orelse geu (c, cols))
then raise Subscript
- else r *? cols +? c
+ else unsafeSpot' (a, r, c)
- fun sub (a as {array, ...}: 'a array, r, c) =
- Primitive.Array.sub (array, spot (a, r, c))
+ fun unsafeSub' (a as {array, ...}: 'a array, r, c) =
+ Array.unsafeSub' (array, unsafeSpot' (a, r, c))
+ fun sub' (a as {array, ...}: 'a array, r, c) =
+ Array.unsafeSub' (array, spot' (a, r, c))
+ fun unsafeUpdate' (a as {array, ...}: 'a array, r, c, x) =
+ Array.unsafeUpdate' (array, unsafeSpot' (a, r, c), x)
+ fun update' (a as {array, ...}: 'a array, r, c, x) =
+ Array.unsafeUpdate' (array, spot' (a, r, c), x)
- fun update (a as {array, ...}: 'a array, r, c, x) =
- Primitive.Array.update (array, spot (a, r, c), x)
+ local
+ fun make (r, c, doit) =
+ if Primitive.Controls.safe
+ then let
+ val r =
+ (SeqIndex.fromInt r)
+ handle Overflow => raise Subscript
+ val c =
+ (SeqIndex.fromInt c)
+ handle Overflow => raise Subscript
+ in
+ doit (r, c)
+ end
+ else doit (SeqIndex.fromIntUnsafe r,
+ SeqIndex.fromIntUnsafe c)
+ in
+ fun sub (a, r, c) =
+ make (r, c, fn (r, c) => sub' (a, r, c))
+ fun update (a, r, c, x) =
+ make (r, c, fn (r, c) => update' (a, r, c, x))
+ end
fun 'a fromList (rows: 'a list list): 'a array =
case rows of
@@ -75,18 +190,19 @@
| row1 :: _ =>
let
val cols = length row1
- val a as {array, ...} = arrayUninit (length rows, cols)
+ val a as {array, rows = rows', cols = cols', ...} =
+ arrayUninit (length rows, cols)
val _ =
List.foldl
(fn (row: 'a list, i) =>
let
- val max = i +? cols
+ val max = i +? cols'
val i' =
List.foldl (fn (x: 'a, i) =>
(if i >= max
then raise Size
- else (Primitive.Array.update (array, i, x)
- ; i + 1)))
+ else (Array.unsafeUpdate' (array, i, x)
+ ; i +? 1)))
i row
in if i' = max
then i'
@@ -97,37 +213,77 @@
a
end
- fun row ({rows, cols, array}, r) =
- if Primitive.safe andalso geu (r, rows)
+ fun row' ({array, rows, cols}, r) =
+ if Primitive.Controls.safe andalso geu (r, rows)
then raise Subscript
else
- ArraySlice.vector (ArraySlice.slice (array, r *? cols, SOME cols))
-
- fun column (a as {rows, cols, ...}: 'a array, c) =
- if Primitive.safe andalso geu (c, cols)
+ ArraySlice.vector (ArraySlice.slice' (array, r *? cols, SOME cols))
+ fun row (a, r) =
+ if Primitive.Controls.safe
+ then let
+ val r =
+ (SeqIndex.fromInt r)
+ handle Overflow => raise Subscript
+ in
+ row' (a, r)
+ end
+ else row' (a, SeqIndex.fromIntUnsafe r)
+ fun column' (a as {rows, cols, ...}: 'a array, c) =
+ if Primitive.Controls.safe andalso geu (c, cols)
then raise Subscript
else
- Vector.tabulate (rows, fn r => sub(a, r, c))
+ Vector.tabulate' (rows, fn r => unsafeSub' (a, r, c))
+ fun column (a, c) =
+ if Primitive.Controls.safe
+ then let
+ val c =
+ (SeqIndex.fromInt c)
+ handle Overflow => raise Subscript
+ in
+ column' (a, c)
+ end
+ else column' (a, SeqIndex.fromIntUnsafe c)
- fun foldi trv f b (region as {base, row, col, ...}) =
+ fun foldi' trv f b (region as {base, row, col, ...}) =
let
- val {stopRow, stopCol} = checkRegion region
+ val {startRow, stopRow, startCol, stopCol} = checkRegion region
in
case trv of
RowMajor =>
- Util.naturalFoldStartStop
- (row, stopRow, b, fn (r, b) =>
- Util.naturalFoldStartStop
- (col, stopCol, b, fn (c, b) =>
- f (r, c, sub (base, r, c), b)))
+ let
+ fun loopRow (r, b) =
+ if r >= stopRow then b
+ else let
+ fun loopCol (c, b) =
+ if c >= stopCol then b
+ else loopCol (c +? 1, f (r, c, sub' (base, r, c), b))
+ in
+ loopRow (r +? 1, loopCol (startCol, b))
+ end
+ in
+ loopRow (startRow, b)
+ end
| ColMajor =>
- Util.naturalFoldStartStop
- (col, stopCol, b, fn (c, b) =>
- Util.naturalFoldStartStop
- (row, stopRow, b, fn (r, b) =>
- f (r, c, sub (base, r, c), b)))
+ let
+ fun loopCol (c, b) =
+ if c >= stopCol then b
+ else let
+ fun loopRow (r, b) =
+ if r >= stopRow then b
+ else loopRow (r +? 1, f (r, c, sub' (base, r, c), b))
+ in
+ loopCol (c +? 1, loopRow (startRow, b))
+ end
+ in
+ loopCol (startCol, b)
+ end
end
+ fun foldi trv f b a =
+ foldi' trv (fn (r, c, x, b) =>
+ f (SeqIndex.toIntUnsafe r,
+ SeqIndex.toIntUnsafe c,
+ x, b)) b a
fun fold trv f b a =
foldi trv (fn (_, _, x, b) => f (x, b)) b (wholeRegion a)
@@ -142,6 +298,7 @@
fun modify trv f a = modifyi trv (f o #3) (wholeRegion a)
fun tabulate trv (rows, cols, f) =
+(*
if !Primitive.usesCallcc
then
(* All this mess is careful to construct a list representing
@@ -204,20 +361,23 @@
; {rows = rows, cols = cols, array = a}
end
else
+*)
let val a = arrayUninit (rows, cols)
in modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
; a
end
- fun copy {src = src as {base, row, col, ...}: 'a region,
+ fun copy {src = src as {base, ...}: 'a region,
dst, dst_row, dst_col} =
let
- val {stopRow, stopCol} = checkRegion src
- val nrows = stopRow -? row
- val ncols = stopCol -? col
- val _ = checkRegion {base = dst, row = dst_row, col = dst_col,
- nrows = SOME nrows, ncols = SOME ncols}
- fun for (start, stop, f: int -> unit) =
+ val {startRow, stopRow, startCol, stopCol} = checkRegion src
+ val nrows = stopRow -? startRow
+ val ncols = stopCol -? startCol
+ val {startRow = dst_row, startCol = dst_col, ...} =
+ checkRegion' {base = dst, row = dst_row, col = dst_col,
+ nrows = SOME nrows,
+ ncols = SOME ncols}
+ fun forUp (start, stop, f: SeqIndex.int -> unit) =
let
fun loop i =
if i >= stop
@@ -225,7 +385,7 @@
else (f i; loop (i + 1))
in loop start
end
- fun forDown (start, stop, f: int -> unit) =
+ fun forDown (start, stop, f: SeqIndex.int -> unit) =
let
fun loop i =
if i < start
@@ -233,11 +393,11 @@
else (f i; loop (i - 1))
in loop (stop -? 1)
end
- val forRows = if row <= dst_row then forDown else for
- val forCols = if col <= dst_col then for else forDown
+ val forRows = if startRow <= dst_row then forDown else forUp
+ val forCols = if startCol <= dst_col then forUp else forDown
in forRows (0, nrows, fn r =>
- forCols (0, ncols, fn c =>
- update (dst, dst_row +? r, dst_col +? c,
- sub (base, row +? r, col +? c))))
+ forCols (0, ncols, fn c =>
+ unsafeUpdate' (dst, dst_row +? r, dst_col +? c,
+ unsafeSub' (base, startRow +? r, startCol +? c))))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono.sml 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono.sml 2006-02-12 21:32:28 UTC (rev 4355)
@@ -44,7 +44,7 @@
end
local
- structure S = EqMono (type elem = Bool.bool)
+ structure S = EqMono (type elem = Primitive.Bool.bool)
open S
in
structure BoolVector = Vector
@@ -54,24 +54,9 @@
structure BoolArray2 = Array2
end
local
- structure S:>
- EQ_MONO
- where type Array.elem = char
- where type Vector.vector = string
- = EqMono (type elem = char)
+ structure S = EqMono (type elem = Primitive.Int8.int)
open S
in
- structure CharArray = Array
- structure CharArray2 = Array2
- structure CharArraySlice = ArraySlice
- structure CharVector = Vector
- structure CharVectorSlice = VectorSlice
- val _ = CharVector.fromArray: CharArray.array -> CharVector.vector
-end
-local
- structure S = EqMono (type elem = Int8.int)
- open S
-in
structure Int8Vector = Vector
structure Int8VectorSlice = VectorSlice
structure Int8Array = Array
@@ -79,7 +64,7 @@
structure Int8Array2 = Array2
end
local
- structure S = EqMono (type elem = Int16.int)
+ structure S = EqMono (type elem = Primitive.Int16.int)
open S
in
structure Int16Vector = Vector
@@ -89,7 +74,7 @@
structure Int16Array2 = Array2
end
local
- structure S = EqMono (type elem = Int32.int)
+ structure S = EqMono (type elem = Primitive.Int32.int)
open S
in
structure Int32Vector = Vector
@@ -99,7 +84,7 @@
structure Int32Array2 = Array2
end
local
- structure S = EqMono (type elem = Int64.int)
+ structure S = EqMono (type elem = Primitive.Int64.int)
open S
in
structure Int64Vector = Vector
@@ -109,7 +94,7 @@
structure Int64Array2 = Array2
end
local
- structure S = EqMono (type elem = IntInf.int)
+ structure S = EqMono (type elem = Primitive.IntInf.int)
open S
in
structure IntInfVector = Vector
@@ -119,7 +104,7 @@
structure IntInfArray2 = Array2
end
local
- structure S = Mono (type elem = Real32.real)
+ structure S = Mono (type elem = Primitive.Real32.real)
open S
in
structure Real32Vector = Vector
@@ -129,7 +114,7 @@
structure Real32Array2 = Array2
end
local
- structure S = Mono (type elem = Real64.real)
+ structure S = Mono (type elem = Primitive.Real64.real)
open S
in
structure Real64Vector = Vector
@@ -139,10 +124,7 @@
structure Real64Array2 = Array2
end
local
- structure S:>
- EQ_MONO
- where type Array.elem = Word8.word
- = EqMono (type elem = Word8.word)
+ structure S = EqMono (type elem = Primitive.Word8.word)
open S
in
structure Word8Vector = Vector
@@ -152,7 +134,7 @@
structure Word8Array2 = Array2
end
local
- structure S = EqMono (type elem = Word16.word)
+ structure S = EqMono (type elem = Primitive.Word16.word)
open S
in
structure Word16Vector = Vector
@@ -162,7 +144,7 @@
structure Word16Array2 = Array2
end
local
- structure S = EqMono (type elem = Word32.word)
+ structure S = EqMono (type elem = Primitive.Word32.word)
open S
in
structure Word32Vector = Vector
@@ -172,7 +154,7 @@
structure Word32Array2 = Array2
end
local
- structure S = EqMono (type elem = Word64.word)
+ structure S = EqMono (type elem = Primitive.Word64.word)
open S
in
structure Word64Vector = Vector
@@ -182,38 +164,74 @@
structure Word64Array2 = Array2
end
-structure IntVector = Int32Vector
-structure IntVectorSlice = Int32VectorSlice
-structure IntArray = Int32Array
-structure IntArraySlice = Int32ArraySlice
-structure IntArray2 = Int32Array2
-structure LargeIntVector = IntInfVector
-structure LargeIntVectorSlice = IntInfVectorSlice
-structure LargeIntArray = IntInfArray
-structure LargeIntArraySlice = IntInfArraySlice
-structure LargeIntArray2 = IntInfArray2
-
-structure RealVector = Real64Vector
-structure RealVectorSlice = Real64VectorSlice
-structure RealArray = Real64Array
-structure RealArraySlice = Real64ArraySlice
-structure RealArray2 = Real64Array2
-
-structure LargeRealVector = Real64Vector
-structure LargeRealVectorSlice = Real64VectorSlice
-structure LargeRealArray = Real64Array
-structure LargeRealArraySlice = Real64ArraySlice
-structure LargeRealArray2 = Real64Array2
-
-structure WordVector = Word32Vector
-structure WordVectorSlice = Word32VectorSlice
-structure WordArray = Word32Array
-structure WordArraySlice = Word32ArraySlice
-structure WordArray2 = Word32Array2
-
-structure LargeWordVector = Word64Vector
-structure LargeWordVectorSlice = Word64VectorSlice
-structure LargeWordArray = Word64Array
-structure LargeWordArraySlice = Word64ArraySlice
-structure LargeWordArray2 = Word64Array2
+local
+ structure S = EqMono (type elem = Char.char)
+ open S
+in
+ structure CharArray = Array
+ structure CharArray2 = Array2
+ structure CharArraySlice = ArraySlice
+ structure CharVector = Vector
+ structure CharVectorSlice = VectorSlice
+end
+local
+ structure S = EqMono (type elem = Int.int)
+ open S
+in
+ structure IntVector = Vector
+ structure IntVectorSlice = VectorSlice
+ structure IntArray = Array
+ structure IntArraySlice = ArraySlice
+ structure IntArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = LargeInt.int)
+ open S
+in
+ structure LargeIntVector = Vector
+ structure LargeIntVectorSlice = VectorSlice
+ structure LargeIntArray = Array
+ structure LargeIntArraySlice = ArraySlice
+ structure LargeIntArray2 = Array2
+end
+local
+ structure S = Mono (type elem = Real.real)
+ open S
+in
+ structure RealVector = Vector
+ structure RealVectorSlice = VectorSlice
+ structure RealArray = Array
+ structure RealArraySlice = ArraySlice
+ structure RealArray2 = Array2
+end
+local
+ structure S = Mono (type elem = LargeReal.real)
+ open S
+in
+ structure LargeRealVector = Vector
+ structure LargeRealVectorSlice = VectorSlice
+ structure LargeRealArray = Array
+ structure LargeRealArraySlice = ArraySlice
+ structure LargeRealArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = Word.word)
+ open S
+in
+ structure WordVector = Vector
+ structure WordVectorSlice = VectorSlice
+ structure WordArray = Array
+ structure WordArraySlice = ArraySlice
+ structure WordArray2 = Array2
+end
+local
+ structure S = EqMono (type elem = LargeWord.word)
+ open S
+in
+ structure LargeWordVector = Vector
+ structure LargeWordVectorSlice = VectorSlice
+ structure LargeWordArray = Array
+ structure LargeWordArraySlice = ArraySlice
+ structure LargeWordArray2 = Array2
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-12 21:32:28 UTC (rev 4355)
@@ -76,20 +76,23 @@
handle Overflow => raise Fail "Sequence.length"
else SeqIndex.toIntUnsafe (length' s)
- fun array' n =
+ fun arrayUninit' n =
if not S.isMutable andalso n = 0
then Array.array0Const ()
else if Primitive.Controls.safe
andalso (n < 0 orelse n > maxLen')
then raise Size
else Array.arrayUnsafe n
- fun array n = array' (fromIntForLength n)
+ fun arrayUninit n = arrayUninit' (fromIntForLength n)
- fun seq0 () = S.fromArray (array' 0)
+ fun newUninit' n = S.fromArray (arrayUninit' n)
+ fun newUninit n = S.fromArray (arrayUninit n)
+ fun seq0 () = S.fromArray (arrayUninit' 0)
+
fun unfoldi' (n, b, f) =
let
- val a = array' n
+ val a = arrayUninit' n
fun loop (i, b) =
if i >= n
then ()
@@ -112,11 +115,12 @@
fun tabulate (n, f) =
unfoldi (n, (), fn (i, ()) => (f i, ()))
+ fun new' (n, x) = tabulate' (n, fn _ => x)
fun new (n, x) = tabulate (n, fn _ => x)
fun fromList l =
let
- val a = array (List.length l)
+ val a = arrayUninit (List.length l)
val _ =
List.foldl (fn (x, i) => (Array.updateUnsafe (a, i, x) ; (i +? 1))) 0 l
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-12 21:32:28 UTC (rev 4355)
@@ -80,6 +80,9 @@
val create: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
('a elt -> 'b elt) -> 'a sequence -> 'c
val duplicate: 'a sequence -> 'a sequence
+ val newUninit': SeqIndex.int -> 'a sequence
+ val newUninit: int -> 'a sequence
+ val new': SeqIndex.int * 'a elt -> 'a sequence
val new: int * 'a elt -> 'a sequence
val toList: 'a sequence -> 'a elt list
val unfoldi': SeqIndex.int * 'a * (SeqIndex.int * 'a -> 'b elt * 'a) -> 'b sequence
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig 2006-02-12 21:32:28 UTC (rev 4355)
@@ -26,10 +26,10 @@
val appi: (int * 'a -> unit) -> 'a slice -> unit
val app: ('a -> unit) -> 'a slice -> unit
val mapi: (int * 'a -> 'b) -> 'a slice -> 'b Vector.vector
- val map: ('a -> 'b) -> 'a slice -> 'b Vector.vector
+ val map: ('a -> 'b) -> 'a slice -> 'b Vector.vector
val foldli: (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+ val foldl: ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
val foldri: (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
- val foldl: ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
val foldr: ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
val findi: (int * 'a -> bool) -> 'a slice -> (int * 'a) option
val find: ('a -> bool) -> 'a slice -> 'a option
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-12 18:36:59 UTC (rev 4354)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-12 21:32:28 UTC (rev 4355)
@@ -71,19 +71,17 @@
../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
|
|
From: Matthew F. <fl...@ml...> - 2006-02-12 10:36:59
|
Refactoring arrays-and-vectors ---------------------------------------------------------------------- A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml ---------------------------------------------------------------------- Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml 2006-02-12 18:36:38 UTC (rev 4353) +++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/seq-index1.sml 2006-02-12 18:36:59 UTC (rev 4354) @@ -0,0 +1,46 @@ +(* 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 SeqIndex = + struct + open SeqIndex + + local + open Primitive + structure S = + SeqIndex_ChooseIntN + (type 'a t = IntInf.int -> 'a + val fInt8 = fn i => Word8.toInt8X (IntInf.toWord8X i) + val fInt16 = fn i => Word16.toInt16X (IntInf.toWord16X i) + val fInt32 = fn i => Word32.toInt32X (IntInf.toWord32X i) + val fInt64 = fn i => Word64.toInt64X (IntInf.toWord64X i)) + structure S = + Int_ChooseInt + (type 'a t = 'a -> int + val fInt8 = fromInt8Unsafe + val fInt16 = fromInt16Unsafe + val fInt32 = fromInt32Unsafe + val fInt64 = fromInt64Unsafe + val fIntInf = S.f) + in + val fromIntUnsafe = S.f + end + + local + structure S = + Int_ChooseInt + (type 'a t = int -> 'a + val fInt8 = toInt8Unsafe + val fInt16 = toInt16Unsafe + val fInt32 = toInt32Unsafe + val fInt64 = toInt64Unsafe + val fIntInf = toIntInf) + in + val toIntUnsafe = S.f + end + end |
|
From: Matthew F. <fl...@ml...> - 2006-02-12 10:36:41
|
Refactoring arrays-and-vectors
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -40,7 +40,6 @@
structure ArraySlice: ARRAY_SLICE_EXTRA
- val rawArray: int -> 'a array
val unsafeSub: 'a array * int -> 'a
val unsafeUpdate: 'a array * int * 'a -> unit
@@ -48,9 +47,4 @@
val duplicate: 'a array -> 'a array
val toList: 'a array -> 'a list
val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b array
-
- (* Deprecated *)
- val checkSlice: 'a array * int * int option -> int
- (* Deprecated *)
- val checkSliceMax: int * int option * int -> int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array.sml 2006-02-12 18:36:38 UTC (rev 4353)
@@ -13,28 +13,43 @@
val fromArray = fn a => a
val isMutable = true
val length = Primitive.Array.length
- val sub = Primitive.Array.sub)
+ val subUnsafe = Primitive.Array.subUnsafe)
open A
- open Primitive.Int
+ val op +? = Int.+?
+ val op + = Int.+
+ val op -? = Int.-?
+ val op - = Int.-
+ val op < = Int.<
+ val op <= = Int.<=
+ val op > = Int.>
+ val op >= = Int.>=
+
+ fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
+
type 'a array = 'a array
type 'a vector = 'a Vector.vector
structure ArraySlice =
struct
open Slice
+ fun update' (arr, i, x) =
+ updateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun update (arr, i, x) =
- update' Primitive.Array.update (arr, i, x)
+ updateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate' (arr, i, x) =
+ unsafeUpdateMk' Primitive.Array.updateUnsafe (arr, i, x)
fun unsafeUpdate (arr, i, x) =
- unsafeUpdate' Primitive.Array.update (arr, i, x)
- fun vector sl = create Vector.tabulate (fn x => x) sl
- fun modifyi f sl =
- appi (fn (i, x) => unsafeUpdate (sl, i, f (i, x))) sl
+ unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun vector sl = create Vector.tabulate' (fn x => x) sl
+ fun modifyi' f sl =
+ appi' (fn (i, x) => unsafeUpdate' (sl, i, f (i, x))) sl
+ fun modifyi f sl = modifyi' (wrap2 f) sl
fun modify f sl = modifyi (f o #2) sl
local
- fun make (length, sub) {src, dst, di} =
- modifyi (fn (i, _) => sub (src, i))
- (slice (dst, di, SOME (length src)))
+ fun make (length, sub') {src, dst, di} =
+ modifyi' (fn (i, _) => sub' (src, i))
+ (slice (dst, di, SOME (length src)))
in
fun copy (arg as {src, dst, di}) =
let val (src', si', len') = base src
@@ -42,25 +57,25 @@
if src' = dst andalso si' < di andalso si' +? len' >= di
then let val sl = slice (dst, di, SOME (length src))
in
- foldri (fn (i, _, _) =>
- unsafeUpdate (sl, i, unsafeSub (src, i)))
+ foldri' (fn (i, _, _) =>
+ unsafeUpdate' (sl, i, unsafeSub' (src, i)))
() sl
end
- else make (length, unsafeSub) arg
+ else make (length, unsafeSub') arg
end
fun copyVec arg =
- make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub) arg
+ make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub') arg
end
end
- val rawArray = Primitive.Array.array
val array = new
local
fun make f arr = f (ArraySlice.full arr)
in
fun vector arr = make (ArraySlice.vector) arr
+ fun modifyi' f = make (ArraySlice.modifyi' f)
fun modifyi f = make (ArraySlice.modifyi f)
fun modify f = make (ArraySlice.modify f)
fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
@@ -69,9 +84,8 @@
dst = dst, di = di}
end
- val unsafeSub = Primitive.Array.sub
- fun update (arr, i, x) = update' Primitive.Array.update (arr, i, x)
- val unsafeUpdate = Primitive.Array.update
+ fun update (arr, i, x) = updateMk Primitive.Array.updateUnsafe (arr, i, x)
+ fun unsafeUpdate (arr, i, x) = unsafeUpdateMk Primitive.Array.updateUnsafe (arr, i, x)
end
structure ArraySlice: ARRAY_SLICE_EXTRA = Array.ArraySlice
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/mono-array.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -42,7 +42,6 @@
val concat: array list -> array
val duplicate: array -> array
val fromPoly: elem Array.array -> array
- val rawArray: int -> array
val toList: array -> elem list
val toPoly: array -> elem Array.array
val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-12 18:36:38 UTC (rev 4353)
@@ -12,75 +12,105 @@
(* fromArray should be constant time. *)
val fromArray: 'a elt array -> 'a sequence
val isMutable: bool
- val length: 'a sequence -> int
- val sub: 'a sequence * int -> 'a elt
+ val length: 'a sequence -> SeqIndex.int
+ val subUnsafe: 'a sequence * SeqIndex.int -> 'a elt
end
): SEQUENCE =
struct
- open S
-
structure Array = Primitive.Array
- open Int
+ val op +? = SeqIndex.+?
+ val op + = SeqIndex.+
+ val op -? = SeqIndex.-?
+ val op - = SeqIndex.-
+ val op < = SeqIndex.<
+ val op <= = SeqIndex.<=
+ val op > = SeqIndex.>
+ val op >= = SeqIndex.>=
+ val ltu = SeqIndex.ltu
+ val leu = SeqIndex.leu
+ val gtu = SeqIndex.gtu
+ val geu = SeqIndex.geu
- val maxLen = Array.maxLen
+ fun wrap1 f = fn (i) => f (SeqIndex.toIntUnsafe i)
+ fun wrap2 f = fn (i, x) => f (SeqIndex.toIntUnsafe i, x)
+ fun wrap3 f = fn (i, x, y) => f (SeqIndex.toIntUnsafe i, x, y)
- fun array n =
- if not isMutable andalso n = 0
+ type 'a sequence = 'a S.sequence
+ type 'a elt = 'a S.elt
+
+ (*
+ * In general, *' values are in terms of SeqIndex.int,
+ * while * values are in terms of Int.int.
+ *)
+
+ local
+ fun doit (toInt, fromInt, maxInt') =
+ (Array.maxLen', toInt Array.maxLen')
+ handle Overflow => (fromInt maxInt', maxInt')
+ structure S =
+ Int_ChooseInt
+ (type 'a t = SeqIndex.int * 'a
+ val fInt8 = doit (SeqIndex.toInt8, SeqIndex.fromInt8,
+ Primitive.Int8.maxInt')
+ val fInt16 = doit (SeqIndex.toInt16, SeqIndex.fromInt16,
+ Primitive.Int16.maxInt')
+ val fInt32 = doit (SeqIndex.toInt32, SeqIndex.fromInt32,
+ Primitive.Int32.maxInt')
+ val fInt64 = doit (SeqIndex.toInt64, SeqIndex.fromInt64,
+ Primitive.Int64.maxInt')
+ val fIntInf = (Array.maxLen', SeqIndex.toIntInf Array.maxLen'))
+ in
+ val (maxLen', maxLen) = S.f
+ end
+
+ fun fromIntForLength n =
+ if Primitive.Controls.safe
+ then (SeqIndex.fromInt n) handle Overflow => raise Size
+ else SeqIndex.fromIntUnsafe n
+
+ fun length' s = S.length s
+ fun length s =
+ if Primitive.Controls.safe
+ then (SeqIndex.toInt (length' s))
+ handle Overflow => raise Fail "Sequence.length"
+ else SeqIndex.toIntUnsafe (length' s)
+
+ fun array' n =
+ if not S.isMutable andalso n = 0
then Array.array0Const ()
- else Array.array n
+ else if Primitive.Controls.safe
+ andalso (n < 0 orelse n > maxLen')
+ then raise Size
+ else Array.arrayUnsafe n
+ fun array n = array' (fromIntForLength n)
- fun seq0 () = fromArray (array 0)
+ fun seq0 () = S.fromArray (array' 0)
- fun unfoldi (n, b, f) =
+ fun unfoldi' (n, b, f) =
let
- val a = array n
+ val a = array' n
fun loop (i, b) =
if i >= n
then ()
else
let
val (x, b') = f (i, b)
- val _ = Array.update (a, i, x)
+ val _ = Array.updateUnsafe (a, i, x)
in
loop (i +? 1, b')
end
val _ = loop (0, b)
in
- fromArray a
+ S.fromArray a
end
+ fun unfoldi (n, b, f) = unfoldi' (fromIntForLength n, b, wrap2 f)
+ fun unfold (n, b, f) = unfoldi (n, b, f o #2)
- (* Tabulate depends on the fact that the runtime system fills in the array
- * with reasonable bogus values.
- *)
+ fun tabulate' (n, f) =
+ unfoldi' (n, (), fn (i, ()) => (f i, ()))
fun tabulate (n, f) =
-(*
- if !Primitive.usesCallcc
- then
- (* This code is careful to use a list to accumulate the
- * components of the array in case f uses callcc.
- *)
- let
- fun loop (i, l) =
- if i >= n
- then l
- else loop (i + 1, f i :: l)
- val l = loop (0, [])
- val a = array n
- fun loop (l, i) =
- case l of
- [] => ()
- | x :: l =>
- let val i = i -? 1
- in Array.update (a, i, x)
- ; loop (l, i)
- end
- in loop (l, n)
- ; fromArray a
- end
- else
-*)
- unfoldi (n, (), fn (i, ()) => (f i, ()))
+ unfoldi (n, (), fn (i, ()) => (f i, ()))
fun new (n, x) = tabulate (n, fn _ => x)
@@ -88,116 +118,177 @@
let
val a = array (List.length l)
val _ =
- List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l
+ List.foldl (fn (x, i) => (Array.updateUnsafe (a, i, x) ; (i +? 1))) 0 l
in
- fromArray a
+ S.fromArray a
end
structure Slice =
struct
- type 'a sequence = 'a sequence
- type 'a elt = 'a elt
- datatype 'a t = T of {seq: 'a sequence, start: int, len: int}
+ type 'a sequence = 'a S.sequence
+ type 'a elt = 'a S.elt
+ datatype 'a t = T of {seq: 'a sequence,
+ start: SeqIndex.int, len: SeqIndex.int}
type 'a slice = 'a t
- fun length (T {len, ...}) = len
- fun unsafeSub (T {seq, start, ...}, i) =
- S.sub (seq, start +? i)
- fun sub (sl as T {len, ...}, i) =
- if Primitive.Controls.safe andalso Int.geu (i, len)
+ fun length' (T {len, ...}) = len
+ fun length sl =
+ if Primitive.Controls.safe
+ then (SeqIndex.toInt (length' sl))
+ handle Overflow => raise Fail "Sequence.Slice.length"
+ else SeqIndex.toIntUnsafe (length' sl)
+ fun unsafeSub' (T {seq, start, ...}, i) =
+ S.subUnsafe (seq, start +? i)
+ fun unsafeSub (sl, i) =
+ unsafeSub' (sl, SeqIndex.fromIntUnsafe i)
+ fun sub' (sl as T {len, ...}, i) =
+ if Primitive.Controls.safe andalso geu (i, len)
then raise Subscript
- else unsafeSub (sl, i)
- fun unsafeUpdate' update (T {seq, start, ...}, i, x) =
- update (seq, start +? i, x)
- fun update' update (sl as T {len, ...}, i, x) =
- if Primitive.safe andalso Int.geu (i, len)
+ else unsafeSub' (sl, i)
+ fun sub (sl, i) =
+ if Primitive.Controls.safe
+ then let
+ val i =
+ (SeqIndex.fromInt i)
+ handle Overflow => raise Subscript
+ in
+ sub' (sl, i)
+ end
+ else unsafeSub (sl, i)
+ fun unsafeUpdateMk' updateUnsafe (T {seq, start, ...}, i, x) =
+ updateUnsafe (seq, start +? i, x)
+ fun unsafeUpdateMk updateUnsafe (sl, i, x) =
+ unsafeUpdateMk' updateUnsafe (sl, SeqIndex.fromIntUnsafe i, x)
+ fun updateMk' updateUnsafe (sl as T {len, ...}, i, x) =
+ if Primitive.Controls.safe andalso geu (i, len)
then raise Subscript
- else unsafeUpdate' update (sl, i, x)
+ else unsafeUpdateMk' updateUnsafe (sl, i, x)
+ fun updateMk updateUnsafe (sl, i, x) =
+ if Primitive.Controls.safe
+ then let
+ val i =
+ (SeqIndex.fromInt i)
+ handle Overflow => raise Subscript
+ in
+ updateMk' updateUnsafe (sl, i, x)
+ end
+ else unsafeUpdateMk updateUnsafe (sl, i, x)
fun full (seq: 'a sequence) : 'a slice =
T {seq = seq, start = 0, len = S.length seq}
- fun subslice (T {seq, start, len}, start', len') =
- case len' of
- NONE => if Primitive.safe andalso
- (start' < 0 orelse start' > len)
- then raise Subscript
- else T {seq = seq,
- start = start +? start',
- len = len -? start'}
- | SOME len' => if Primitive.safe andalso
- (start' < 0 orelse start' > len orelse
- len' < 0 orelse len' > len -? start')
- then raise Subscript
- else T {seq = seq,
- start = start +? start',
- len = len'}
- fun unsafeSubslice (T {seq, start, len}, start', len') =
+ fun unsafeSubslice' (T {seq, start, len}, start', len') =
T {seq = seq,
start = start +? start',
len = (case len' of
NONE => len -? start'
| SOME len' => len')}
+ fun unsafeSubslice (sl, start, len) =
+ unsafeSubslice'
+ (sl, SeqIndex.fromIntUnsafe start,
+ Option.map SeqIndex.fromIntUnsafe len)
+ fun unsafeSlice' (seq, start, len) =
+ unsafeSubslice' (full seq, start, len)
+ fun unsafeSlice (seq, start, len) =
+ unsafeSubslice (full seq, start, len)
+ fun subslice' (T {seq, start, len}, start', len') =
+ case len' of
+ NONE =>
+ if Primitive.Controls.safe
+ andalso gtu (start', len)
+ then raise Subscript
+ else T {seq = seq,
+ start = start +? start',
+ len = len -? start'}
+ | SOME len' =>
+ if Primitive.Controls.safe
+ andalso (gtu (start', len)
+ orelse gtu (len', len -? start'))
+ then raise Subscript
+ else T {seq = seq,
+ start = start +? start',
+ len = len'}
+ fun subslice (sl, start, len) =
+ if Primitive.Controls.safe
+ then (subslice' (sl,
+ SeqIndex.fromInt start,
+ Option.map SeqIndex.fromInt len))
+ handle Overflow => raise Subscript
+ else unsafeSubslice (sl, start, len)
+ fun slice' (seq: 'a sequence, start, len) =
+ subslice' (full seq, start, len)
fun slice (seq: 'a sequence, start, len) =
subslice (full seq, start, len)
- fun unsafeSlice (seq: 'a sequence, start, len) =
- unsafeSubslice (full seq, start, len)
- fun base (T {seq, start, len}) = (seq, start, len)
+ fun base' (T {seq, start, len}) =
+ (seq, start, len)
+ fun base (T {seq, start, len}) =
+ (seq, SeqIndex.toIntUnsafe start, SeqIndex.toIntUnsafe len)
fun isEmpty sl = length sl = 0
fun getItem (sl as T {seq, start, len}) =
if isEmpty sl
then NONE
- else SOME (S.sub (seq, start),
+ else SOME (S.subUnsafe (seq, start),
T {seq = seq,
start = start +? 1,
len = len -? 1})
- fun foldli f b (T {seq, start, len}) =
+ fun foldli' f b (T {seq, start, len}) =
let
val min = start
+ val len = len -? 1
val max = start +? len
fun loop (i, b) =
- if i >= max then b
- else loop (i +? 1, f (i -? min, S.sub (seq, i), b))
+ if i > max then b
+ else loop (i +? 1, f (i -? min, S.subUnsafe (seq, i), b))
in loop (min, b)
end
- fun foldri f b (T {seq, start, len}) =
+ fun foldli f b sl = foldli' (wrap3 f) b sl
+ fun foldri' f b (T {seq, start, len}) =
let
val min = start
+ val len = len -? 1
val max = start +? len
fun loop (i, b) =
if i < min then b
- else loop (i -? 1, f (i -? min, S.sub (seq, i), b))
- in loop (max -? 1, b)
+ else loop (i -? 1, f (i -? min, S.subUnsafe (seq, i), b))
+ in loop (max, b)
end
+ fun foldri f b sl = foldri' (wrap3 f) b sl
local
fun make foldi f b sl = foldi (fn (_, x, b) => f (x, b)) b sl
in
- fun foldl f = make foldli f
- fun foldr f = make foldri f
+ fun foldl f = make foldli' f
+ fun foldr f = make foldri' f
end
- fun appi f sl = foldli (fn (i, x, ()) => f (i, x)) () sl
+ fun appi' f sl = foldli' (fn (i, x, ()) => f (i, x)) () sl
+ fun appi f sl = appi' (wrap2 f) sl
fun app f sl = appi (f o #2) sl
- fun createi tabulate f (T {seq, start, len}) =
- tabulate (len, fn i => f (i, S.sub (seq, start +? i)))
- fun create tabulate f sl = createi tabulate (f o #2) sl
- fun mapi f sl = createi tabulate f sl
+ fun createi' tabulate' f (T {seq, start, len}) =
+ tabulate' (len, fn i => f (i, S.subUnsafe (seq, start +? i)))
+ fun createi tabulate' f sl = createi' tabulate' (wrap2 f) sl
+ fun create tabulate' f sl = createi tabulate' (f o #2) sl
+ fun mapi' f sl = createi' tabulate' f sl
+ fun mapi f sl = mapi' (wrap2 f) sl
fun map f sl = mapi (f o #2) sl
- fun findi p (T {seq, start, len}) =
+ fun findi' p (T {seq, start, len}) =
let
val min = start
+ val len = len -? 1
val max = start +? len
fun loop i =
- if i >= max
+ if i > max
then NONE
- else let val z = (i -? min, S.sub (seq, i))
+ else let val z = (i -? min, S.subUnsafe (seq, i))
in if p z
then SOME z
else loop (i +? 1)
end
in loop min
end
+ fun findi p sl = Option.map (wrap2 (fn z => z)) (findi' (wrap2 p) sl)
fun find p sl = Option.map #2 (findi (p o #2) sl)
- fun existsi p sl = Option.isSome (findi p sl)
+ fun existsi' p sl = Option.isSome (findi' p sl)
+ fun existsi p sl = existsi' (wrap2 p) sl
fun exists p sl = existsi (p o #2) sl
- fun alli p sl = not (existsi (not o p) sl)
+ fun alli' p sl = not (existsi' (not o p) sl)
+ fun alli p sl = alli' (wrap2 p) sl
fun all p sl = alli (p o #2) sl
fun collate cmp (T {seq = seq1, start = start1, len = len1},
T {seq = seq2, start = start2, len = len2}) =
@@ -212,31 +303,34 @@
| (true, false) => LESS
| (false, true) => GREATER
| (false, false) =>
- (case cmp (S.sub (seq1, i), S.sub (seq2, j)) of
+ (case cmp (S.subUnsafe (seq1, i),
+ S.subUnsafe (seq2, j)) of
EQUAL => loop (i +? 1, j +? 1)
| ans => ans)
in loop (min1, min2)
end
fun sequence (sl as T {seq, start, len}): 'a sequence =
- if isMutable orelse (start <> 0 orelse len <> S.length seq)
+ if S.isMutable orelse (start <> 0 orelse len <> S.length seq)
then map (fn x => x) sl
else seq
fun append (sl1: 'a slice, sl2: 'a slice): 'a sequence =
- if length sl1 = 0
+ if length' sl1 = 0
then sequence sl2
- else if length sl2 = 0
+ else if length' sl2 = 0
then sequence sl1
else
let
- val l1 = length sl1
- val l2 = length sl2
- val n = l1 + l2 handle Overflow => raise Size
+ val l1 = length' sl1
+ val l2 = length' sl2
+ val n = (l1 + l2) handle Overflow => raise Size
in
- unfoldi (n, (0, sl1),
+ unfoldi' (n, (0, sl1),
fn (_, (i, sl)) =>
- if i < length sl
- then (unsafeSub (sl, i), (i +? 1, sl))
- else (unsafeSub (sl2, 0), (1, sl2)))
+ if SeqIndex.< (i, length' sl)
+ then (unsafeSub' (sl, i),
+ (i +? 1, sl))
+ else (unsafeSub' (sl2, 0),
+ (1, sl2)))
end
fun concat (sls: 'a slice list): 'a sequence =
case sls of
@@ -244,17 +338,19 @@
| [sl] => sequence sl
| sls' as sl::sls =>
let
- val n = List.foldl (fn (sl, s) => s + length sl) 0 sls'
- handle Overflow => raise Size
+ val n =
+ (List.foldl (fn (sl, s) => s +? length' sl) 0 sls')
+ handle Overflow => raise Size
in
- unfoldi (n, (0, sl, sls),
- fn (_, ac) =>
- let
- fun loop (i, sl, sls) =
- if i < length sl
- then (unsafeSub (sl, i), (i +? 1, sl, sls))
+ unfoldi' (n, (0, sl, sls),
+ fn (_, ac) =>
+ let
+ fun loop (i, sl, sls) =
+ if SeqIndex.< (i, length' sl)
+ then (unsafeSub' (sl, i),
+ (i +? 1, sl, sls))
else case sls of
- [] => raise Fail "concat bug"
+ [] => raise Fail "Sequence.Slice.concat"
| sl :: sls => loop (0, sl, sls)
in loop ac
end)
@@ -270,26 +366,41 @@
(sequence sl) sls
end
fun triml k =
- if Primitive.safe andalso k < 0
+ if Primitive.Controls.safe andalso Int.< (k, 0)
then raise Subscript
else
(fn (T {seq, start, len}) =>
- if k > len
- then unsafeSlice (seq, start +? len, SOME 0)
- else unsafeSlice (seq, start +? k, SOME (len -? k)))
+ let
+ val k =
+ if Primitive.Controls.safe
+ then SeqIndex.fromInt k
+ else SeqIndex.fromIntUnsafe k
+ in
+ if SeqIndex.> (k, len)
+ then unsafeSlice' (seq, start +? len, SOME 0)
+ else unsafeSlice' (seq, start +? k, SOME (len -? k))
+ end handle Overflow => unsafeSlice' (seq, start +? len, SOME 0))
fun trimr k =
- if Primitive.safe andalso k < 0
+ if Primitive.Controls.safe andalso Int.< (k, 0)
then raise Subscript
else
(fn (T {seq, start, len}) =>
- unsafeSlice (seq, start,
- SOME (if k > len then 0 else len -? k)))
+ let
+ val k =
+ if Primitive.Controls.safe
+ then SeqIndex.fromInt k
+ else SeqIndex.fromIntUnsafe k
+ in
+ if SeqIndex.> (k, len)
+ then unsafeSlice' (seq, start, SOME 0)
+ else unsafeSlice' (seq, start, SOME (len -? k))
+ end handle Overflow => unsafeSlice' (seq, start, SOME 0))
fun isSubsequence (eq: 'a elt * 'a elt -> bool)
(seq: 'a sequence)
(sl: 'a slice) =
let
val n = S.length seq
- val n' = length sl
+ val n' = length' sl
in
if n <= n'
then let
@@ -299,7 +410,8 @@
then false
else if j >= n
then true
- else if eq (S.sub (seq, j), unsafeSub (sl, i +? j))
+ else if eq (S.subUnsafe (seq, j),
+ unsafeSub' (sl, i +? j))
then loop (i, j +? 1)
else loop (i +? 1, 0)
in
@@ -312,14 +424,15 @@
(sl: 'a slice) =
let
val n = S.length seq
- val n' = length sl
+ val n' = length' sl
in
if n <= n'
then let
fun loop (j) =
if j >= n
then true
- else if eq (S.sub (seq, j), unsafeSub (sl, j))
+ else if eq (S.subUnsafe (seq, j),
+ unsafeSub' (sl, j))
then loop (j +? 1)
else false
in
@@ -332,7 +445,7 @@
(sl: 'a slice) =
let
val n = S.length seq
- val n' = length sl
+ val n' = length' sl
in
if n <= n'
then let
@@ -340,7 +453,8 @@
fun loop (j) =
if j >= n
then true
- else if eq (S.sub (seq, j), unsafeSub (sl, n'' +? j))
+ else if eq (S.subUnsafe (seq, j),
+ unsafeSub' (sl, n'' +? j))
then loop (j +? 1)
else false
in
@@ -348,35 +462,40 @@
end
else false
end
- fun split (T {seq, start, len}, i) =
- (unsafeSlice (seq, start, SOME (i -? start)),
- unsafeSlice (seq, i, SOME (len -? (i -? start))))
+ fun split' (T {seq, start, len}, i) =
+ (unsafeSlice' (seq, start, SOME (i -? start)),
+ unsafeSlice' (seq, i, SOME (len -? (i -? start))))
fun splitl f (sl as T {seq, start, len}) =
let
val stop = start +? len
fun loop i =
if i >= stop
then i
- else if f (S.sub (seq, i))
+ else if f (S.subUnsafe (seq, i))
then loop (i +? 1)
else i
- in split (sl, loop start)
+ in split' (sl, loop start)
end
fun splitr f (sl as T {seq, start, len}) =
let
fun loop i =
if i < start
then start
- else if f (S.sub (seq, i))
+ else if f (S.subUnsafe (seq, i))
then loop (i -? 1)
else i +? 1
- in split (sl, loop (start +? len -? 1))
+ in split' (sl, loop (start +? len -? 1))
end
- fun splitAt (T {seq, start, len}, i) =
- if Primitive.safe andalso Int.gtu (i, len)
+ fun splitAt' (T {seq, start, len}, i) =
+ if Primitive.Controls.safe andalso SeqIndex.gtu (i, len)
then raise Subscript
- else (unsafeSlice (seq, start, SOME i),
- unsafeSlice (seq, start +? i, SOME (len -? i)))
+ else (unsafeSlice' (seq, start, SOME i),
+ unsafeSlice' (seq, start +? i, SOME (len -? i)))
+ fun splitAt (sl, i) =
+ if Primitive.Controls.safe
+ then (splitAt' (sl, SeqIndex.fromInt i))
+ handle Overflow => raise Subscript
+ else splitAt' (sl, SeqIndex.fromIntUnsafe i)
fun dropl p s = #2 (splitl p s)
fun dropr p s = #1 (splitr p s)
fun takel p s = #1 (splitl p s)
@@ -395,21 +514,21 @@
fun loop' j =
if j >= len'
then i
- else if eq (S.sub (seq, i +? j),
- S.sub (seq', j))
+ else if eq (S.subUnsafe (seq, i +? j),
+ S.subUnsafe (seq', j))
then loop' (j +? 1)
else loop (i +? 1)
in loop' 0
end
- in split (sl, loop start)
+ in split' (sl, loop start)
end
fun span (eq: 'a sequence * 'a sequence -> bool)
(T {seq, start, ...},
T {seq = seq', start = start', len = len'}) =
- if Primitive.safe andalso
+ if Primitive.Controls.safe andalso
(not (eq (seq, seq')) orelse start' +? len' < start)
then raise Span
- else unsafeSlice (seq, start, SOME ((start' +? len') -? start))
+ else unsafeSlice' (seq, start, SOME ((start' +? len') -? start))
fun translate f (sl: 'a slice) =
concat (List.rev (foldl (fn (c, l) => (full (f c)) :: l) [] sl))
local
@@ -420,7 +539,7 @@
if i >= max
then List.rev (finish (seq, start, i, sls))
else
- if p (S.sub (seq, i))
+ if p (S.subUnsafe (seq, i))
then loop (i +? 1, i +? 1, finish (seq, start, i, sls))
else loop (i +? 1, start, sls)
in loop (start, start, [])
@@ -431,12 +550,12 @@
if start = stop
then sls
else
- (unsafeSlice (seq, start, SOME (stop -? start)))
+ (unsafeSlice' (seq, start, SOME (stop -? start)))
:: sls)
p sl
fun fields p sl =
make (fn (seq, start, stop, sls) =>
- (unsafeSlice (seq, start, SOME (stop -? start)))
+ (unsafeSlice' (seq, start, SOME (stop -? start)))
:: sls)
p sl
end
@@ -448,23 +567,38 @@
fun make2 f (seq1, seq2) = f (Slice.full seq1, Slice.full seq2)
in
fun sub (seq, i) = Slice.sub (Slice.full seq, i)
+ fun sub' (seq, i) = Slice.sub' (Slice.full seq, i)
fun unsafeSub (seq, i) = Slice.unsafeSub (Slice.full seq, i)
- fun update' update (seq, i, x) =
- Slice.update' update (Slice.full seq, i, x)
+ fun unsafeSub' (seq, i) = Slice.unsafeSub' (Slice.full seq, i)
+ fun updateMk updateUnsafe (seq, i, x) =
+ Slice.updateMk updateUnsafe (Slice.full seq, i, x)
+ fun updateMk' updateUnsafe (seq, i, x) =
+ Slice.updateMk' updateUnsafe (Slice.full seq, i, x)
+ fun unsafeUpdateMk updateUnsafe (seq, i, x) =
+ Slice.unsafeUpdateMk updateUnsafe (Slice.full seq, i, x)
+ fun unsafeUpdateMk' updateUnsafe (seq, i, x) =
+ Slice.unsafeUpdateMk' updateUnsafe (Slice.full seq, i, x)
fun append seqs = make2 Slice.append seqs
fun concat seqs = Slice.concat (List.map Slice.full seqs)
+ fun appi' f = make (Slice.appi' f)
fun appi f = make (Slice.appi f)
fun app f = make (Slice.app f)
+ fun mapi' f = make (Slice.mapi' f)
fun mapi f = make (Slice.mapi f)
fun map f = make (Slice.map f)
+ fun foldli' f b = make (Slice.foldli' f b)
fun foldli f b = make (Slice.foldli f b)
+ fun foldl f b = make (Slice.foldl f b)
+ fun foldri' f b = make (Slice.foldri' f b)
fun foldri f b = make (Slice.foldri f b)
- fun foldl f b = make (Slice.foldl f b)
fun foldr f b = make (Slice.foldr f b)
+ fun findi' p = make (Slice.findi' p)
fun findi p = make (Slice.findi p)
fun find p = make (Slice.find p)
+ fun existsi' p = make (Slice.existsi' p)
fun existsi p = make (Slice.existsi p)
fun exists p = make (Slice.exists p)
+ fun alli' p = make (Slice.alli' p)
fun alli p = make (Slice.alli p)
fun all p = make (Slice.all p)
fun collate cmp = make2 (Slice.collate cmp)
@@ -475,23 +609,10 @@
fun translate f = make (Slice.translate f)
fun tokens f seq = List.map Slice.sequence (make (Slice.tokens f) seq)
fun fields f seq = List.map Slice.sequence (make (Slice.fields f) seq)
- fun createi tabulate f seq = make (Slice.createi tabulate f) seq
- fun create tabulate f seq = make (Slice.create tabulate f) seq
+ fun createi' tabulate' f seq = make (Slice.createi' tabulate' f) seq
+ fun createi tabulate' f seq = make (Slice.createi tabulate' f) seq
+ fun create tabulate' f seq = make (Slice.create tabulate' f) seq
fun duplicate seq = make Slice.sequence seq
fun toList seq = make Slice.toList seq
end
-
- (* Deprecated *)
- fun checkSliceMax (start: int, num: int option, max: int): int =
- case num of
- NONE => if Primitive.safe andalso (start < 0 orelse start > max)
- then raise Subscript
- else max
- | SOME num =>
- if Primitive.safe
- andalso (start < 0 orelse num < 0 orelse start > max -? num)
- then raise Subscript
- else start +? num
- (* Deprecated *)
- fun checkSlice (s, i, opt) = checkSliceMax (i, opt, length s)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -16,28 +16,45 @@
val maxLen: int
val fromList: 'a elt list -> 'a sequence
+ val tabulate': SeqIndex.int * (SeqIndex.int -> 'a elt) -> 'a sequence
val tabulate: int * (int -> 'a elt) -> 'a sequence
+ val length': 'a sequence -> SeqIndex.int
val length: 'a sequence -> int
+ val sub': 'a sequence * SeqIndex.int -> 'a elt
val sub: 'a sequence * int -> 'a elt
+ val unsafeSub': 'a sequence * SeqIndex.int -> 'a elt
val unsafeSub: 'a sequence * int -> 'a elt
- (* update':
- * ('a sequence * int * 'a elt -> unit) should be an unsafe update.
+ (* updateMk',updateMk,unsafeUpdateMk',unsafeUpdateMk:
+ * ('a sequence * SeqIndex.int * 'a elt -> unit) should be an unsafe update.
*)
- val update': ('a sequence * int * 'a elt -> unit) ->
- ('a sequence * int * 'a elt) -> unit
+ val updateMk': ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a sequence * SeqIndex.int * 'a elt) -> unit
+ val updateMk: ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a sequence * int * 'a elt) -> unit
+ val unsafeUpdateMk': ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a sequence * SeqIndex.int * 'a elt) -> unit
+ val unsafeUpdateMk: ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a sequence * int * 'a elt) -> unit
val concat: 'a sequence list -> 'a sequence
+ val appi': (SeqIndex.int * 'a elt -> unit) -> 'a sequence -> unit
val appi: (int * 'a elt -> unit) -> 'a sequence -> unit
val app: ('a elt -> unit) -> 'a sequence -> unit
+ val mapi' : (SeqIndex.int * 'a elt -> 'b elt) -> 'a sequence -> 'b sequence
val mapi : (int * 'a elt -> 'b elt) -> 'a sequence -> 'b sequence
val map: ('a elt -> 'b elt) -> 'a sequence -> 'b sequence
+ val foldli': (SeqIndex.int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
val foldli: (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
+ val foldl: ('a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
+ val foldri': (SeqIndex.int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
val foldri: (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
- val foldl: ('a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
val foldr: ('a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
+ val findi': (SeqIndex.int * 'a elt -> bool) -> 'a sequence -> (SeqIndex.int * 'a elt) option
val findi: (int * 'a elt -> bool) -> 'a sequence -> (int * 'a elt) option
val find: ('a elt -> bool) -> 'a sequence -> 'a elt option
+ val existsi': (SeqIndex.int * 'a elt -> bool) -> 'a sequence -> bool
val existsi: (int * 'a elt -> bool) -> 'a sequence -> bool
val exists: ('a elt -> bool) -> 'a sequence -> bool
+ val alli': (SeqIndex.int * 'a elt -> bool) -> 'a sequence -> bool
val alli: (int * 'a elt -> bool) -> 'a sequence -> bool
val all: ('a elt -> bool) -> 'a sequence -> bool
val collate: ('a elt * 'a elt -> order) -> 'a sequence * 'a sequence -> order
@@ -53,20 +70,19 @@
(* Extra *)
val append: 'a sequence * 'a sequence -> 'a sequence
- (* createi,create:
- * (int * (int -> 'b elt) -> 'c) should be a tabulate function.
+ (* createi',createi,create:
+ * (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) should be a tabulate' function.
*)
- val createi: (int * (int -> 'b elt) -> 'c) ->
+ val createi': (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
+ (SeqIndex.int * 'a elt -> 'b elt) -> 'a sequence -> 'c
+ val createi: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
(int * 'a elt -> 'b elt) -> 'a sequence -> 'c
- val create: (int * (int -> 'b elt) -> 'c) ->
+ val create: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
('a elt -> 'b elt) -> 'a sequence -> 'c
val duplicate: 'a sequence -> 'a sequence
val new: int * 'a elt -> 'a sequence
val toList: 'a sequence -> 'a elt list
+ val unfoldi': SeqIndex.int * 'a * (SeqIndex.int * 'a -> 'b elt * 'a) -> 'b sequence
val unfoldi: int * 'a * (int * 'a -> 'b elt * 'a) -> 'b sequence
-
- (* Deprecated *)
- val checkSlice: 'a sequence * int * int option -> int
- (* Deprecated *)
- val checkSliceMax: int * int option * int -> int
+ val unfold: int * 'a * ('a -> 'b elt * 'a) -> 'b sequence
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -11,37 +11,56 @@
type 'a sequence
type 'a elt
type 'a slice
+ val length': 'a slice -> SeqIndex.int
val length: 'a slice -> int
+ val sub': 'a slice * SeqIndex.int -> 'a elt
val sub: 'a slice * int -> 'a elt
+ val unsafeSub': 'a slice * SeqIndex.int -> 'a elt
val unsafeSub: 'a slice * int -> 'a elt
- (* update',unsafeUpdate':
- * ('a sequence * int * 'a elt -> unit) should be an unsafe update.
+ (* updateMk',updateMk,unsafeUpdateMk',unsafeUpdateMk:
+ * ('a sequence * SeqIndex.int * 'a elt -> unit) should be an unsafe update.
*)
- val update': ('a sequence * int * 'a elt -> unit) ->
- ('a slice * int * 'a elt) -> unit
- val unsafeUpdate': ('a sequence * int * 'a elt -> unit) ->
- ('a slice * int * 'a elt) -> unit
+ val updateMk': ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a slice * SeqIndex.int * 'a elt) -> unit
+ val updateMk: ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a slice * int * 'a elt) -> unit
+ val unsafeUpdateMk': ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a slice * SeqIndex.int * 'a elt) -> unit
+ val unsafeUpdateMk: ('a sequence * SeqIndex.int * 'a elt -> unit) ->
+ ('a slice * int * 'a elt) -> unit
val full: 'a sequence -> 'a slice
+ val slice': 'a sequence * SeqIndex.int * SeqIndex.int option -> 'a slice
val slice: 'a sequence * int * int option -> 'a slice
+ val unsafeSlice': 'a sequence * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSlice: 'a sequence * int * int option -> 'a slice
+ val subslice': 'a slice * SeqIndex.int * SeqIndex.int option -> 'a slice
val subslice: 'a slice * int * int option -> 'a slice
+ val unsafeSubslice': 'a slice * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSubslice: 'a slice * int * int option -> 'a slice
+ val base': 'a slice -> 'a sequence * SeqIndex.int * SeqIndex.int
val base: 'a slice -> 'a sequence * int * int
val concat: 'a slice list -> 'a sequence
val isEmpty: 'a slice -> bool
val getItem: 'a slice -> ('a elt * 'a slice) option
+ val appi': (SeqIndex.int * 'a elt -> unit) -> 'a slice -> unit
val appi: (int * 'a elt -> unit) -> 'a slice -> unit
val app: ('a elt -> unit) -> 'a slice -> unit
+ val mapi': (SeqIndex.int * 'a elt -> 'b elt) -> 'a slice -> 'b sequence
val mapi: (int * 'a elt -> 'b elt) -> 'a slice -> 'b sequence
val map: ('a elt -> 'b elt) -> 'a slice -> 'b sequence
+ val foldli': (SeqIndex.int * 'a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
val foldli: (int * 'a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
+ val foldl: ('a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
+ val foldri': (SeqIndex.int * 'a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
val foldri: (int * 'a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
- val foldl: ('a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
val foldr: ('a elt * 'b -> 'b) -> 'b -> 'a slice -> 'b
+ val findi': (SeqIndex.int * 'a elt -> bool) -> 'a slice -> (SeqIndex.int * 'a elt) option
val findi: (int * 'a elt -> bool) -> 'a slice -> (int * 'a elt) option
val find: ('a elt -> bool) -> 'a slice -> 'a elt option
+ val existsi': (SeqIndex.int * 'a elt -> bool) -> 'a slice -> bool
val existsi: (int * 'a elt -> bool) -> 'a slice -> bool
val exists: ('a elt -> bool) -> 'a slice -> bool
+ val alli': (SeqIndex.int * 'a elt -> bool) -> 'a slice -> bool
val alli: (int * 'a elt -> bool) -> 'a slice -> bool
val all: ('a elt -> bool) -> 'a slice -> bool
val collate: ('a elt * 'a elt -> order) -> 'a slice * 'a slice -> order
@@ -55,6 +74,7 @@
val isSuffix: ('a elt * 'a elt -> bool) -> 'a sequence -> 'a slice -> bool
val splitl: ('a elt -> bool) -> 'a slice -> 'a slice * 'a slice
val splitr: ('a elt -> bool) -> 'a slice -> 'a slice * 'a slice
+ val splitAt': 'a slice * SeqIndex.int -> 'a slice * 'a slice
val splitAt: 'a slice * int -> 'a slice * 'a slice
val dropl: ('a elt -> bool) -> 'a slice -> 'a slice
val dropr: ('a elt -> bool) -> 'a slice -> 'a slice
@@ -72,12 +92,14 @@
(* Extra *)
val append: 'a slice * 'a slice -> 'a sequence
- (* createi,create:
- * (int * (int -> 'b elt) -> 'c) should be a tabulate function.
+ (* createi',createi,create:
+ * (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) should be a tabulate' function.
*)
- val createi: (int * (int -> 'b elt) -> 'c) ->
+ val createi': (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
+ (SeqIndex.int * 'a elt -> 'b elt) -> 'a slice -> 'c
+ val createi: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
(int * 'a elt -> 'b elt) -> 'a slice -> 'c
- val create: (int * (int -> 'b elt) -> 'c) ->
+ val create: (SeqIndex.int * (SeqIndex.int -> 'b elt) -> 'c) ->
('a elt -> 'b elt) -> 'a slice -> 'c
val toList: 'a slice -> 'a elt list
val sequence: 'a slice -> 'a sequence
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector-slice.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -5,7 +5,6 @@
signature VECTOR_SLICE_GLOBAL =
sig
-
end
signature VECTOR_SLICE =
@@ -43,8 +42,11 @@
sig
include VECTOR_SLICE
+ val unsafeSub': 'a slice * SeqIndex.int -> 'a
val unsafeSub: 'a slice * int -> 'a
+ val unsafeSlice': 'a Vector.vector * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSlice: 'a Vector.vector * int * int option -> 'a slice
+ val unsafeSubslice': 'a slice * SeqIndex.int * SeqIndex.int option -> 'a slice
val unsafeSubslice: 'a slice * int * int option -> 'a slice
(* Used to implement Substring/String functions *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sig 2006-02-12 18:36:38 UTC (rev 4353)
@@ -34,6 +34,7 @@
include VECTOR
structure VectorSlice: VECTOR_SLICE_EXTRA
+ val fromArray: 'a array -> 'a vector
val unsafeSub: 'a vector * int -> 'a
(* Used to implement Substring/String functions *)
@@ -47,11 +48,8 @@
val append: 'a vector * 'a vector -> 'a vector
val duplicate: 'a vector -> 'a vector
- val fromArray: 'a array -> 'a vector
+ val tabulate': SeqIndex.int * (SeqIndex.int -> 'a) -> 'a vector
val toList: 'a vector -> 'a list
val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b vector
val vector: int * 'a -> 'a vector
-
- (* Deprecated *)
- val checkSlice: 'a vector * int * int option -> int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/vector.sml 2006-02-12 18:36:38 UTC (rev 4353)
@@ -13,7 +13,7 @@
val fromArray = Primitive.Vector.fromArray
val isMutable = false
val length = Primitive.Vector.length
- val sub = Primitive.Vector.sub)
+ val subUnsafe = Primitive.Vector.subUnsafe)
open V
type 'a vector = 'a vector
@@ -30,13 +30,31 @@
end
fun update (v, i, x) =
- tabulate (length v,
- fn j => if i = j
- then x
- else unsafeSub (v, j))
+ let
+ fun doit i =
+ tabulate' (length' v,
+ fn j => if i = j
+ then x
+ else unsafeSub' (v, j))
+ in
+ if Primitive.Controls.safe
+ then
+ let
+ val i =
+ (SeqIndex.fromInt i)
+ handle Overflow => raise Subscript
+ in
+ if SeqIndex.geu (i, length' v)
+ then raise Subscript
+ else doit i
+ end
+ else let
+ val i = SeqIndex.fromIntUnsafe i
+ in
+ doit i
+ end
+ end
- val unsafeSub = Primitive.Vector.sub
-
val isSubvector = isSubsequence
val fromArray = Primitive.Vector.fromArray
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-12 18:36:38 UTC (rev 4353)
@@ -62,27 +62,28 @@
../list/list-pair.sml
../arrays-and-vectors/slice.sig
../arrays-and-vectors/sequence.sig
+ ../arrays-and-vectors/seq-index1.sml
+ ../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/sequence.fun
+ ../arrays-and-vectors/array2.sml
*)
- ../arrays-and-vectors/vector-slice.sig
- ../arrays-and-vectors/vector.sig
+ ../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/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
+ ../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
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-12 18:36:38 UTC (rev 4353)
@@ -238,7 +238,7 @@
end
val (n, acc) =
loop (w, 1, [(0, if isneg then 0w1 else 0w0)])
- val a = A.array n
+ val a = A.arrayUnsafe n
fun loop acc =
case acc of
[] => ()
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml 2006-02-12 18:36:38 UTC (rev 4353)
@@ -16,10 +16,6 @@
struct
open Array
val arrayUnsafe = _prim "Array_array": SeqIndex.int -> 'a array;
- fun array n =
- if Controls.safe andalso SeqIndex.< (n, 0)
- then raise Exn.Size
- else arrayUnsafe 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' = SeqIndex.maxInt'. *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml 2006-02-10 03:21:00 UTC (rev 4352)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim2.sml 2006-02-12 18:36:38 UTC (rev 4353)
@@ -48,7 +48,6 @@
(* Install an emergency suffix. *)
local
structure P = Primitive
- s...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-09 19:21:05
|
Fairly complete set of exposed primitive arithmetic.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U 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/large-int.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-real.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/general/general.sml
U 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/int-inf1.sml
U 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/int1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/list/list.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/Makefile
----------------------------------------------------------------------
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-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-02-10 03:21:00 UTC (rev 4352)
@@ -26,6 +26,7 @@
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_REAL_MAPS = default-real64.map
DEFAULT_WORD_MAPS = default-word32.map default-word64.map
.PHONY: type-check
@@ -36,8 +37,9 @@
for ctypes in $(CTYPES_MAPS); do \
for defchar in $(DEFAULT_CHAR_MAPS); do \
for defint in $(DEFAULT_INT_MAPS); do \
+ for defreal in $(DEFAULT_REAL_MAPS); do \
for defword in $(DEFAULT_WORD_MAPS); do \
- echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defword"; \
+ echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defreal $$defword"; \
$(MLTON) -disable-ann deadCode -stop tc -show-types true \
-mlb-path-map "maps/$$objptrrep" \
-mlb-path-map "maps/$$header" \
@@ -45,6 +47,7 @@
-mlb-path-map "maps/$$ctypes" \
-mlb-path-map "maps/$$defchar" \
-mlb-path-map "maps/$$defint" \
+ -mlb-path-map "maps/$$defreal" \
-mlb-path-map "maps/$$defword" \
build/sources.mlb; \
- done; done; done; done; done; done; done
+ done; done; done; done; done; done; done; done
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/array-slice.sig 2006-02-10 03:21:00 UTC (rev 4352)
@@ -1,3 +1,8 @@
+structure Array =
+ struct
+ type 'a array = 'a array
+ end
+
signature ARRAY_SLICE_GLOBAL =
sig
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.fun 2006-02-10 03:21:00 UTC (rev 4352)
@@ -21,7 +21,7 @@
structure Array = Primitive.Array
- open Primitive.Int
+ open Int
val maxLen = Array.maxLen
@@ -104,13 +104,13 @@
fun unsafeSub (T {seq, start, ...}, i) =
S.sub (seq, start +? i)
fun sub (sl as T {len, ...}, i) =
- if Primitive.safe andalso Primitive.Int.geu (i, len)
+ if Primitive.Controls.safe andalso Int.geu (i, len)
then raise Subscript
else unsafeSub (sl, i)
fun unsafeUpdate' update (T {seq, start, ...}, i, x) =
update (seq, start +? i, x)
fun update' update (sl as T {len, ...}, i, x) =
- if Primitive.safe andalso Primitive.Int.geu (i, len)
+ if Primitive.safe andalso Int.geu (i, len)
then raise Subscript
else unsafeUpdate' update (sl, i, x)
fun full (seq: 'a sequence) : 'a slice =
@@ -373,7 +373,7 @@
in split (sl, loop (start +? len -? 1))
end
fun splitAt (T {seq, start, len}, i) =
- if Primitive.safe andalso Primitive.Int.gtu (i, len)
+ if Primitive.safe andalso Int.gtu (i, len)
then raise Subscript
else (unsafeSlice (seq, start, SOME i),
unsafeSlice (seq, start +? i, SOME (len -? i)))
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/sequence.sig 2006-02-10 03:21:00 UTC (rev 4352)
@@ -20,7 +20,8 @@
val length: 'a sequence -> int
val sub: 'a sequence * int -> 'a elt
val unsafeSub: 'a sequence * int -> 'a elt
- (* ('a sequence * int * 'a elt -> unit should be an unsafe update.
+ (* update':
+ * ('a sequence * int * 'a elt -> unit) should be an unsafe update.
*)
val update': ('a sequence * int * 'a elt -> unit) ->
('a sequence * int * 'a elt) -> unit
@@ -53,7 +54,7 @@
(* Extra *)
val append: 'a sequence * 'a sequence -> 'a sequence
(* createi,create:
- * (int * (int -> 'b elt) -> 'c should be a tabulate function.
+ * (int * (int -> 'b elt) -> 'c) should be a tabulate function.
*)
val createi: (int * (int -> 'b elt) -> 'c) ->
(int * 'a elt -> 'b elt) -> 'a sequence -> 'c
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/arrays-and-vectors/slice.sig 2006-02-10 03:21:00 UTC (rev 4352)
@@ -14,7 +14,8 @@
val length: 'a slice -> int
val sub: 'a slice * int -> 'a elt
val unsafeSub: 'a slice * int -> 'a elt
- (* ('a sequence * int * 'a elt -> unit should be an unsafe update.
+ (* update',unsafeUpdate':
+ * ('a sequence * int * 'a elt -> unit) should be an unsafe update.
*)
val update': ('a sequence * int * 'a elt -> unit) ->
('a slice * int * 'a elt) -> unit
@@ -62,7 +63,7 @@
val position: ('a elt * 'a elt -> bool) ->
'a sequence -> 'a slice -> 'a slice * 'a slice
(* span:
- * 'a sequence * 'a sequence -> bool should be polymorphic equality
+ * ('a sequence * 'a sequence -> bool) should be polymorphic equality
*)
val span: ('a sequence * 'a sequence -> bool) -> 'a slice * 'a slice -> 'a slice
val translate: ('a elt -> 'a sequence) -> 'a slice -> 'a sequence
@@ -72,7 +73,7 @@
(* Extra *)
val append: 'a slice * 'a slice -> 'a sequence
(* createi,create:
- * (int * (int -> 'b elt) -> 'c should be a tabulate function.
+ * (int * (int -> 'b elt) -> 'c) should be a tabulate function.
*)
val createi: (int * (int -> 'b elt) -> 'c) ->
(int * 'a elt -> 'b elt) -> 'a slice -> 'c
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-10 03:21:00 UTC (rev 4352)
@@ -29,52 +29,60 @@
local ../config/bind-for-config0.sml in ann "forceUsed" in
../config/default/$(DEFAULT_CHAR)
../config/default/$(DEFAULT_INT)
+ ../config/default/$(DEFAULT_REAL)
../config/default/$(DEFAULT_WORD)
+ ../config/default/large-int.sml
+ ../config/default/large-real.sml
+ ../config/default/large-word.sml
end end
+ ../integer/int1.sml
+ ../integer/word1.sml
local ../config/bind-for-config0.sml in ann "forceUsed" in
+ ../config/default/$(DEFAULT_CHAR)
+ ../config/default/$(DEFAULT_INT)
+ ../config/default/$(DEFAULT_REAL)
+ ../config/default/$(DEFAULT_WORD)
+ ../config/default/large-int.sml
+ ../config/default/large-real.sml
+ ../config/default/large-word.sml
+ end end
+ local ../config/bind-for-config0.sml in ann "forceUsed" in
../config/objptr/$(OBJPTR_REP)
../config/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
../config/c/misc/$(CTYPES)
end end
-
+ ../general/general.sig
+ ../general/general.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
(*
- 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
+ ../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
Modified: 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-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-real64.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -7,3 +7,7 @@
structure Real = Real64
type real = Real.real
+
+functor Real_ChooseRealN (A: CHOOSE_REALN_ARG) :
+ sig val f : Real.real A.t end =
+ ChooseRealN_Real64 (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-int.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-int.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -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 LargeInt = IntInf
+
+functor LargeInt_ChooseInt (A: CHOOSE_INT_ARG) :
+ sig val f : LargeInt.int A.t end =
+ ChooseInt_IntInf (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-real.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-real.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -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 LargeReal = Real64
+
+functor LargeReal_ChooseRealN (A: CHOOSE_REALN_ARG) :
+ sig val f : Real.real A.t end =
+ ChooseRealN_Real64 (A)
Added: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-word.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/large-word.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -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 LargeWord = Word64
+
+functor LargeWord_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : LargeWord.word A.t end =
+ ChooseWordN_Word64 (A)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/general/general.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/general/general.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/general/general.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -8,7 +8,7 @@
structure General: GENERAL_EXTRA =
struct
- type unit = unit
+ type unit = Primitive.Unit.unit
type exn = exn
exception Bind = Bind
@@ -16,13 +16,13 @@
exception Chr
exception Div
exception Domain
- exception Fail = Fail
+ exception Fail of string
exception Overflow = Overflow
exception Size = Size
exception Span
exception Subscript
- datatype order = LESS | EQUAL | GREATER
+ datatype order = datatype Primitive.Order.order
val ! = Primitive.Ref.deref
val op := = Primitive.Ref.assign
@@ -54,4 +54,3 @@
structure GeneralGlobal: GENERAL_GLOBAL = General
open GeneralGlobal
-
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -71,10 +71,10 @@
val fromWord64: Primitive.Word64.word -> int
(* Sign extend. *)
- 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 fromWord8X: Primitive.Word8.word -> int
+ val fromWord16X: Primitive.Word16.word -> int
+ val fromWord32X: Primitive.Word32.word -> int
+ val fromWord64X: Primitive.Word64.word -> int
(* Overflow checking. *)
val toInt8: int -> Primitive.Int8.int
@@ -90,10 +90,10 @@
val toWord64: int -> Primitive.Word64.word
(* Lowbits. *)
- val toWordX8: int -> Primitive.Word8.word
- val toWordX16: int -> Primitive.Word16.word
- val toWordX32: int -> Primitive.Word32.word
- val toWordX64: int -> Primitive.Word64.word
+ val toWord8X: int -> Primitive.Word8.word
+ val toWord16X: int -> Primitive.Word16.word
+ val toWord32X: int -> Primitive.Word32.word
+ val toWord64X: int -> Primitive.Word64.word
end
structure Primitive = struct
@@ -136,10 +136,10 @@
structure S =
ObjptrInt_ChooseIntN
(type 'a t = ObjptrWord.word -> 'a
- val fInt8 = ObjptrWord.toIntX8
- val fInt16 = ObjptrWord.toIntX16
- val fInt32 = ObjptrWord.toIntX32
- val fInt64 = ObjptrWord.toIntX64)
+ val fInt8 = ObjptrWord.toInt8X
+ val fInt16 = ObjptrWord.toInt16X
+ val fInt32 = ObjptrWord.toInt32X
+ val fInt64 = ObjptrWord.toInt64X)
in
val toObjptrIntX = S.f
end
@@ -261,7 +261,7 @@
if Int8.>= (i, 0)
then fromWordAux8 (false, Word8.fromInt8 i)
else fromWordAux8 (true, Word8.~ (Word8.fromInt8 i))
- fun fromWordX8 w = fromInt8 (Word8.toIntX8 w)
+ fun fromWord8X w = fromInt8 (Word8.toInt8X w)
val fromWordAux16 =
make {toMPLimb = MPLimb.fromWord16,
@@ -275,7 +275,7 @@
if Int16.>= (i, 0)
then fromWordAux16 (false, Word16.fromInt16 i)
else fromWordAux16 (true, Word16.~ (Word16.fromInt16 i))
- fun fromWordX16 w = fromInt16 (Word16.toIntX16 w)
+ fun fromWord16X w = fromInt16 (Word16.toInt16X w)
val fromWordAux32 =
make {toMPLimb = MPLimb.fromWord32,
@@ -289,7 +289,7 @@
if Int32.>= (i, 0)
then fromWordAux32 (false, Word32.fromInt32 i)
else fromWordAux32 (true, Word32.~ (Word32.fromInt32 i))
- fun fromWordX32 w = fromInt32 (Word32.toIntX32 w)
+ fun fromWord32X w = fromInt32 (Word32.toInt32X w)
val fromWordAux64 =
make {toMPLimb = MPLimb.fromWord64,
@@ -303,7 +303,7 @@
if Int64.>= (i, 0)
then fromWordAux64 (false, Word64.fromInt64 i)
else fromWordAux64 (true, Word64.~ (Word64.fromInt64 i))
- fun fromWordX64 w = fromInt64 (Word64.toIntX64 w)
+ fun fromWord64X w = fromInt64 (Word64.toInt64X w)
fun fromIntInf i = i
end
@@ -385,20 +385,20 @@
zero = Word8.zero,
lshift = Word8.<<,
orb = Word8.orb}}
- fun toWordX8 i =
+ fun toWord8X i =
case toWordAux8 i of
- Small w => ObjptrWord.toWordX8 w
+ Small w => ObjptrWord.toWord8X w
| Big (isneg, _, ans) => if isneg then Word8.~ ans else ans
- fun toWord8 i = toWordX8 i
+ fun toWord8 i = toWord8X i
fun toInt8 i =
case toWordAux8 i of
- Small w => ObjptrWord.toIntX8 w
+ Small w => ObjptrWord.toInt8X w
| Big (isneg, extra, ans) =>
if extra
then raise Overflow
else if isneg
then let
- val ans = Word8.toIntX8 (Word8.~ ans)
+ val ans = Word8.toInt8X (Word8.~ ans)
in
if Int8.>= (ans, 0)
then raise Overflow
@@ -413,20 +413,20 @@
zero = Word16.zero,
lshift = Word16.<<,
orb = Word16.orb}}
- fun toWordX16 i =
+ fun toWord16X i =
case toWordAux16 i of
- Small w => ObjptrWord.toWordX16 w
+ Small w => ObjptrWord.toWord16X w
| Big (isneg, _, ans) => if isneg then Word16.~ ans else ans
- fun toWord16 i = toWordX16 i
+ fun toWord16 i = toWord16X i
fun toInt16 i =
case toWordAux16 i of
- Small w => ObjptrWord.toIntX16 w
+ Small w => ObjptrWord.toInt16X w
| Big (isneg, extra, ans) =>
if extra
then raise Overflow
else if isneg
then let
- val ans = Word16.toIntX16 (Word16.~ ans)
+ val ans = Word16.toInt16X (Word16.~ ans)
in
if Int16.>= (ans, 0)
then raise Overflow
@@ -441,20 +441,20 @@
zero = Word32.zero,
lshift = Word32.<<,
orb = Word32.orb}}
- fun toWordX32 i =
+ fun toWord32X i =
case toWordAux32 i of
- Small w => ObjptrWord.toWordX32 w
+ Small w => ObjptrWord.toWord32X w
| Big (isneg, _, ans) => if isneg then Word32.~ ans else ans
- fun toWord32 i = toWordX32 i
+ fun toWord32 i = toWord32X i
fun toInt32 i =
case toWordAux32 i of
- Small w => ObjptrWord.toIntX32 w
+ Small w => ObjptrWord.toInt32X w
| Big (isneg, extra, ans) =>
if extra
then raise Overflow
else if isneg
then let
- val ans = Word32.toIntX32 (Word32.~ ans)
+ val ans = Word32.toInt32X (Word32.~ ans)
in
if Int32.>= (ans, 0)
then raise Overflow
@@ -469,20 +469,20 @@
zero = Word64.zero,
lshift = Word64.<<,
orb = Word64.orb}}
- fun toWordX64 i =
+ fun toWord64X i =
case toWordAux64 i of
- Small w => ObjptrWord.toWordX64 w
+ Small w => ObjptrWord.toWord64X w
| Big (isneg, _, ans) => if isneg then Word64.~ ans else ans
- fun toWord64 i = toWordX64 i
+ fun toWord64 i = toWord64X i
fun toInt64 i =
case toWordAux64 i of
- Small w => ObjptrWord.toIntX64 w
+ Small w => ObjptrWord.toInt64X w
| Big (isneg, extra, ans) =>
if extra
then raise Overflow
else if isneg
then let
- val ans = Word64.toIntX64 (Word64.~ ans)
+ val ans = Word64.toInt64X (Word64.~ ans)
in
if Int64.>= (ans, 0)
then raise Overflow
@@ -890,28 +890,28 @@
open Word8
val fromIntInf = IntInf.toWord8
val toIntInf = IntInf.fromWord8
- val toIntInfX = IntInf.fromWordX8
+ val toIntInfX = IntInf.fromWord8X
end
structure Word16 =
struct
open Word16
val fromIntInf = IntInf.toWord16
val toIntInf = IntInf.fromWord16
- val toIntInfX = IntInf.fromWordX16
+ val toIntInfX = IntInf.fromWord16X
end
structure Word32 =
struct
open Word32
val fromIntInf = IntInf.toWord32
val toIntInf = IntInf.fromWord32
- val toIntInfX = IntInf.fromWordX32
+ val toIntInfX = IntInf.fromWord32X
end
structure Word64 =
struct
open Word64
val fromIntInf = IntInf.toWord64
val toIntInf = IntInf.fromWord64
- val toIntInfX = IntInf.fromWordX64
+ val toIntInfX = IntInf.fromWord64X
end
end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf1.sml (from rev 4350, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 00:42:03 UTC (rev 4350)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf1.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -0,0 +1,78 @@
+(* 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_INF1 =
+ sig
+ include INT_INF0
+
+ val fromInt: Int.int -> int
+ val fromLarge: LargeInt.int -> int
+ val toInt: int -> Int.int
+ val toLarge: int -> LargeInt.int
+ end
+
+structure Primitive = struct
+
+open Primitive
+
+structure IntInf : INT_INF1 =
+ struct
+ structure I = Primitive.IntInf
+
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> int
+ val fInt8 = I.fromInt8
+ val fInt16 = I.fromInt16
+ val fInt32 = I.fromInt32
+ val fInt64 = I.fromInt64
+ val fIntInf = I.fromIntInf)
+ in
+ val fromInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> int
+ val fInt8 = I.fromInt8
+ val fInt16 = I.fromInt16
+ val fInt32 = I.fromInt32
+ val fInt64 = I.fromInt64
+ val fIntInf = I.fromIntInf)
+ in
+ val fromLarge = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = int -> 'a
+ val fInt8 = I.toInt8
+ val fInt16 = I.toInt16
+ val fInt32 = I.toInt32
+ val fInt64 = I.toInt64
+ val fIntInf = I.toIntInf)
+ in
+ val toInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = int -> 'a
+ val fInt8 = I.toInt8
+ val fInt16 = I.toInt16
+ val fInt32 = I.toInt32
+ val fInt64 = I.toInt64
+ val fIntInf = I.toIntInf)
+ in
+ val toLarge = S.f
+ end
+
+ end
+
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -26,10 +26,10 @@
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 >> : int * Primitive.Word32.word -> int
val sign': int -> Primitive.Int32.int
val sameSign: int * int -> bool
@@ -47,10 +47,10 @@
val fromWord64: Primitive.Word64.word -> int
(* Overflow checking, signed interp. *)
- 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 fromWord8X: Primitive.Word8.word -> int
+ val fromWord16X: Primitive.Word16.word -> int
+ val fromWord32X: Primitive.Word32.word -> int
+ val fromWord64X: Primitive.Word64.word -> int
(* Overflow checking. *)
val toInt8: int -> Primitive.Int8.int
@@ -65,10 +65,10 @@
val toWord64: int -> Primitive.Word64.word
(* Lowbits or sign extend. *)
- val toWordX8: int -> Primitive.Word8.word
- val toWordX16: int -> Primitive.Word16.word
- val toWordX32: int -> Primitive.Word32.word
- val toWordX64: int -> Primitive.Word64.word
+ val toWord8X: int -> Primitive.Word8.word
+ val toWord16X: int -> Primitive.Word16.word
+ val toWord32X: int -> Primitive.Word32.word
+ val toWord64X: int -> Primitive.Word64.word
end
functor MkInt0 (I: PRIM_INTEGER): INTEGER0 =
@@ -268,35 +268,35 @@
toWordXUnsafe)
end
in
- val (fromWord8, fromWordX8, toWord8, toWordX8) =
+ val (fromWord8, fromWord8X, toWord8, toWord8X) =
make {fromWordUnsafe = fromWord8Unsafe,
- fromWordXUnsafe = fromWordX8Unsafe,
+ fromWordXUnsafe = fromWord8XUnsafe,
toWordUnsafe = toWord8Unsafe,
- toWordXUnsafe =toWordX8Unsafe,
+ toWordXUnsafe =toWord8XUnsafe,
other = {wordSize' = Primitive.Word8.wordSize',
lt = Primitive.Word8.<,
gt = Primitive.Word8.>}}
- val (fromWord16, fromWordX16, toWord16, toWordX16) =
+ val (fromWord16, fromWord16X, toWord16, toWord16X) =
make {fromWordUnsafe = fromWord16Unsafe,
- fromWordXUnsafe = fromWordX16Unsafe,
+ fromWordXUnsafe = fromWord16XUnsafe,
toWordUnsafe = toWord16Unsafe,
- toWordXUnsafe =toWordX16Unsafe,
+ toWordXUnsafe =toWord16XUnsafe,
other = {wordSize' = Primitive.Word16.wordSize',
lt = Primitive.Word16.<,
gt = Primitive.Word16.>}}
- val (fromWord32, fromWordX32, toWord32, toWordX32) =
+ val (fromWord32, fromWord32X, toWord32, toWord32X) =
make {fromWordUnsafe = fromWord32Unsafe,
- fromWordXUnsafe = fromWordX32Unsafe,
+ fromWordXUnsafe = fromWord32XUnsafe,
toWordUnsafe = toWord32Unsafe,
- toWordXUnsafe =toWordX32Unsafe,
+ toWordXUnsafe =toWord32XUnsafe,
other = {wordSize' = Primitive.Word32.wordSize',
lt = Primitive.Word32.<,
gt = Primitive.Word32.>}}
- val (fromWord64, fromWordX64, toWord64, toWordX64) =
+ val (fromWord64, fromWord64X, toWord64, toWord64X) =
make {fromWordUnsafe = fromWord64Unsafe,
- fromWordXUnsafe = fromWordX64Unsafe,
+ fromWordXUnsafe = fromWord64XUnsafe,
toWordUnsafe = toWord64Unsafe,
- toWordXUnsafe =toWordX64Unsafe,
+ toWordXUnsafe =toWord64XUnsafe,
other = {wordSize' = Primitive.Word64.wordSize',
lt = Primitive.Word64.<,
gt = Primitive.Word64.>}}
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml (from rev 4350, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml 2006-02-10 00:42:03 UTC (rev 4350)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -0,0 +1,133 @@
+(* 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 INT_FROM_TO_ARG =
+ sig
+ type int
+ (* Overflow checking, signed interp. *)
+ 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
+ (* Overflow checking. *)
+ 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
+ end
+
+signature INT_FROM_TO_RES =
+ sig
+ type int
+ val fromInt: Int.int -> int
+ val fromLarge: LargeInt.int -> int
+ val toInt: int -> Int.int
+ val toLarge: int -> LargeInt.int
+ end
+
+functor IntFromTo(I: INT_FROM_TO_ARG): INT_FROM_TO_RES where type int = I.int =
+ struct
+ open I
+
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> int
+ val fInt8 = I.fromInt8
+ val fInt16 = I.fromInt16
+ val fInt32 = I.fromInt32
+ val fInt64 = I.fromInt64
+ val fIntInf = I.fromIntInf)
+ in
+ val fromInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> int
+ val fInt8 = I.fromInt8
+ val fInt16 = I.fromInt16
+ val fInt32 = I.fromInt32
+ val fInt64 = I.fromInt64
+ val fIntInf = I.fromIntInf)
+ in
+ val fromLarge = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = int -> 'a
+ val fInt8 = I.toInt8
+ val fInt16 = I.toInt16
+ val fInt32 = I.toInt32
+ val fInt64 = I.toInt64
+ val fIntInf = I.toIntInf)
+ in
+ val toInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = int -> 'a
+ val fInt8 = I.toInt8
+ val fInt16 = I.toInt16
+ val fInt32 = I.toInt32
+ val fInt64 = I.toInt64
+ val fIntInf = I.toIntInf)
+ in
+ val toLarge = S.f
+ end
+
+ end
+
+structure Primitive = struct
+open Primitive
+
+structure Int8 = struct
+ open Int8
+ local
+ structure S = IntFromTo (Primitive.Int8)
+ in
+ open S
+ end
+ end
+structure Int16 = struct
+ open Int16
+ local
+ structure S = IntFromTo (Primitive.Int16)
+ in
+ open S
+ end
+ end
+structure Int32 = struct
+ open Int32
+ local
+ structure S = IntFromTo (Primitive.Int32)
+ in
+ open S
+ end
+ end
+structure Int64 = struct
+ open Int64
+ local
+ structure S = IntFromTo (Primitive.Int64)
+ in
+ open S
+ end
+ end
+structure IntInf = struct
+ open IntInf
+ local
+ structure S = IntFromTo (Primitive.IntInf)
+ in
+ open S
+ end
+ end
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -31,10 +31,10 @@
val fromInt64: Primitive.Int64.int -> word
(* Lowbits or zero extend. *)
- 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 fromInt8Z: Primitive.Int8.int -> word
+ val fromInt16Z: Primitive.Int16.int -> word
+ val fromInt32Z: Primitive.Int32.int -> word
+ val fromInt64Z: Primitive.Int64.int -> word
(* Lowbits or zero extend. *)
val fromWord8: Primitive.Word8.word -> word
@@ -43,10 +43,10 @@
val fromWord64: Primitive.Word64.word -> word
(* Lowbits or sign extend. *)
- 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 fromWord8X: Primitive.Word8.word -> word
+ val fromWord16X: Primitive.Word16.word -> word
+ val fromWord32X: Primitive.Word32.word -> word
+ val fromWord64X: Primitive.Word64.word -> word
(* Overflow checking, unsigned interp. *)
val toInt8: word -> Primitive.Int8.int
@@ -55,10 +55,10 @@
val toInt64: word -> Primitive.Int64.int
(* Overflow checking, signed interp. *)
- 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 toInt8X: word -> Primitive.Int8.int
+ val toInt16X: word -> Primitive.Int16.int
+ val toInt32X: word -> Primitive.Int32.int
+ val toInt64X: word -> Primitive.Int64.int
(* Lowbits or zero extend. *)
val toWord8: word -> Primitive.Word8.word
@@ -67,10 +67,10 @@
val toWord64: word -> Primitive.Word64.word
(* Lowbits or sign extend. *)
- val toWordX8: word -> Primitive.Word8.word
- val toWordX16: word -> Primitive.Word16.word
- val toWordX32: word -> Primitive.Word32.word
- val toWordX64: word -> Primitive.Word64.word
+ val toWord8X: word -> Primitive.Word8.word
+ val toWord16X: word -> Primitive.Word16.word
+ val toWord32X: word -> Primitive.Word32.word
+ val toWord64X: word -> Primitive.Word64.word
end
functor MkWord0 (W: PRIM_WORD): WORD0 =
@@ -152,48 +152,48 @@
toIntX)
end
in
- val (fromInt8, fromIntZ8, toInt8, toIntX8) =
+ val (fromInt8, fromInt8Z, toInt8, toInt8X) =
make {fromIntUnsafe = fromInt8Unsafe,
- fromIntZUnsafe = fromIntZ8Unsafe,
+ fromIntZUnsafe = fromInt8ZUnsafe,
toIntUnsafe = toInt8Unsafe,
- toIntXUnsafe = toIntX8Unsafe,
+ toIntXUnsafe = toInt8XUnsafe,
other = {precision' = Primitive.Int8.precision',
maxInt' = Primitive.Int8.maxInt',
minInt' = Primitive.Int8.minInt'}}
- val (fromInt16, fromIntZ16, toInt16, toIntX16) =
+ val (fromInt16, fromInt16Z, toInt16, toInt16X) =
make {fromIntUnsafe = fromInt16Unsafe,
- fromIntZUnsafe = fromIntZ16Unsafe,
+ fromIntZUnsafe = fromInt16ZUnsafe,
toIntUnsafe = toInt16Unsafe,
- toIntXUnsafe = toIntX16Unsafe,
+ toIntXUnsafe = toInt16XUnsafe,
other = {precision' = Primitive.Int16.precision',
maxInt' = Primitive.Int16.maxInt',
minInt' = Primitive.Int16.minInt'}}
- val (fromInt32, fromIntZ32, toInt32, toIntX32) =
+ val (fromInt32, fromInt32Z, toInt32, toInt32X) =
make {fromIntUnsafe = fromInt32Unsafe,
- fromIntZUnsafe = fromIntZ32Unsafe,
+ fromIntZUnsafe = fromInt32ZUnsafe,
toIntUnsafe = toInt32Unsafe,
- toIntXUnsafe = toIntX32Unsafe,
+ toIntXUnsafe = toInt32XUnsafe,
other = {precision' = Primitive.Int32.precision',
maxInt' = Primitive.Int32.maxInt',
minInt' = Primitive.Int32.minInt'}}
- val (fromInt64, fromIntZ64, toInt64, toIntX64) =
+ val (fromInt64, fromInt64Z, toInt64, toInt64X) =
make {fromIntUnsafe = fromInt64Unsafe,
- fromIntZUnsafe = fromIntZ64Unsafe,
+ fromIntZUnsafe = fromInt64ZUnsafe,
toIntUnsafe = toInt64Unsafe,
- toIntXUnsafe = toIntX64Unsafe,
+ toIntXUnsafe = toInt64XUnsafe,
other = {precision' = Primitive.Int64.precision',
maxInt' = Primitive.Int64.maxInt',
minInt' = Primitive.Int64.minInt'}}
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)
+ val (fromWord8, fromWord8X, toWord8, toWord8X) =
+ (fromWord8Unsafe, fromWord8XUnsafe, toWord8Unsafe, toWord8XUnsafe)
+ val (fromWord16, fromWord16X, toWord16, toWord16X) =
+ (fromWord16Unsafe, fromWord16XUnsafe, toWord16Unsafe, toWord16XUnsafe)
+ val (fromWord32, fromWord32X, toWord32, toWord32X) =
+ (fromWord32Unsafe, fromWord32XUnsafe, toWord32Unsafe, toWord32XUnsafe)
+ val (fromWord64, fromWord64X, toWord64, toWord64X) =
+ (fromWord64Unsafe, fromWord64XUnsafe, toWord64Unsafe, toWord64XUnsafe)
end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml (from rev 4350, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-02-10 00:42:03 UTC (rev 4350)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -0,0 +1,218 @@
+(* 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 WORD_FROM_TO_ARG =
+ sig
+ type word
+ (* Lowbits or sign extend. *)
+ 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 fromIntInf: Primitive.IntInf.int -> word
+ (* Lowbits or zero extend. *)
+ val fromWord8: Primitive.Word8.word -> word
+ val fromWord16: Primitive.Word16.word -> word
+ val fromWord32: Primitive.Word32.word -> word
+ val fromWord64: Primitive.Word64.word -> word
+ (* Overflow checking, unsigned interp. *)
+ 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 toIntInf: word -> Primitive.IntInf.int
+ (* Overflow checking, signed interp. *)
+ val toInt8X: word -> Primitive.Int8.int
+ val toInt16X: word -> Primitive.Int16.int
+ val toInt32X: word -> Primitive.Int32.int
+ val toInt64X: word -> Primitive.Int64.int
+ val toIntInfX: word -> Primitive.IntInf.int
+ (* Lowbits or zero extend. *)
+ val toWord8: word -> Primitive.Word8.word
+ val toWord16: word -> Primitive.Word16.word
+ val toWord32: word -> Primitive.Word32.word
+ val toWord64: word -> Primitive.Word64.word
+ (* Lowbits or sign extend. *)
+ val toWord8X: word -> Primitive.Word8.word
+ val toWord16X: word -> Primitive.Word16.word
+ val toWord32X: word -> Primitive.Word32.word
+ val toWord64X: word -> Primitive.Word64.word
+ end
+
+signature WORD_FROM_TO_RES =
+ sig
+ type word
+
+ val fromInt: Int.int -> word
+ val fromLarge: LargeWord.word -> word
+ val fromLargeInt: LargeInt.int -> word
+ val fromLargeWord: LargeWord.word -> word
+
+ val toInt: word -> Int.int
+ val toIntX: word -> Int.int
+ val toLarge: word -> LargeWord.word
+ val toLargeX: word -> LargeWord.word
+ val toLargeInt: word -> LargeInt.int
+ val toLargeIntX: word -> LargeInt.int
+ val toLargeWord: word -> LargeWord.word
+ val toLargeWordX: word -> LargeWord.word
+ end
+
+functor WordFromTo (W: WORD_FROM_TO_ARG): WORD_FROM_TO_RES where type word = W.word =
+ struct
+ open W
+
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = 'a -> word
+ val fInt8 = W.fromInt8
+ val fInt16 = W.fromInt16
+ val fInt32 = W.fromInt32
+ val fInt64 = W.fromInt64
+ val fIntInf = W.fromIntInf)
+ in
+ val fromInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = 'a -> word
+ val fInt8 = W.fromInt8
+ val fInt16 = W.fromInt16
+ val fInt32 = W.fromInt32
+ val fInt64 = W.fromInt64
+ val fIntInf = W.fromIntInf)
+ in
+ val fromLargeInt = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8
+ val fWord16 = W.fromWord16
+ val fWord32 = W.fromWord32
+ val fWord64 = W.fromWord64)
+ in
+ val fromLarge = S.f
+ val fromLargeWord = fromLarge
+ end
+
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = word -> 'a
+ val fInt8 = W.toInt8
+ val fInt16 = W.toInt16
+ val fInt32 = W.toInt32
+ val fInt64 = W.toInt64
+ val fIntInf = W.toIntInf)
+ in
+ val toInt = S.f
+ end
+ local
+ structure S =
+ Int_ChooseInt
+ (type 'a t = word -> 'a
+ val fInt8 = W.toInt8X
+ val fInt16 = W.toInt16X
+ val fInt32 = W.toInt32X
+ val fInt64 = W.toInt64X
+ val fIntInf = W.toIntInfX)
+ in
+ val toIntX = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = word -> 'a
+ val fInt8 = W.toInt8
+ val fInt16 = W.toInt16
+ val fInt32 = W.toInt32
+ val fInt64 = W.toInt64
+ val fIntInf = W.toIntInf)
+ in
+ val toLargeInt = S.f
+ end
+ local
+ structure S =
+ LargeInt_ChooseInt
+ (type 'a t = word -> 'a
+ val fInt8 = W.toInt8X
+ val fInt16 = W.toInt16X
+ val fInt32 = W.toInt32X
+ val fInt64 = W.toInt64X
+ val fIntInf = W.toIntInfX)
+ in
+ val toLargeIntX = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = word -> 'a
+ val fWord8 = W.toWord8
+ val fWord16 = W.toWord16
+ val fWord32 = W.toWord32
+ val fWord64 = W.toWord64)
+ in
+ val toLarge = S.f
+ val toLargeWord = toLarge
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = word -> 'a
+ val fWord8 = W.toWord8X
+ val fWord16 = W.toWord16X
+ val fWord32 = W.toWord32X
+ val fWord64 = W.toWord64X)
+ in
+ val toLargeX = S.f
+ val toLargeWordX = toLargeX
+ end
+
+
+ end
+
+structure Primitive = struct
+open Primitive
+
+structure Word8 = struct
+ open Word8
+ local
+ structure S = WordFromTo (Primitive.Word8)
+ in
+ open S
+ end
+ end
+structure Word16 = struct
+ open Word16
+ local
+ structure S = WordFromTo (Primitive.Word16)
+ in
+ open S
+ end
+ end
+structure Word32 = struct
+ open Word32
+ local
+ structure S = WordFromTo (Primitive.Word32)
+ in
+ open S
+ end
+ end
+structure Word64 = struct
+ open Word64
+ local
+ structure S = WordFromTo (Primitive.Word64)
+ in
+ open S
+ end
+ end
+end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/list/list.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/list/list.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/list/list.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -8,9 +8,9 @@
structure List: LIST =
struct
- open Primitive.Int
+ open Int
- datatype list = datatype list
+ datatype list = datatype Primitive.List.list
exception Empty
@@ -101,7 +101,7 @@
fun all pred = not o (exists (not o pred))
fun tabulate (n, f) =
- if Primitive.safe andalso n < 0
+ if Primitive.Controls.safe andalso n < 0
then raise Size
else let
fun loop (i, ac) =
@@ -121,7 +121,7 @@
then loop (l, n - 1)
else x
in
- if Primitive.safe andalso n < 0
+ if Primitive.Controls.safe andalso n < 0
then raise Subscript
else loop (l, n)
end
@@ -135,7 +135,7 @@
| x :: l => loop (l, n - 1, x :: ac))
else rev ac
in
- if Primitive.safe andalso n < 0
+ if Primitive.Controls.safe andalso n < 0
then raise Subscript
else loop (l, n, [])
end
@@ -149,7 +149,7 @@
| _ :: l => loop (l, n - 1))
else l
in
- if Primitive.safe andalso n < 0
+ if Primitive.Controls.safe andalso n < 0
then raise Subscript
else loop (l, n)
end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map (from rev 4348, 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 15:30:17 UTC (rev 4348)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/default-real64.map 2006-02-10 03:21:00 UTC (rev 4352)
@@ -0,0 +1 @@
+DEFAULT_REAL default-real64.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml 2006-02-10 01:28:43 UTC (rev 4351)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml 2006-02-10 03:21:00 UTC (rev 4352)
@@ -57,10 +57,10 @@
val fromInt64Unsafe: Primitive.Int64.int -> int
(* Lowbits or zero extend. *)
- 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 fromInt8ZUnsafe: Primitive.Int8.int -> int
+ val fromInt16ZUnsafe: Primitive.Int16.int -> int
+ val fromInt32ZUnsafe: Primitive.Int32.int -> int
+ val fromInt64ZUnsafe: Primitive.Int64.int -> int
(* Lowbits or zero extend. *)
val fromWord8Unsafe: Primitive.Word8.word -> int
@@ -69,10 +69,10 @@
val fromWord64Unsafe: Primitive.Word64.word -> int
(* Lowbits or sign extend. *)
- 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 fromWord8XUnsafe: Primitive.Word8.word -> int
+ val fromWord16XUnsafe: Primitive.Word16.word -> int
+ val fromWord32XUnsafe: Primitive.Word32.word -> int
+ val fromWord64XUnsafe: Primitive.Word64.word -> int
(* Lowbits or sign extend. *)
val toInt8Unsafe: int -> Primitive.Int8.int
@@ -81,10 +81,10 @@
val toInt64Unsafe: int -> Primitive.Int64.int
(* Lowbits or zero extend. *)
- 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 toInt8ZUnsafe: int -> Primitive.Int8.int
+ val toInt16ZUnsafe: int -> Primitive.Int16.int
+ val toInt32ZUnsafe: int -> Primitive.Int32.int
+ val toInt64ZUnsafe: int -> Primitive.Int64.int
(* Lowbits or zero extend. *)
val toWord8Unsafe: int -> Primitive.Word8.word
@@ -93,10 +93,10 @@
val toWord64Unsafe: int -> Primitive.Word64.word
(* Lowbits or sign extend. *)
- 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 toWord8XUnsafe: int -> Primitive.Word8.word
+ val toWord16XUnsafe: int -> Primitive.Word16.word
+ val toWord32XUnsafe: int -> Primitive.Word32.word
+ val toWord64XUnsafe: int -> Primitive.Word64.word
end
structure Primitive = struct
@@ -206,40 +206,40 @@
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 fromInt8ZUnsafe = _prim "WordU8_toWord8": Int8.int -> int;
+ val fromInt16ZUnsafe = _prim "WordU16_toWord8": Int16.int -> int;
+ val fromInt32ZUnsafe = _prim "WordU32_toWord8": Int32.int -> int;
+ val fromInt64ZUnsafe = _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 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 fromWord8XUnsafe = _prim "WordS8_toWord8": Word8.word -> int;
+ val fromWord16XUnsafe = _prim "WordS16_toWord8": Word16.word -> int;
+ val fromWord32XUnsafe = _prim "WordS32_toWord8": Word32.word -> int;
+ val fromWord64XUnsafe = _prim "WordS64_toWord8": Word64.word -> int;
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 toInt8ZUnsafe = _prim "WordU8_toWord8": int -> Int8.int;
+ val toInt16ZUnsafe = _prim "WordU8_toWord16": int -> Int16.int;
+ val toInt32ZUnsafe = _prim "WordU8_toWord32": int -> Int32.int;
+ val toInt64ZUnsafe = _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 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 toWord8XUnsafe = _prim "WordS8_toWord8": int -> Word8.word;
+ val toWord16XUnsafe =...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-09 17:28:44
|
Better splitting of compiler from annotation
----------------------------------------------------------------------
U mlton/trunk/mlton/control/control-flags.sml
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2006-02-10 00:42:03 UTC (rev 4350)
+++ mlton/trunk/mlton/control/control-flags.sml 2006-02-10 01:28:43 UTC (rev 4351)
@@ -534,17 +534,18 @@
local
fun checkPrefix (s, f) =
- case String.fields (s, fn c => c = #":") of
- [s] => f s
- | [comp,s] =>
+ case String.peeki (s, fn (_, c) => c = #":") of
+ NONE => f s
+ | SOME (i, _) =>
let
+ val comp = String.prefix (s, i)
val comp = String.deleteSurroundingWhitespace comp
+ val s = String.dropPrefix (s, i + 1)
in
if String.equals (comp, "mlton")
then f s
else Other
end
- | _ => Bad
in
val parseId = fn s => checkPrefix (s, parseId)
val parseIdAndArgs = fn s => checkPrefix (s, parseIdAndArgs)
|
|
From: Matthew F. <fl...@ml...> - 2006-02-09 16:42:08
|
Numerous fixes to IntInf.{to,from}{Int,Word{,X}}{8,16,32,64} code.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml
U 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/header/
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word64.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml
D 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/config/seq/seqindex-int32.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seqindex-int64.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
U 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/header-word32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/header-word64.map
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index32.map
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seq-index64.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int32.map
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/maps/seqindex-int64.map
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/misc/reader.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-nullstring.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-seq.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-word.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/test/Makefile
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/print.c
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/test/test.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/Stdio.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-02-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -983,6 +983,8 @@
structure Stdio =
struct
val print = _import "Stdio_print" : String8.t -> unit;
+val printStderr = _import "Stdio_printStderr" : String8.t -> unit;
+val printStdout = _import "Stdio_printStdout" : String8.t -> unit;
end
structure Time =
struct
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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-02-10 00:42:03 UTC (rev 4350)
@@ -20,28 +20,31 @@
../bin/clean
+OBJPTR_REP_MAPS = objptr-rep32.map objptr-rep64.map
+HEADER_MAPS = header-word32.map header-word64.map
+SEQ_INDEX_MAPS = seqindex-int32.map seqindex-int64.map
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 objptrrep in $(OBJPTR_REP_MAPS); do \
+ for header in $(HEADER_MAPS); do \
+ for seqindex in $(SEQ_INDEX_MAPS); do \
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"; \
+ echo "Type checking: $$objptrrep $$header $$seqindex $$ctypes $$defchar $$defint $$defword"; \
$(MLTON) -disable-ann deadCode -stop tc -show-types true \
+ -mlb-path-map "maps/$$objptrrep" \
+ -mlb-path-map "maps/$$header" \
+ -mlb-path-map "maps/$$seqindex" \
-mlb-path-map "maps/$$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
+ done; done; done; done; done; done; done
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-02-10 00:42:03 UTC (rev 4350)
@@ -20,9 +20,10 @@
../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/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
+ ../config/c/misc/$(CTYPES)
end end
../integer/int-inf0.sml
local ../config/bind-for-config0.sml in ann "forceUsed" in
@@ -31,9 +32,10 @@
../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/header/$(HEADER_WORD)
../config/seq/$(SEQ_INDEX)
+ ../config/c/misc/$(CTYPES)
end end
(*
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml 2006-02-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -5,6 +5,24 @@
* See the file MLton-LICENSE for details.
*)
+signature CHOOSE_CHARN_ARG =
+ sig
+ type 'a t
+ val fChar8: Char8.char t
+ val fChar16: Char16.char t
+ val fChar32: Char32.char t
+ end
+
+functor ChooseCharN_Char8 (A : CHOOSE_CHARN_ARG) :
+ sig val f : Char8.char A.t end =
+ struct val f = A.fChar8 end
+functor ChooseCharN_Char16 (A : CHOOSE_CHARN_ARG) :
+ sig val f : Char16.char A.t end =
+ struct val f = A.fChar16 end
+functor ChooseCharN_Char32 (A : CHOOSE_CHARN_ARG) :
+ sig val f : Char32.char A.t end =
+ struct val f = A.fChar32 end
+
signature CHOOSE_INTN_ARG =
sig
type 'a t
@@ -27,6 +45,32 @@
sig val f : Int64.int A.t end =
struct val f = A.fInt64 end
+signature CHOOSE_INT_ARG =
+ sig
+ type 'a t
+ val fInt8: Int8.int t
+ val fInt16: Int16.int t
+ val fInt32: Int32.int t
+ val fInt64: Int64.int t
+ val fIntInf: IntInf.int t
+ end
+
+functor ChooseInt_Int8 (A : CHOOSE_INT_ARG) :
+ sig val f : Int8.int A.t end =
+ struct val f = A.fInt8 end
+functor ChooseInt_Int16 (A : CHOOSE_INT_ARG) :
+ sig val f : Int16.int A.t end =
+ struct val f = A.fInt16 end
+functor ChooseInt_Int32 (A : CHOOSE_INT_ARG) :
+ sig val f : Int32.int A.t end =
+ struct val f = A.fInt32 end
+functor ChooseInt_Int64 (A : CHOOSE_INT_ARG) :
+ sig val f : Int64.int A.t end =
+ struct val f = A.fInt64 end
+functor ChooseInt_IntInf (A : CHOOSE_INT_ARG) :
+ sig val f : IntInf.int A.t end =
+ struct val f = A.fIntInf end
+
signature CHOOSE_REALN_ARG =
sig
type 'a t
@@ -41,6 +85,24 @@
sig val f : Real64.real A.t end =
struct val f = A.fReal64 end
+signature CHOOSE_STRINGN_ARG =
+ sig
+ type 'a t
+ val fString8: String8.string t
+ val fString16: String16.string t
+ val fString32: String32.string t
+ end
+
+functor ChooseStringN_String8 (A : CHOOSE_STRINGN_ARG) :
+ sig val f : String8.string A.t end =
+ struct val f = A.fString8 end
+functor ChooseStringN_String16 (A : CHOOSE_STRINGN_ARG) :
+ sig val f : String16.string A.t end =
+ struct val f = A.fString16 end
+functor ChooseStringN_String32 (A : CHOOSE_STRINGN_ARG) :
+ sig val f : String32.string A.t end =
+ struct val f = A.fString32 end
+
signature CHOOSE_WORDN_ARG =
sig
type 'a t
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-char8.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -9,3 +9,11 @@
type char = Char.char
structure String = String8
type string = String.string
+
+functor Char_ChooseChar (A: CHOOSE_CHARN_ARG) :
+ sig val f : Char.char A.t end =
+ ChooseCharN_Char8 (A)
+
+functor String_ChooseString (A: CHOOSE_STRINGN_ARG) :
+ sig val f : String.string A.t end =
+ ChooseStringN_String8 (A)
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int32.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -8,26 +8,6 @@
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
+functor Int_ChooseInt (A: CHOOSE_INT_ARG) :
+ sig val f : Int.int A.t end =
+ ChooseInt_Int32 (A)
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-int64.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -8,26 +8,6 @@
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
+functor Int_ChooseInt (A: CHOOSE_INT_ARG) :
+ sig val f : Int.int A.t end =
+ ChooseInt_Int64 (A)
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-intinf.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -8,26 +8,6 @@
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
+functor Int_ChooseInt (A: CHOOSE_INT_ARG) :
+ sig val f : Int.int A.t end =
+ ChooseInt_IntInf (A)
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word32.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -8,12 +8,6 @@
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
+functor Word_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : Word.word A.t end =
+ ChooseWordN_Word32 (A)
Modified: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/default/default-word64.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -8,12 +8,6 @@
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
+functor Word_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : Word.word A.t end =
+ ChooseWordN_Word64 (A)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word32.sml (from rev 4348, 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 15:30:17 UTC (rev 4348)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word32.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -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 HeaderWord = Word32
+
+functor HeaderWord_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : HeaderWord.word A.t end =
+ ChooseWordN_Word32 (A)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word64.sml (from rev 4348, 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 15:30:17 UTC (rev 4348)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/header/header-word64.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -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 HeaderWord = Word64
+
+functor HeaderWord_ChooseWordN (A: CHOOSE_WORDN_ARG) :
+ sig val f : HeaderWord.word A.t end =
+ ChooseWordN_Word64 (A)
Deleted: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -1,12 +0,0 @@
-(* 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)
Deleted: 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-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -1,12 +0,0 @@
-(* 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/config/seq/seqindex-int32.sml (from rev 4348, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index32.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seqindex-int64.sml (from rev 4348, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/seq/seq-index64.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 00:38:30 UTC (rev 4349)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-02-10 00:42:03 UTC (rev 4350)
@@ -24,16 +24,20 @@
val one: int
val abs: int -> int
+ val +? : int * 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 -> int
+ val ~? : 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 -> int
val < : int * int -> bool
@@ -53,33 +57,39 @@
val toString8: int -> Primitive.String8.string
+ (* Sign extend. *)
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
+ (* Zero extend. *)
val fromWord8: Primitive.Word8.word -> int
val fromWord16: Primitive.Word16.word -> int
val fromWord32: Primitive.Word32.word -> int
val fromWord64: Primitive.Word64.word -> int
+ (* Sign extend. *)
val fromWordX8: Primitive.Word8.word -> int
val fromWordX16: Primitive.Word16.word -> int
val fromWordX32: Primitive.Word32.word -> int
val fromWordX64: Primitive.Word64.word -> int
+ (* Overflow checking. *)
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
+ (* Lowbits. *)
val toWord8: int -> Primitive.Word8.word
val toWord16: int -> Primitive.Word16.word
val toWord32: int -> Primitive.Word32.word
val toWord64: int -> Primitive.Word64.word
+ (* Lowbits. *)
val toWordX8: int -> Primitive.Word8.word
val toWordX16: int -> Primitive.Word16.word
val toWordX32: int -> Primitive.Word32.word
@@ -98,7 +108,43 @@
structure V = Primitive.Vector
structure S = SeqIndex
- structure W = ObjptrWord
+ structure W = struct
+ open ObjptrWord
+ local
+ structure S =
+ ObjptrInt_ChooseIntN
+ (type 'a t = 'a -> ObjptrWord.word
+ val fInt8 = ObjptrWord.fromInt8
+ val fInt16 = ObjptrWord.fromInt16
+ val fInt32 = ObjptrWord.fromInt32
+ val fInt64 = ObjptrWord.fromInt64)
+ in
+ val fromObjptrInt = S.f
+ end
+ local
+ structure S =
+ ObjptrInt_ChooseIntN
+ (type 'a t = ObjptrWord.word -> 'a
+ val fInt8 = ObjptrWord.toInt8
+ val fInt16 = ObjptrWord.toInt16
+ val fInt32 = ObjptrWord.toInt32
+ val fInt64 = ObjptrWord.toInt64)
+ in
+ val toObjptrInt = S.f
+ end
+ local
+ structure S =
+ ObjptrInt_ChooseIntN
+ (type 'a t = ObjptrWord.word -> 'a
+ val fInt8 = ObjptrWord.toIntX8
+ val fInt16 = ObjptrWord.toIntX16
+ val fInt32 = ObjptrWord.toIntX32
+ val fInt64 = ObjptrWord.toIntX64)
+ in
+ val toObjptrIntX = S.f
+ end
+ end
+
structure I = ObjptrInt
structure MPLimb = C_MPLimb
structure Sz = struct
@@ -142,10 +188,10 @@
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 dropTagCoerceInt (i: bigInt): I.int = W.toObjptrIntX (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 addTagCoerceInt (i: I.int): bigInt = addTagCoerce (W.fromObjptrInt 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)
@@ -155,394 +201,303 @@
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
+ rshift: 'a * Word32.word -> 'a}}
+ (isneg, w) =
+ if Int32.> (ObjptrWord.wordSize', #wordSize' other)
+ orelse let
+ val upperBits =
+ (#rshift other)
+ (w, Word32.- (ObjptrWord.wordSizeWord', 0w2))
+ in
+ (#eq other) (upperBits, #zero other)
+ end
+ then let
+ val ans = toObjptrWord w
+ val ans = if isneg then ObjptrWord.~ ans else ans
+ in
+ Prim.fromWord (addTag ans)
+ end
+ else let
+ fun loop (w, i, acc) =
+ if (#eq other) (w, (#zero other))
+ then (i, acc)
+ else
+ let
+ val limb = toMPLimb w
+ val w =
+ (#rshift other)
+ (w, MPLimb.wordSizeWord')
+ in
+ loop (w, S.+ (i, 1), (i, limb) :: acc)
+ end
+ val (n, acc) =
+ loop (w, 1, [(0, if isneg then 0w1 else 0w0)])
+ val a = A.array n
+ fun loop acc =
+ case acc of
+ [] => ()
+ | (i, v) :: acc => (A.updateUnsafe (a, i, v)
+ ; loop acc)
+ val () = loop acc
+ in
+ Prim.fromVector (V.fromArray a)
+ end
in
- val fromWord8 =
+ val fromWordAux8 =
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 =
+ fun fromWord8 w = fromWordAux8 (false, w)
+ fun fromInt8 i =
+ if Int8.>= (i, 0)
+ then fromWordAux8 (false, Word8.fromInt8 i)
+ else fromWordAux8 (true, Word8.~ (Word8.fromInt8 i))
+ fun fromWordX8 w = fromInt8 (Word8.toIntX8 w)
+
+ val fromWordAux16 =
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 =
+ fun fromWord16 w = fromWordAux16 (false, w)
+ fun fromInt16 i =
+ if Int16.>= (i, 0)
+ then fromWordAux16 (false, Word16.fromInt16 i)
+ else fromWordAux16 (true, Word16.~ (Word16.fromInt16 i))
+ fun fromWordX16 w = fromInt16 (Word16.toIntX16 w)
+
+ val fromWordAux32 =
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 =
+ fun fromWord32 w = fromWordAux32 (false, w)
+ fun fromInt32 i =
+ if Int32.>= (i, 0)
+ then fromWordAux32 (false, Word32.fromInt32 i)
+ else fromWordAux32 (true, Word32.~ (Word32.fromInt32 i))
+ fun fromWordX32 w = fromInt32 (Word32.toIntX32 w)
+
+ val fromWordAux64 =
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.>>}}
+ fun fromWord64 w = fromWordAux64 (false, w)
+ fun fromInt64 i =
+ if Int64.>= (i, 0)
+ then fromWordAux64 (false, Word64.fromInt64 i)
+ else fromWordAux64 (true, Word64.~ (Word64.fromInt64 i))
+ fun fromWordX64 w = fromInt64 (Word64.toIntX64 w)
+
+ fun fromIntInf i = i
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
+ structure S =
+ ObjptrInt_ChooseIntN
+ (type 'a t = 'a -> bigInt
+ val fInt8 = fromInt8
+ val fInt16 = fromInt16
+ val fInt32 = fromInt32
+ val fInt64 = fromInt64)
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
+ val fromObjptrInt = S.f
end
local
+ datatype 'a ans =
+ Big of bool * bool * 'a
+ | Small of ObjptrWord.word
fun 'a make {fromMPLimb: MPLimb.word -> 'a,
- fromObjptrWordX: ObjptrWord.word -> 'a,
other : {wordSize': Int32.int,
+ wordSizeWord': Word32.word,
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
+ orb: 'a * 'a -> 'a}} i =
+ if isSmall i
+ then Small (dropTagCoerce i)
+ else let
+ val v = Prim.toVector i
+ val n = V.length v
+ val isneg = V.subUnsafe (v, 0) <> 0w0
+ in
+ if Int32.>= (MPLimb.wordSize', #wordSize' other)
+ then let
+ val limbsPer = 1
+ val limb = V.subUnsafe (v, 1)
+ val extra =
+ S.> (n, S.+ (limbsPer, 1))
+ orelse
+ (MPLimb.>> (limb, #wordSizeWord' other)) <> 0w0
+ val ans = fromMPLimb limb
+ in
+ Big (isneg, extra, ans)
+ end
+ else let
+ val limbsPer =
+ S.fromInt32 (Int32.quot (#wordSize' other,
+ MPLimb.wordSize'))
+ val extra =
+ S.> (n, S.+ (limbsPer, 1))
+ val ans =
+ let
+ fun loop (i, ans) =
+ if S.> (i, 0)
+ then let
+ val limb = V.subUnsafe (v, i)
+ val ans =
+ (#orb other)
+ ((#lshift other)
+ (ans, MPLimb.wordSizeWord'),
+ fromMPLimb limb)
+ in
+ loop (S.- (i, 1), ans)
+ end
+ else ans
+ in
+ loop (S.min (S.- (n, 1), limbsPer), #zero other)
+ end
+ in
+ Big (isneg, extra, ans)
+ end
+ end
in
- val toWord8 =
+ val toWordAux8 =
make {fromMPLimb = MPLimb.toWord8,
- fromObjptrWordX = ObjptrWord.toWordX8,
other = {wordSize' = Word8.wordSize',
+ wordSizeWord' = Word8.wordSizeWord',
zero = Word8.zero,
lshift = Word8.<<,
- neg = Word8.~,
orb = Word8.orb}}
- val toWordX8 = toWord8
- val toWord16 =
+ fun toWordX8 i =
+ case toWordAux8 i of
+ Small w => ObjptrWord.toWordX8 w
+ | Big (isneg, _, ans) => if isneg then Word8.~ ans else ans
+ fun toWord8 i = toWordX8 i
+ fun toInt8 i =
+ case toWordAux8 i of
+ Small w => ObjptrWord.toIntX8 w
+ | Big (isneg, extra, ans) =>
+ if extra
+ then raise Overflow
+ else if isneg
+ then let
+ val ans = Word8.toIntX8 (Word8.~ ans)
+ in
+ if Int8.>= (ans, 0)
+ then raise Overflow
+ else ans
+ end
+ else Word8.toInt8 ans
+
+ val toWordAux16 =
make {fromMPLimb = MPLimb.toWord16,
- fromObjptrWordX = ObjptrWord.toWordX16,
other = {wordSize' = Word16.wordSize',
+ wordSizeWord' = Word16.wordSizeWord',
zero = Word16.zero,
lshift = Word16.<<,
- neg = Word16.~,
orb = Word16.orb}}
- val toWordX16 = toWord16
- val toWord32 =
+ fun toWordX16 i =
+ case toWordAux16 i of
+ Small w => ObjptrWord.toWordX16 w
+ | Big (isneg, _, ans) => if isneg then Word16.~ ans else ans
+ fun toWord16 i = toWordX16 i
+ fun toInt16 i =
+ case toWordAux16 i of
+ Small w => ObjptrWord.toIntX16 w
+ | Big (isneg, extra, ans) =>
+ if extra
+ then raise Overflow
+ else if isneg
+ then let
+ val ans = Word16.toIntX16 (Word16.~ ans)
+ in
+ if Int16.>= (ans, 0)
+ then raise Overflow
+ else ans
+ end
+ else Word16.toInt16 ans
+
+ val toWordAux32 =
make {fromMPLimb = MPLimb.toWord32,
- fromObjptrWordX = ObjptrWord.toWordX32,
other = {wordSize' = Word32.wordSize',
+ wordSizeWord' = Word32.wordSizeWord',
zero = Word32.zero,
lshift = Word32.<<,
- neg = Word32.~,
orb = Word32.orb}}
- val toWordX32 = toWord32
- val toWord64 =
+ fun toWordX32 i =
+ case toWordAux32 i of
+ Small w => ObjptrWord.toWordX32 w
+ | Big (isneg, _, ans) => if isneg then Word32.~ ans else ans
+ fun toWord32 i = toWordX32 i
+ fun toInt32 i =
+ case toWordAux32 i of
+ Small w => ObjptrWord.toIntX32 w
+ | Big (isneg, extra, ans) =>
+ if extra
+ then raise Overflow
+ else if isneg
+ then let
+ val ans = Word32.toIntX32 (Word32.~ ans)
+ in
+ if Int32.>= (ans, 0)
+ then raise Overflow
+ else ans
+ end
+ else Word32.toInt32 ans
+
+ val toWordAux64 =
make {fromMPLimb = MPLimb.toWord64,
- fromObjptrWordX = ObjptrWord.toWordX64,
other = {wordSize' = Word64.wordSize',
+ wordSizeWord' = Word64.wordSizeWord',
zero = Word64.zero,
lshift = Word64.<<,
- neg = Word64.~,
orb = Word64.orb}}
- val toWordX64 = toWord64
+ fun toWordX64 i =
+ case toWordAux64 i of
+ Small w => ObjptrWord.toWordX64 w
+ | Big (isneg, _, ans) => if isneg then Word64.~ ans else ans
+ fun toWord64 i = toWordX64 i
+ fun toInt64 i =
+ case toWordAux64 i of
+ Small w => ObjptrWord.toIntX64 w
+ | Big (isneg, extra, ans) =>
+ if extra
+ then raise Overflow
+ else if isneg
+ then let
+ val ans = Word64.toIntX64 (Word64.~ ans)
+ in
+ if Int64.>= (ans, 0)
+ then raise Overflow
+ else ans
+ end
+ else Word64.toInt64 ans
+
+ fun toIntInf i = i
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
+ val bytesPerHeader = Sz.fromInt32 (Int32.quot (HeaderWord.wordSize', 8))
in
val bytesPerArrayHeader =
Sz.+ (bytesPerCounter, Sz.+ (bytesPerLength, bytesPerHeader))
@@ -563,20 +518,20 @@
* 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 badObjptrWord: W.word = W.fromObjptrInt badObjptrInt
val badObjptrWordTagged: W.word = addTag badObjptrWord
- val badObjptrIntTagged: I.int = W.toIntXEq badObjptrWordTagged
+ val badObjptrIntTagged: I.int = W.toObjptrIntX 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)
+ I.>= (W.toObjptrIntX (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
+ V.subUnsafe (Prim.toVector arg, 0) <> 0w0
local
fun make (smallOp, bigOp, limbsFn, extra)
@@ -586,11 +541,11 @@
if areSmall (lhs, rhs)
then let
val lhsw = dropTagCoerce lhs
- val lhsi = W.toIntXEq lhsw
+ val lhsi = W.toObjptrIntX lhsw
val rhsw = dropTagCoerce rhs
- val rhsi = W.toIntXEq rhsw
+ val rhsi = W.toObjptrIntX rhsw
val ansi = smallOp (lhsi, rhsi)
- val answ = W.fromIntEq ansi
+ val answ = W.fromObjptrInt ansi
val ans = addTag answ
in
if sameSignBit (ans, answ)
@@ -626,16 +581,16 @@
if areSmall (num, den)
then let
val numw = dropTagCoerce num
- val numi = W.toIntXEq numw
+ val numi = W.toObjptrIntX numw
val denw = dropTagCoerce den
- val deni = W.toIntXEq numw
+ val deni = W.toObjptrIntX numw
in
if numw = badObjptrWord
andalso deni = ~1
then negBadIntInf
else let
val ansi = I.quot (numi, deni)
- val answ = W.fromIntEq ansi
+ val answ = W.fromObjptrInt ansi
val ans = addTag answ
in
Prim.fromWord ans
@@ -650,18 +605,18 @@
else if den = zero
then raise Div
else Prim.quot (num, den,
- reserve (S.- (nlimbs, dlimbs), 1))
+ reserve (S.- (nlimbs, dlimbs), 2))
end
fun bigRem (num: bigInt, den: bigInt): bigInt =
if areSmall (num, den)
then let
val numw = dropTagCoerce num
- val numi = W.toIntXEq numw
+ val numi = W.toObjptrIntX numw
val denw = dropTagCoerce den
- val deni = W.toIntXEq numw
+ val deni = W.toObjptrIntX numw
val ansi = I.rem (numi, deni)
- val answ = W.fromIntEq ansi
+ val answ = W.fromObjptrInt ansi
val ans = addTag answ
in
Prim.fromWord ans
@@ -727,16 +682,16 @@
fun bigCompare (lhs: bigInt, rhs: bigInt): order =
if areSmall (lhs, rhs)
- then I.compare (W.toIntXEq (Prim.toWord lhs),
- W.toIntXEq (Prim.toWord rhs))
+ then I.compare (W.toObjptrIntX (Prim.toWord lhs),
+ W.toObjptrIntX (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))
+ then smallTest (W.toObjptrIntX (Prim.toWord lhs),
+ W.toObjptrIntX (Prim.toWord rhs))
else int32Test (Prim.compare (lhs, rhs), 0)
in
val bigLT = make (I.<, Int32.<)
@@ -752,7 +707,7 @@
in
if argw = badObjptrWordTagged
then negBadIntInf
- else if I.< (W.toIntXEq argw, 0)
+ else if I.< (W.toObjptrIntX argw, 0)
then Prim.fromWord (W.- (0w2, argw))
else arg
end
@@ -872,16 +827,20 @@
val minInt = NONE
val abs = bigAbs
+ val op +? = bigAdd
val op + = bigAdd
val divMod = bigDivMod
val op div = bigDiv
val gcd = bigGcd
val op mod = bigMod
+ val op *? = bigMul
val op * = bigMul
+ val op ~? = bigNeg
val op ~ = bigNeg
val quotRem = bigQuotRem
val quot = bigQuot
val rem = bigRem
+ val op -? = bigSub
val op - = bigSub
val op < = bigLT
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int0.sml
==========================...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-09 16:38:32
|
MAIL preliminary support for compiler specific annotations
Added very simple support for compiler specific annotations. If an
annotation contains ":", then the text preceding the ":" is meant to
denote a compiler. For MLton, if the text preceding the ":" is equal
to "mlton", then the remaining annotation is scanned as a normal
annotation. If the text preceding the ":" is not-equal to "mlton",
then the annotation is ignored, and no warning is issued.
----------------------------------------------------------------------
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/elaborate/elaborate-mlbs.fun
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2006-02-05 15:30:17 UTC (rev 4348)
+++ mlton/trunk/mlton/control/control-flags.sig 2006-02-10 00:38:30 UTC (rev 4349)
@@ -94,7 +94,7 @@
val name: ('args, 'st) t -> string
datatype ('a, 'b) parseResult =
- Bad | Deprecated of 'a | Good of 'b
+ Bad | Deprecated of 'a | Good of 'b | Other
structure Id :
sig
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2006-02-05 15:30:17 UTC (rev 4348)
+++ mlton/trunk/mlton/control/control-flags.sml 2006-02-10 00:38:30 UTC (rev 4349)
@@ -174,7 +174,7 @@
fun equalsId (ctrl, id') = Id.equals (id ctrl, id')
datatype ('a, 'b) parseResult =
- Bad | Deprecated of 'a | Good of 'b
+ Bad | Deprecated of 'a | Good of 'b | Other
val deGood =
fn Good z => z
| _ => Error.bug "Control.Elaborate.deGood"
@@ -532,6 +532,24 @@
val {parseId, parseIdAndArgs} = ac
end
+ local
+ fun checkPrefix (s, f) =
+ case String.fields (s, fn c => c = #":") of
+ [s] => f s
+ | [comp,s] =>
+ let
+ val comp = String.deleteSurroundingWhitespace comp
+ in
+ if String.equals (comp, "mlton")
+ then f s
+ else Other
+ end
+ | _ => Bad
+ in
+ val parseId = fn s => checkPrefix (s, parseId)
+ val parseIdAndArgs = fn s => checkPrefix (s, parseIdAndArgs)
+ end
+
val processDefault = fn s =>
case parseIdAndArgs s of
Bad => Bad
@@ -540,6 +558,7 @@
(alts, Deprecated (List.map (alts, #1)), fn ((_,args),res) =>
if Args.processDef args then res else Bad)
| Good (_, args) => if Args.processDef args then Good () else Bad
+ | Other => Bad
val processEnabled = fn (s, b) =>
case parseId s of
@@ -549,6 +568,7 @@
(alts, Deprecated alts, fn (id,res) =>
if Id.setEnabled (id, b) then res else Bad)
| Good id => if Id.setEnabled (id, b) then Good () else Bad
+ | Other => Bad
val withDef : (unit -> 'a) -> 'a = fn f =>
let
Modified: mlton/trunk/mlton/elaborate/elaborate-mlbs.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-mlbs.fun 2006-02-05 15:30:17 UTC (rev 4348)
+++ mlton/trunk/mlton/elaborate/elaborate-mlbs.fun 2006-02-10 00:38:30 UTC (rev 4349)
@@ -261,6 +261,7 @@
else elabBasdec basdec,
restore)
end
+ | Other => elabBasdec basdec
end) basdec
val _ = withDef (fn () => elabBasdec mlb)
in
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2006-02-05 15:30:17 UTC (rev 4348)
+++ mlton/trunk/mlton/main/main.fun 2006-02-10 00:38:30 UTC (rev 4349)
@@ -125,6 +125,8 @@
concat ["Warning: ", "deprecated annotation: ", s, ". Use ",
List.toString Control.Elaborate.Id.name ids, ".\n"])
| Control.Elaborate.Good () => ()
+ | Control.Elaborate.Other =>
+ usage (concat ["invalid -", flag, " flag: ", s])
open Control Popt
fun push r = SpaceString (fn s => List.push (r, s))
datatype z = datatype MLton.Platform.Arch.t
|
|
From: Matthew F. <fl...@ml...> - 2006-02-05 07:30:23
|
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)
+...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-05 06:22:39
|
Branching basis-library for refactoring
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/unix-sock.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/error.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/io.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/proc-env.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/process.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/signal.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/sys-db.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/tty.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/basis-ffi.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
D mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/time.sml
----------------------------------------------------------------------
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor (from rev 4344, mlton/branches/on-20050822-x86_64-branch/basis-library)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,82 +0,0 @@
-(* 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.
- *)
-
-structure C = struct
-
-
-(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
-
-structure String = Pointer
-structure StringArray = Pointer
-
-(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
-
-(* C99 *)
-structure Intmax = struct open Int64 type t = int end
-structure UIntmax = struct open Word64 type t = word end
-
-(* from <dirent.h> *)
-structure DirP = struct open Word32 type t = word end
-
-(* from <poll.h> *)
-structure NFds = struct open Word32 type t = word end
-
-(* from <resource.h> *)
-structure RLim = struct open Word64 type t = word end
-
-(* from <sys/types.h> *)
-structure Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
-
-(* from <sys/socket.h> *)
-structure Socklen = struct open Word32 type t = word end
-
-(* from <termios.h> *)
-structure CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
-
-(* from "gmp.h" *)
-structure MPLimb = struct open Word32 type t = word end
-
-
-structure Errno = struct type 'a t = 'a end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/amd64-linux/c-types.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,78 +0,0 @@
-(* 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.
- *)
-
-structure C = struct
-
-
-(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
-
-structure String = Pointer
-structure StringArray = Pointer
-
-(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
-
-(* from <dirent.h> *)
-structure DirP = struct open Word32 type t = word end
-
-(* from <poll.h> *)
-structure NFds = struct open Word32 type t = word end
-
-(* from <resource.h> *)
-structure RLim = struct open Word64 type t = word end
-
-(* from <sys/types.h> *)
-structure Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
-
-(* from <sys/socket.h> *)
-structure Socklen = struct open Word32 type t = word end
-
-(* from <termios.h> *)
-structure CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
-
-(* from "gmp.h" *)
-structure MPLimb = struct open Word32 type t = word end
-
-
-structure Errno = struct type 'a t = 'a end
-end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/x86-linux/c-types.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/choose.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,1032 +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.
- *)
-
-(*
- * 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
- structure Word = Word32
-
- datatype rep =
- Big of Word.word Vector.vector
- | Small of Int.int
-
- structure Prim = Primitive.IntInf
- type bigInt = Prim.int
- local
- open Int
- in
- val op < = op <
- val op <= = op <=
- val op > = op >
- val op >= = op >=
- val op + = op +
- val op - = op -
- end
- type smallInt = int
-
- (* bigIntConstant is just to make it easy to spot where the bigInt
- * constants are in this module.
- *)
- fun bigIntConstant x = x
- val zero = bigIntConstant 0
- val one = bigIntConstant 1
- val negOne = bigIntConstant ~1
-
- (* Check if an IntInf.int is small (i.e., a fixnum). *)
- fun isSmall (i: bigInt): bool =
- 0w0 <> Word.andb (Prim.toWord i, 0w1)
-
- (* Check if two IntInf.int's are both small (i.e., fixnums).
- * This is a gross hack, but uses only one test.
- *)
- fun areSmall (i: bigInt, i': bigInt) =
- 0w0 <> Word.andb (Prim.toWord i, Word.andb (Prim.toWord i', 0w1))
-
- (*
- * Return the number of `limbs' in a bigInt.
- * If arg is big, then |arg| is in [ 2^ (32 (x-1)), 2^ (32 x) )
- * where x is size arg. If arg is small, then it is in
- * [ - 2^30, 2^30 ).
- *)
- fun bigSize (arg: bigInt): smallInt =
- Vector.length (Prim.toVector arg) -? 1
- fun size (arg: bigInt): smallInt =
- if isSmall arg
- then 1
- else bigSize arg
-
- val bytesPerWord = 0w4
- (*
- * Reserve heap space for a bignum bigInt with room for size + 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 with the 0w4
- * below.
- *)
- fun reserve (size: smallInt, extra: smallInt): word =
- Word.* (bytesPerWord,
- Word.+ (Word.fromInt size,
- Word.+ (0w4, (* counter, size, header, sign words *)
- Word.fromInt extra)))
-
- (*
- * Given a fixnum bigInt, return the Word.word which it
- * represents.
- * NOTE: it is an ERROR to call stripTag on an argument
- * which is a bignum bigInt.
- *)
- fun stripTag (arg: bigInt): Word.word =
- Word.~>> (Prim.toWord arg, 0w1)
-
- (*
- * Given a Word.word, add the tag bit in so that it looks like
- * a fixnum bigInt.
- *)
- fun addTag (argw: Word.word): Word.word =
- Word.orb (Word.<< (argw, 0w1), 0w1)
-
- (*
- * Given a fixnum bigInt, change the tag bit to 0.
- * NOTE: it is an ERROR to call zeroTag on an argument
- * which is a bignum bigInt.
- *)
- fun zeroTag (arg: bigInt): Word.word =
- Word.andb (Prim.toWord arg, 0wxFFFFFFFE)
-
- (*
- * Given a Word.word, set the tag bit back to 1.
- *)
- fun incTag (argw: Word.word): Word.word =
- Word.orb (argw, 0w1)
-
- (*
- * badw is the fixnum bigInt (as a word) whose negation and
- * absolute value are not fixnums. badv is the same thing
- * with the tag stripped off.
- * negBad is the negation (and absolute value) of that bigInt.
- *)
- val badw: Word.word = 0wx80000001 (* = Prim.toWord ~0x40000000 *)
- val badv: Word.word = 0wxC0000000 (* = stripTag ~0x40000000 *)
- val negBad: bigInt = bigIntConstant 0x40000000
-
- (*
- * Given two Word.word's, check if they have the same `sign' bit.
- *)
- fun sameSign (lhs: Word.word, rhs: Word.word): bool =
- Word.toIntX (Word.xorb (lhs, rhs)) >= 0
-
- (*
- * Given a bignum bigint, test if it is (strictly) negative.
- * Note: it is an ERROR to call bigIsNeg on an argument
- * which is a fixnum bigInt.
- *)
- fun bigIsNeg (arg: bigInt): bool =
- Primitive.Vector.sub (Prim.toVector arg, 0) <> 0w0
-
- (*
- * Convert a smallInt to a bigInt.
- *)
- fun bigFromInt (arg: smallInt): bigInt =
- let
- val argv = Word.fromInt arg
- val ans = addTag argv
- in
- if sameSign (argv, ans)
- then Prim.fromWord ans
- else let val space = Primitive.Array.array 2
- val (isneg, abs) = if arg < 0
- then (0w1, Word.- (0w0, argv))
- else (0w0, argv)
- val _ = Primitive.Array.update (space, 0, isneg)
- val _ = Primitive.Array.update (space, 1, abs)
- val space = Primitive.Vector.fromArray space
- in
- Prim.fromVector space
- end
- end
-
- fun rep x =
- if isSmall x
- then Small (Word.toIntX (stripTag x))
- else Big (Prim.toVector x)
-
- (*
- * Convert a bigInt to a smallInt, raising overflow if it
- * is too big.
- *)
- fun bigToInt (arg: bigInt): smallInt =
- if isSmall arg
- then Word.toIntX (stripTag arg)
- else if bigSize arg <> 1
- then raise Overflow
- else let val arga = Prim.toVector arg
- val argw = Primitive.Vector.sub (arga, 1)
- in if Primitive.Vector.sub (arga, 0) <> 0w0
- then if Word.<= (argw, 0wx80000000)
- then Word.toIntX (Word.- (0w0, argw))
- else raise Overflow
- else if Word.< (argw, 0wx80000000)
- then Word.toIntX argw
- else raise Overflow
- end
-
- fun bigFromInt64 (i: Int64.int): bigInt =
- if Int64.<= (~0x40000000, i) andalso Int64.<= (i, 0x3FFFFFFF)
- then Prim.fromWord (addTag (Word.fromInt (Int64.toInt i)))
- else
- let
- fun doit (i: Int64.int, isNeg): bigInt =
- if Int64.<= (i, 0xFFFFFFFF)
- then
- let
- val a = Primitive.Array.array 2
- val _ = Array.update (a, 0, isNeg)
- val _ = Array.update (a, 1, Int64.toWord i)
- in
- Prim.fromVector (Vector.fromArray a)
- end
- else
- let
- val a = Primitive.Array.array 3
- val _ = Array.update (a, 0, isNeg)
- val r = Int64.rem (i, 0x100000000)
- val _ = Array.update (a, 1, Int64.toWord r)
- val q = Int64.quot (i, 0x100000000)
- val _ = Array.update (a, 2, Int64.toWord q)
- in
- Prim.fromVector (Vector.fromArray a)
- end
- in
- if Int64.>= (i, 0)
- then doit (i, 0w0)
- else
- if i = valOf Int64.minInt
- then ~0x8000000000000000
- else doit (Int64.~? i, 0w1)
- end
-
- fun bigToInt64 (arg: bigInt): Int64.int =
- case rep arg of
- Small i => Int64.fromInt i
- | Big v =>
- if Vector.length v > 3
- then raise Overflow
- else let
- val sign = Primitive.Vector.sub (v, 0)
- val w1 = Primitive.Vector.sub (v, 1)
- val w2 = Primitive.Vector.sub (v, 2)
- in
- if Word.> (w2, 0wx80000000)
- then raise Overflow
- else if w2 = 0wx80000000
- then if w1 = 0w0 andalso sign = 0w1
- then valOf Int64.minInt
- else raise Overflow
- else
- let
- val n =
- Int64.+?
- (Primitive.Int64.fromWord w1,
- Int64.*? (Primitive.Int64.fromWord w2,
- 0x100000000))
- in
- if sign = 0w1
- then Int64.~ n
- else n
- end
- end
-
- (*
- * bigInt negation.
- *)
- fun bigNegate (arg: bigInt): bigInt =
- if isSmall arg
- then let val argw = Prim.toWord arg
- in if argw = badw
- then negBad
- else Prim.fromWord (Word.- (0w2, argw))
- end
- else Prim.~ (arg, reserve (bigSize arg, 1))
-
- val dontInline: (unit -> 'a) -> 'a =
- fn f =>
- let
- val rec recur: int -> 'a =
- fn i =>
- if i = 0
- then f ()
- else (ignore (recur (i - 1))
- ; recur (i - 2))
- in
- recur 0
- end
-
- (*
- * bigInt multiplication.
- *)
- local
- val carry: Word.word ref = ref 0w0
- in
- fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then let
- val lhsv = stripTag lhs
- val rhs0 = zeroTag rhs
- val ans0 = Prim.smallMul (lhsv, rhs0, carry)
- in
- if (! carry) = Word.~>> (ans0, 0w31)
- then SOME (Prim.fromWord (incTag ans0))
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
- | SOME i => i
- end
- end
-
- (*
- * bigInt quot.
- * Round towards 0 (bigRem returns the remainder).
- * Note, if size num < size den, then the answer is 0.
- * The only non-trivial case here is num being - den,
- * and small, but in that case, although den may be big, its
- * size is still 1. (den cannot be 0 in this case.)
- * The space required for the shifted numerator limbs is <= nsize + 1.
- * The space required for the shifted denominator limbs is <= dsize
- * The space required for the quotient limbs is <= 1 + nsize - dsize.
- * Thus the total space for limbs is <= 2*nsize + 2 (and one extra
- * word for the isNeg flag).
- *)
- fun bigQuot (num: bigInt, den: bigInt): bigInt =
- if areSmall (num, den)
- then let val numv = stripTag num
- val denv = stripTag den
- in if numv = badv andalso denv = Word.fromInt ~1
- then negBad
- else let val numi = Word.toIntX numv
- val deni = Word.toIntX denv
- val ansi = Int.quot (numi, deni)
- val answ = Word.fromInt ansi
- in Prim.fromWord (addTag answ)
- end
- end
- else let val nsize = size num
- val dsize = size den
- in if nsize < dsize
- then zero
- else if den = zero
- then raise Div
- else
- Prim.quot
- (num, den,
- Word.* (Word.* (0w2, bytesPerWord),
- Word.+ (Word.fromInt nsize, 0w3)))
- end
-
- (*
- * bigInt rem.
- * Sign taken from numerator, quotient is returned by bigQuot.
- * Note, if size num < size den, then the answer is 0.
- * The only non-trivial case here is num being - den,
- * and small, but in that case, although den may be big, its
- * size is still 1. (den cannot be 0 in this case.)
- * The space required for the shifted numerator limbs is <= nsize + 1.
- * The space required for the shifted denominator limbs is <= dsize
- * The space required for the quotient limbs is <= 1 + nsize - dsize.
- * Thus the total space for limbs is <= 2*nsize + 2 (and one extra
- * word for the isNeg flag).
- *)
- fun bigRem (num: bigInt, den: bigInt): bigInt =
- if areSmall (num, den)
- then let val numv = stripTag num
- val numi = Word.toIntX numv
- val denv = stripTag den
- val deni = Word.toIntX denv
- val ansi = Int.rem (numi, deni)
- val answ = Word.fromInt ansi
- in Prim.fromWord (addTag answ)
- end
- else let val nsize = size num
- val dsize = size den
- in if nsize < dsize
- then num
- else if den = zero
- then raise Div
- else
- Prim.rem
- (num, den, Word.* (Word.* (0w2, bytesPerWord),
- Word.+ (Word.fromInt nsize, 0w3)))
- end
-
- (*
- * bigInt addition.
- *)
- fun bigPlus (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then let val ansv = Word.+ (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in if sameSign (ans, ansv)
- then SOME (Prim.fromWord ans)
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.+ (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
- | SOME i => i
- end
-
- (*
- * bigInt subtraction.
- *)
- fun bigMinus (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then
- let
- val ansv = Word.- (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in
- if sameSign (ans, ansv)
- then SOME (Prim.fromWord ans)
- else NONE
- end
- else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.- (lhs, rhs, reserve (Int.max (size lhs, size rhs), 1)))
- | SOME i => i
- end
-
- (*
- * bigInt compare.
- *)
- fun bigCompare (lhs: bigInt, rhs: bigInt): order =
- if areSmall (lhs, rhs)
- then Int.compare (Word.toIntX (Prim.toWord lhs),
- Word.toIntX (Prim.toWord rhs))
- else Int.compare (Prim.compare (lhs, rhs), 0)
-
-
- (*
- * bigInt comparisions.
- *)
- local
- fun makeTest (smallTest: smallInt * smallInt -> bool)
- (lhs: bigInt, rhs: bigInt): bool =
- if areSmall (lhs, rhs)
- then smallTest (Word.toIntX (Prim.toWord lhs),
- Word.toIntX (Prim.toWord rhs))
- else smallTest (Prim.compare (lhs, rhs), 0)
- in
- val bigGT = makeTest (op >)
- val bigGE = makeTest (op >=)
- val bigLE = makeTest (op <=)
- val bigLT = makeTest (op <)
- end
-
- (*
- * bigInt abs.
- *)
- fun bigAbs (arg: bigInt): bigInt =
- if isSmall arg
- then let val argw = Prim.toWord arg
- in if argw = badw
- then negBad
- else if Word.toIntX argw < 0
- then Prim.fromWord (Word.- (0w2, argw))
- else arg
- end
- else if bigIsNeg arg
- then Prim.~ (arg, reserve (bigSize arg, 1))
- else arg
-
- (*
- * bigInt min.
- *)
- fun bigMin (lhs: bigInt, rhs: bigInt): bigInt =
- if bigLE (lhs, rhs)
- then lhs
- else rhs
-
- (*
- * bigInt max.
- *)
- fun bigMax (lhs: bigInt, rhs: bigInt): bigInt =
- if bigLE (lhs, rhs)
- then rhs
- else lhs
-
- (*
- * bigInt sign.
- *)
- fun bigSign (arg: bigInt): smallInt =
- if isSmall arg
- then Int.sign (Word.toIntX (stripTag arg))
- else if bigIsNeg arg
- then ~1
- else 1
-
- (*
- * bigInt sameSign.
- *)
- fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
- bigSign lhs = bigSign rhs
-
- (*
- * bigInt gcd.
- * based on code from PolySpace.
- *)
- local
- open Int
-
- fun mod2 x = Word.toIntX (Word.andb (Word.fromInt x, 0w1))
- fun div2 x = Word.toIntX (Word.>> (Word.fromInt 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
- Prim.fromWord
- (addTag
- (Word.fromInt
- (gcdInt (Int.abs (Word.toIntX (stripTag lhs)),
- Int.abs (Word.toIntX (stripTag rhs)),
- 1))))
- else Prim.gcd (lhs, rhs, reserve (max (size lhs, size rhs), 0))
- end
-
- (*
- * 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
-
- val op + = bigPlus
- val op - = bigMinus
- val op > = bigGT
- val op >= = bigGE
- val op < = bigLT
- val quot = bigQuot
- val rem = bigRem
-
- fun x div 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 x mod 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 divMod (x, y) = (x div y, x mod y)
- fun quotRem (x, y) = (quot (x, y), rem (x, y))
-
- (*
- * 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
-
- (*
- * bigInt bit operations.
- *)
- local
- fun make (wordOp, bigIntOp): bigInt * bigInt -> bigInt =
- fn (lhs: bigInt, rhs: bigInt) =>
- if areSmall (lhs, rhs)
- then
- let
- val ansv = wordOp (stripTag lhs, stripTag rhs)
- val ans = addTag ansv
- in
- Prim.fromWord ans
- end
- else
- dontInline
- (fn () =>
- bigIntOp (lhs, rhs, reserve (Int.max (size lhs, size rhs), 0)))
- in
- val bigAndb = make (Word.andb, Prim.andb)
- val bigOrb = make (Word.orb, Prim.orb)
- val bigXorb = make (Word.xorb, Prim.xorb)
- end
-
- fun bigNotb (arg: bigInt): bigInt =
- if isSmall arg
- then Prim.fromWord (addTag (Word.notb (stripTag arg)))
- else dontInline (fn () => Prim.notb (arg, reserve (size arg, 0)))
-
- local
- val bitsPerLimb : Word.word = 0w32
- fun shiftSize shift = Word.toIntX (Word.div (shift, bitsPerLimb))
- in
- fun bigArshift (arg: bigInt, shift: word): bigInt =
- if shift = 0wx0
- then arg
- else Prim.~>> (arg, shift,
- reserve (Int.max (1, size arg -? shiftSize shift),
- 0))
-
- fun bigLshift (arg: bigInt, shift: word): bigInt =
- if shift = 0wx0
- then arg
- else Prim.<< (arg, shift, reserve (size arg +? shiftSize shift, 1))
- end
-
- type int = bigInt
- val abs = bigAbs
- val compare = bigCompare
- val divMod = divMod
- val fmt = bigFmt
- val fromInt = bigFromInt
- val fromInt64 = bigFromInt64
- val fromLarge = fn x => x
- val fromString = bigFromString
- val gcd = bigGcd
- val max = bigMax
- val maxInt = NONE
- val min = bigMin
- val minInt = NONE
- val op * = bigMul
- val op + = bigPlus
- val op - = bigMinus
- val op < = bigLT
- val op <= = bigLE
- val op > = bigGT
- val op >= = bigGE
- val op div = op div
- val op mod = op mod
- val pow = pow
- val precision = NONE
- val quot = bigQuot
- val quotRem = quotRem
- val rem = bigRem
- val rep = rep
- val sameSign = bigSameSign
- val scan = bigScan
- val sign = bigSign
- val toInt = bigToInt
- val toInt64 = bigToInt64
- val toLarge = fn x => x
- val toString = bigToString
- val ~ = bigNegate
- val andb = bigAndb
- val notb = bigNotb
- val orb = bigOrb
- val xorb = bigXorb
- val ~>> = bigArshift
- val << = bigLshift
- end
-
-structure LargeInt = IntInf
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,41 +0,0 @@
-(* 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.
- *)
-
-structure Exit =
- struct
- structure Status =
- struct
- type t = C.Status.t
- val fromInt =C.Status.fromInt
- val toInt = C.Status.toInt
- val failure = fromInt 1
- val success = fromInt 0
- end
-
- val exiting = ref false
-
- fun atExit f =
- if !exiting
- then ()
- else Cleaner.addNew (Cleaner.atExit, f)
-
- fun exit (status: Status.t): 'a =
- if !exiting
- then raise Fail "exit"
- else
- let
- val _ = exiting := true
- val i = Status.toInt status
- in
- if 0 <= i andalso i < 256
- then (let open Cleaner in clean atExit end
- ; Primitive.halt status
- ; raise Fail "exit")
- else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
- Int.toString i])
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/exit.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,30 +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 MLtonProcEnv: MLTON_PROC_ENV =
- struct
- type gid = C.GId.t
-
- fun setenv {name, value} =
- let
- val name = NullString.nullTerm name
- val value = NullString.nullTerm value
- in
- PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setenv (name, value))
- end
-
- fun setgroups gs =
- let
- val v = Vector.fromList gs
- val n = Vector.length v
- in
- PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (n, v))
- end
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,44 +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 MLtonRlimit: MLTON_RLIMIT =
- struct
- open PrimitiveFFI.MLton.Rlimit
- type rlim = C.RLim.t
- type t = C.Int.t
-
- val get =
- fn (r: t) =>
- PosixError.SysCall.syscall
- (fn () =>
- (get r, fn () =>
- {hard = getHard (),
- soft = getSoft ()}))
-
- val set =
- fn (r: t, {hard, soft}) =>
- PosixError.SysCall.simple
- (fn () => set (r, hard, soft))
-
- val infinity = INFINITY
-
- val coreFileSize = CORE
- val cpuTime = CPU
- val dataSize = DATA
- val fileSize = FSIZE
- val numFiles = NOFILE
- val stackSize = STACK
- val virtualMemorySize = AS
-
-(* NOT STANDARD
- val lockedInMemorySize = MEMLOCK
- val numProcesses = NPROC
- val residentSetSize = RSS
-*)
-
- end
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml (from rev 4345, mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml)
Deleted: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/signal.sml 2006-02-05 14:22:33 UTC (rev 4347)
@@ -1,227 +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 MLtonSignal: MLTON_SIGNAL_EXTRA =
-struct
-
-open Posix.Signal
-structure Prim = PrimitiveFFI.Posix.Signal
-structure Error = PosixError
-structure SysCall = Error.SysCall
-val restart = SysCall.restartFlag
-
-type t = signal
-
-type how = C.Int.t
-
-(* val toString = SysWord.toString o toWord *)
-
-fun raiseInval () =
- let
- open PosixError
- in
- raiseSys inval
- end
-
-val validSignals =
- Array.tabulate
- (Prim.NSIG, fn i =>
- Prim.sigismember(fromInt i) <> ~1)
-
-structure Mask =
- struct
- datatype t =
- AllBut of signal list
- | Some of signal list
-
- val allBut = AllBut
- val some = Some
-
- val all = allBut []
- val none = some []
-
- fun read () =
- Some
- (Array.foldri
- (fn (i, b, sigs) =>
- if b
- then if (Prim.sigismember(fromInt i)) = 1
- then (fromInt i)::sigs
- else sigs
- else sigs)
- []
- validSignals)
-
- fun write m =
- case m of
- AllBut signals =>
- (SysCall.simple Prim.sigfillset
- ; List.app (fn s => SysCall.simple (fn () => Prim.sigdelset s)) signals)
- | Some signals =>
- (SysCall.simple Prim.sigemptyset
- ; List.app (fn s => SysCall.simple (fn () => Prim.sigaddset s)) signals)
-
- local
- fun make (how: how) (m: t) =
- (write m; SysCall.simpleRestart (fn () => Prim.sigprocmask how))
- in
- val block = make Prim.SIG_BLOCK
- val unblock = make Prim.SIG_UNBLOCK
- val setBlocked = make Prim.SIG_SETMASK
- fun getBlocked () = (make Prim.SIG_BLOCK none; read ())
- end
-
- local
- fun member (sigs, s) = List.exists (fn s' => s = s') sigs
- in
- fun isMember (mask, s) =
- if Array.sub (validSignals, toInt s)
- then case mask of
- AllBut sigs => not (member (sigs, s))
- | Some sigs => member (sigs, s)
- else raiseInval ()
- end
- end
-
-structure Handler =
- struct
- datatype t =
- Default
- | Handler of MLtonThread.Runnable.t -> MLtonThread.Runnable.t
- | Ignore
- | InvalidSignal
- end
-
-datatype handler = datatype Handler.t
-
-local
- val r = ref false
-in
- fun initHandler (s: signal): Handler.t =
- if 0 = Prim.isDefault (s, r)
- then if !r
- then Default
- else Ignore
- else InvalidSignal
-end
-
-val (getHandler, setHandler, handlers) =
- let
- val handlers = Array.tabulate (Prim.NSIG, initHandler o fromInt)
- val _ =
- Cleaner.addNew
- (Cleaner.atLoadWorld, fn () =>
- Array.modifyi (initHandler o fromInt o #1) handlers)
- in
- (fn s: t => Array.sub (handlers, toInt s),
- fn (s: t, h) => if Primitive.MLton.Profile.isOn andalso s = prof
- then raiseInval ()
- else Array.update (handlers, toInt s, h),
- handlers)
- end
-
-val gcHandler = ref Ignore
-
-fun handled () =
- Mask.some
- (Array.foldri
- (fn (s, h, sigs) =>
- case h of
- Handler _ => (fromInt s)::sigs
- | _ => sigs) [] handlers)
-
-structure Handler =
- struct
- open Handler
-
- val default = Default
- val ignore = Ignore
-
- val isDefault = fn Default => true | _ => false
- val isIgnore = fn Ignore => true | _ => false
-
- val handler =
- (* This let is used so that Thread.setHandler is only used if
- * Handler.handler is used. This prevents threads from being part
- * of every program.
- *)
- let
- (* As far as C is concerned, there is only one signal handler.
- * As soon as possible after a C signal is received, this signal
- * handler walks over the array of all SML handlers, and invokes any
- * one for which a C signal has been received.
- *
- * Any exceptions raised by a signal handler will be caught by
- * the topLevelHandler, which is installed in thread.sml.
- *)
- val _ =
- PosixError.SysCall.blocker :=
- (fn () => let
- val m = Mask.getBlocked ()
- val () = Mask.block (handled ())
- ...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2006-02-04 21:18:32
|
Merge trunk revisions 4290:4345 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/benchmark/main.sml
U mlton/branches/on-20050822-x86_64-branch/lib/basis-stubs/basis-2002.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/other.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/pervasive.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/substring.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/benchmark/main.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/benchmark/main.sml 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/benchmark/main.sml 2006-02-05 05:18:28 UTC (rev 4346)
@@ -267,7 +267,7 @@
(fn e =>
let
val originalDbase = "/usr/lib/poly/ML_dbase"
- val poly = "poly"
+ val poly = "/usr/bin/poly"
in File.withTemp
(fn dbase =>
let
@@ -286,7 +286,7 @@
withInput
(input, fn () =>
timeIt (Explicit {args = [dbase],
- com = "poly"})))
+ com = poly})))
val after = File.size dbase
in
if original = after
Modified: mlton/branches/on-20050822-x86_64-branch/lib/basis-stubs/basis-2002.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/basis-stubs/basis-2002.sml 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/basis-stubs/basis-2002.sml 2006-02-05 05:18:28 UTC (rev 4346)
@@ -31,8 +31,6 @@
structure Math = Math
structure OS = OS
structure Option = Option
- structure Pack32Big = Pack32Big
- structure Pack32Little = Pack32Little
structure Position = Position
structure Posix = Posix
structure Real = Real
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm 2006-02-05 05:18:28 UTC (rev 4346)
@@ -39,8 +39,6 @@
structure MLton
structure OS
structure Option
-structure Pack32Big
-structure Pack32Little
structure Position
structure Posix
structure Real
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/other.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/other.sml 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/other.sml 2006-02-05 05:18:28 UTC (rev 4346)
@@ -15,8 +15,6 @@
structure ListPair = ListPair
structure Math = Math
structure Option = Option
-structure Pack32Big = Pack32Big
-structure Pack32Little = Pack32Little
structure SML90 = SML90
structure SMLofNJ = SMLofNJ
structure Unix = Unix
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/pervasive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/pervasive.sml 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/pervasive.sml 2006-02-05 05:18:28 UTC (rev 4346)
@@ -32,8 +32,6 @@
structure Math = Math
structure Option = Option
structure OS = OS
- structure Pack32Big = Pack32Big
- structure Pack32Little = Pack32Little
structure Position = Position
structure Posix = Posix
structure Real = Real
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2006-02-05 05:18:28 UTC (rev 4346)
@@ -41,8 +41,6 @@
structure MLton
structure OS
structure Option
-structure Pack32Big
-structure Pack32Little
structure Position
structure Posix
structure Real
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/substring.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/substring.sml 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/substring.sml 2006-02-05 05:18:28 UTC (rev 4346)
@@ -10,8 +10,6 @@
struct
open OpenInt32 Substring
- val full = all
-
fun base ss =
let val (s, i, j) = Substring.base ss
in (s, fromInt i, fromInt j)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun 2006-02-05 05:10:42 UTC (rev 4345)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun 2006-02-05 05:18:28 UTC (rev 4346)
@@ -3155,10 +3155,11 @@
fun loop cs =
case cs of
[] => Error.bug "ElaborateEnv.functorClosure: missing firstTycon"
- | c :: cs =>
- if Tycon.equals (c, firstTycon)
- then cs
- else loop cs
+ | c :: cs' =>
+ if Tycon.equals (c, firstTycon) then
+ cs
+ else
+ loop cs'
in
loop (!allTycons)
end
|
|
From: Matthew F. <fl...@ml...> - 2006-02-04 21:10:47
|
Checkpoint before branching basis refactoring.
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/Posix/TTY-consts.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -5,78 +5,124 @@
* See the file MLton-LICENSE for details.
*)
-structure C = struct
-
(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
+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 String = Pointer
-structure StringArray = Pointer
+structure C_Pointer = Pointer
+structure C_String = Pointer
+structure C_StringArray = Pointer
(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
+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 Intmax = struct open Int64 type t = int end
-structure UIntmax = struct open Word64 type t = word end
+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 DirP = struct open Word32 type t = word end
+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 NFds = struct open Word32 type t = word end
+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 RLim = struct open Word64 type t = word end
+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 Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
+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 Socklen = struct open Word32 type t = word end
+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 CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
+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 MPLimb = struct open Word32 type t = word end
+structure C_MPLimb = struct open Word32 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure Errno = struct type 'a t = 'a end
-end
+structure C_Errno = struct type 'a t = 'a end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/x86-linux/c-types.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -5,74 +5,124 @@
* See the file MLton-LICENSE for details.
*)
-structure C = struct
-
(* C *)
-structure Char = struct open Int8 type t = int end
-structure SChar = struct open Int8 type t = int end
-structure UChar = struct open Word8 type t = word end
-structure Short = struct open Int16 type t = int end
-structure SShort = struct open Int16 type t = int end
-structure UShort = struct open Word16 type t = word end
-structure Int = struct open Int32 type t = int end
-structure SInt = struct open Int32 type t = int end
-structure UInt = struct open Word32 type t = word end
-structure Long = struct open Int32 type t = int end
-structure SLong = struct open Int32 type t = int end
-structure ULong = struct open Word32 type t = word end
-structure LongLong = struct open Int64 type t = int end
-structure SLongLong = struct open Int64 type t = int end
-structure ULongLong = struct open Word64 type t = word end
-structure Float = struct open Real32 type t = real end
-structure Double = struct open Real64 type t = real end
-structure Size = struct open Word32 type t = word end
+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 String = Pointer
-structure StringArray = Pointer
+structure C_Pointer = Pointer
+structure C_String = Pointer
+structure C_StringArray = Pointer
(* Generic integers *)
-structure Fd = Int
-structure Signal = Int
-structure Status = Int
-structure Sock = Int
+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 DirP = struct open Word32 type t = word end
+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 NFds = struct open Word32 type t = word end
+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 RLim = struct open Word64 type t = word end
+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 Clock = struct open Int32 type t = int end
-structure Dev = struct open Word64 type t = word end
-structure GId = struct open Word32 type t = word end
-structure Id = struct open Word32 type t = word end
-structure INo = struct open Word64 type t = word end
-structure Mode = struct open Word32 type t = word end
-structure NLink = struct open Word32 type t = word end
-structure Off = struct open Int64 type t = int end
-structure PId = struct open Int32 type t = int end
-structure SSize = struct open Int32 type t = int end
-structure SUSeconds = struct open Int32 type t = int end
-structure Time = struct open Int32 type t = int end
-structure UId = struct open Word32 type t = word end
-structure USeconds = struct open Word32 type t = word end
+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 Socklen = struct open Word32 type t = word end
+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 CC = struct open Word8 type t = word end
-structure Speed = struct open Word32 type t = word end
-structure TCFlag = struct open Word32 type t = word end
+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 MPLimb = struct open Word32 type t = word end
+structure C_MPLimb = struct open Word32 type t = word end
+functor C_MPLimb_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
-structure Errno = struct type 'a t = 'a end
-end
+structure C_Errno = struct type 'a t = 'a end
Added: mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/choose.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -0,0 +1,64 @@
+(* 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.
+ *)
+
+signature CHOOSE_INTN_ARG =
+ sig
+ type 'a t
+ val fInt8: Int8.int t
+ val fInt16: Int16.int t
+ val fInt32: Int32.int t
+ val fInt64: Int64.int t
+ end
+
+functor ChooseIntN_Int8 (A : CHOOSE_INTN_ARG) :
+ sig val f : Int8.int A.t end =
+ struct val f = A.fInt8 end
+functor ChooseIntN_Int16 (A : CHOOSE_INTN_ARG) :
+ sig val f : Int16.int A.t end =
+ struct val f = A.fInt16 end
+functor ChooseIntN_Int32 (A : CHOOSE_INTN_ARG) :
+ sig val f : Int32.int A.t end =
+ struct val f = A.fInt32 end
+functor ChooseIntN_Int64 (A : CHOOSE_INTN_ARG) :
+ sig val f : Int64.int A.t end =
+ struct val f = A.fInt64 end
+
+signature CHOOSE_REALN_ARG =
+ sig
+ type 'a t
+ val fReal32: Real32.real t
+ val fReal64: Real64.real t
+ end
+
+functor ChooseRealN_Real32 (A : CHOOSE_REALN_ARG) :
+ sig val f : Real32.real A.t end =
+ struct val f = A.fReal32 end
+functor ChooseRealN_Real64 (A : CHOOSE_REALN_ARG) :
+ sig val f : Real64.real A.t end =
+ struct val f = A.fReal64 end
+
+signature CHOOSE_WORDN_ARG =
+ sig
+ type 'a t
+ val fWord8: Word8.word t
+ val fWord16: Word16.word t
+ val fWord32: Word32.word t
+ val fWord64: Word64.word t
+ end
+
+functor ChooseWordN_Word8 (A : CHOOSE_WORDN_ARG) :
+ sig val f : Word8.word A.t end =
+ struct val f = A.fWord8 end
+functor ChooseWordN_Word16 (A : CHOOSE_WORDN_ARG) :
+ sig val f : Word16.word A.t end =
+ struct val f = A.fWord16 end
+functor ChooseWordN_Word32 (A : CHOOSE_WORDN_ARG) :
+ sig val f : Word32.word A.t end =
+ struct val f = A.fWord32 end
+functor ChooseWordN_Word64 (A : CHOOSE_WORDN_ARG) :
+ sig val f : Word64.word A.t end =
+ struct val f = A.fWord64 end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int-inf.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -97,20 +97,6 @@
Word.orb (Word.<< (argw, 0w1), 0w1)
(*
- * Given a fixnum bigInt, change the tag bit to 0.
- * NOTE: it is an ERROR to call zeroTag on an argument
- * which is a bignum bigInt.
- *)
- fun zeroTag (arg: bigInt): Word.word =
- Word.andb (Prim.toWord arg, 0wxFFFFFFFE)
-
- (*
- * Given a Word.word, set the tag bit back to 1.
- *)
- fun incTag (argw: Word.word): Word.word =
- Word.orb (argw, 0w1)
-
- (*
* badw is the fixnum bigInt (as a word) whose negation and
* absolute value are not fixnums. badv is the same thing
* with the tag stripped off.
@@ -272,35 +258,29 @@
recur 0
end
- (*
- * bigInt multiplication.
- *)
- local
- val carry: Word.word ref = ref 0w0
- in
- fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
- let
- val res =
- if areSmall (lhs, rhs)
- then let
- val lhsv = stripTag lhs
- val rhs0 = zeroTag rhs
- val ans0 = Prim.smallMul (lhsv, rhs0, carry)
- in
- if (! carry) = Word.~>> (ans0, 0w31)
- then SOME (Prim.fromWord (incTag ans0))
+
+ fun bigMul (lhs: bigInt, rhs: bigInt): bigInt =
+ let
+ val res =
+ if areSmall (lhs, rhs)
+ then let val ansv = (Word.fromInt o Int.*)
+ (Word.toIntX (stripTag lhs),
+ Word.toIntX (stripTag rhs))
+ val ans = addTag ansv
+ in
+ if sameSign (ans, ansv)
+ then SOME (Prim.fromWord ans)
else NONE
- end
+ end handle Overflow => NONE
else NONE
- in
- case res of
- NONE =>
- dontInline
- (fn () =>
- Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
- | SOME i => i
- end
- end
+ in
+ case res of
+ NONE =>
+ dontInline
+ (fn () =>
+ Prim.* (lhs, rhs, reserve (size lhs +? size rhs, 0)))
+ | SOME i => i
+ end
(*
* bigInt quot.
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exit.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -9,9 +9,9 @@
struct
structure Status =
struct
- type t = C.Status.t
- val fromInt =C.Status.fromInt
- val toInt = C.Status.toInt
+ type t = C_Status.t
+ val fromInt = C_Status.fromInt
+ val toInt = C_Status.toInt
val failure = fromInt 1
val success = fromInt 0
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/proc-env.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -8,7 +8,7 @@
structure MLtonProcEnv: MLTON_PROC_ENV =
struct
- type gid = C.GId.t
+ type gid = C_GId.t
fun setenv {name, value} =
let
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rlimit.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -9,8 +9,8 @@
structure MLtonRlimit: MLTON_RLIMIT =
struct
open PrimitiveFFI.MLton.Rlimit
- type rlim = C.RLim.t
- type t = C.Int.t
+ type rlim = C_RLim.t
+ type t = C_Int.t
val get =
fn (r: t) =>
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/signal.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -17,7 +17,7 @@
type t = signal
-type how = C.Int.t
+type how = C_Int.t
(* val toString = SysWord.toString o toWord *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/syslog.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -16,7 +16,7 @@
open PrimitiveFFI.MLton.Syslog
-type openflag = C.Int.t
+type openflag = C_Int.t
local
open Logopt
@@ -28,7 +28,7 @@
val PID = LOG_PID
end
-type facility = C.Int.t
+type facility = C_Int.t
local
open Facility
@@ -55,7 +55,7 @@
val UUCP = LOG_UUCP
end
-type loglevel = C.Int.t
+type loglevel = C_Int.t
local
open Severity
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/net-host-db.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -35,7 +35,7 @@
finish ()
end
fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
- type addr_family = C.Int.t
+ type addr_family = C_Int.t
val intToAddrFamily = fn z => z
val addrFamilyToInt = fn z => z
@@ -96,7 +96,7 @@
else NONE
in
fun getByAddr in_addr =
- get (Prim.getByAddress (in_addr, C.Socklen.fromInt (Vector.length in_addr)))
+ get (Prim.getByAddress (in_addr, C_Socklen.fromInt (Vector.length in_addr)))
fun getByName name =
get (Prim.getByName (NullString.nullTerm name))
end
@@ -107,7 +107,7 @@
val buf = CharArray.array (n, #"\000")
val () =
Posix.Error.SysCall.simple
- (fn () => Prim.getHostName (CharArray.toPoly buf, C.Size.fromInt n))
+ (fn () => Prim.getHostName (CharArray.toPoly buf, C_Size.fromInt n))
in
case CharArray.findi (fn (_, c) => c = #"\000") buf of
NONE => CharArray.vector buf
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sig 2006-02-05 05:10:42 UTC (rev 4345)
@@ -171,7 +171,7 @@
val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) sock
type pre_sock_addr
val unpackSockAddr: 'af sock_addr -> Word8Vector.vector
- val new_sock_addr: unit -> (pre_sock_addr * C.Socklen.t ref * (unit -> 'af sock_addr))
+ val new_sock_addr: unit -> (pre_sock_addr * C_Socklen.t ref * (unit -> 'af sock_addr))
structure CtlExtra:
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/socket.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -6,7 +6,7 @@
*)
structure Socket:> SOCKET_EXTRA
- where type SOCK.sock_type = C.Int.t
+ where type SOCK.sock_type = C_Int.t
where type pre_sock_addr = Word8.word array
=
struct
@@ -16,23 +16,23 @@
structure Syscall = Error.SysCall
structure FileSys = Posix.FileSys
-type sock = C.Sock.t
-val sockToWord = SysWord.fromInt o C.Sock.toInt
-val wordToSock = C.Sock.fromInt o SysWord.toInt
+type sock = C_Sock.t
+val sockToWord = SysWord.fromInt o C_Sock.toInt
+val wordToSock = C_Sock.fromInt o SysWord.toInt
fun sockToFD sock = FileSys.wordToFD (sockToWord sock)
fun fdToSock fd = wordToSock (FileSys.fdToWord fd)
type pre_sock_addr = Word8.word array
datatype sock_addr = SA of Word8.word vector
fun unpackSockAddr (SA sa) = Word8Vector.fromPoly sa
-fun new_sock_addr (): (pre_sock_addr * C.Socklen.t ref * (unit -> sock_addr)) =
+fun new_sock_addr (): (pre_sock_addr * C_Socklen.t ref * (unit -> sock_addr)) =
let
- val salen = C.Size.toInt Prim.sockAddrStorageLen
+ val salen = C_Size.toInt Prim.sockAddrStorageLen
val sa = Array.array (salen, 0wx0)
- val salenRef = ref (C.Socklen.fromInt salen)
+ val salenRef = ref (C_Socklen.fromInt salen)
fun finish () =
SA (ArraySlice.vector (ArraySlice.slice
- (sa, 0, SOME (C.Socklen.toInt (!salenRef)))))
+ (sa, 0, SOME (C_Socklen.toInt (!salenRef)))))
in
(sa, salenRef, finish)
end
@@ -64,7 +64,7 @@
structure SOCK =
struct
- type sock_type = C.Int.t
+ type sock_type = C_Int.t
val stream = Prim.SOCK.STREAM
val dgram = Prim.SOCK.DGRAM
val names = [
@@ -84,9 +84,9 @@
structure CtlExtra =
struct
- type level = C.Int.t
- type optname = C.Int.t
- type request = C.Int.t
+ type level = C_Int.t
+ type optname = C_Int.t
+ type request = C_Int.t
(* host byte order *)
structure PW = PackWord32Host
@@ -142,14 +142,14 @@
fun getSockOpt (level: level, optname: optname) s =
let
val optval = Word8Array.array (optlen, 0wx0)
- val optlen = ref (C.Socklen.fromInt optlen)
+ val optlen = ref (C_Socklen.fromInt optlen)
in
Syscall.simple
(fn () =>
Prim.Ctl.getSockOpt (s, level, optname,
Word8Array.toPoly optval,
optlen))
- ; unmarshal (optval, C.Socklen.toInt (!optlen), 0)
+ ; unmarshal (optval, C_Socklen.toInt (!optlen), 0)
end
fun setSockOpt (level: level, optname: optname) (s, optval) =
let
@@ -160,7 +160,7 @@
(fn () =>
Prim.Ctl.setSockOpt (s, level, optname,
Word8Vector.toPoly optval,
- C.Socklen.fromInt optlen))
+ C_Socklen.fromInt optlen))
end
fun getIOCtl (request: request) s : 'a =
let
@@ -221,7 +221,7 @@
else SOME (Posix.Error.errorMsg se, SOME se)
end handle Error.SysErr z => SOME z
local
- fun getName (s, f: sock * pre_sock_addr * C.Socklen.t ref -> int) =
+ fun getName (s, f: sock * pre_sock_addr * C_Socklen.t ref -> int) =
let
val (sa, salen, finish) = new_sock_addr ()
val () = Syscall.simple (fn () => f (s, sa, salen))
@@ -248,7 +248,7 @@
fun familyOfAddr (SA sa) = NetHostDB.intToAddrFamily (Prim.familyOfAddr sa)
fun bind (s, SA sa) =
- Syscall.simple (fn () => Prim.bind (s, sa, C.Socklen.fromInt (Vector.length sa)))
+ Syscall.simple (fn () => Prim.bind (s, sa, C_Socklen.fromInt (Vector.length sa)))
fun listen (s, n) =
Syscall.simple (fn () => Prim.listen (s, n))
@@ -290,12 +290,12 @@
end
fun connect (s, SA sa) =
- Syscall.simple (fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa)))
+ Syscall.simple (fn () => Prim.connect (s, sa, C_Socklen.fromInt (Vector.length sa)))
fun connectNB (s, SA sa) =
nonBlock'
({restart = false}, fn () =>
- withNonBlock (s, fn () => Prim.connect (s, sa, C.Socklen.fromInt (Vector.length sa))),
+ withNonBlock (s, fn () => Prim.connect (s, sa, C_Socklen.fromInt (Vector.length sa))),
fn _ => true,
Error.inprogress, false)
@@ -397,7 +397,7 @@
val (buf, i, sz) = base sl
in
Syscall.simpleResultRestart
- (fn () => primSend (s, buf, i, C.Size.fromInt sz,
+ (fn () => primSend (s, buf, i, C_Size.fromInt sz,
Word.toInt (mk_out_flags out_flags)))
end
fun send (sock, buf) = send' (sock, buf, no_out_flags)
@@ -407,7 +407,7 @@
in
nonBlock
(fn () =>
- primSend (s, buf, i, C.Size.fromInt sz,
+ primSend (s, buf, i, C_Size.fromInt sz,
Word.toInt (
Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
mk_out_flags out_flags))),
@@ -421,9 +421,9 @@
in
Syscall.simpleRestart
(fn () =>
- primSendTo (s, buf, i, C.Size.fromInt sz,
+ primSendTo (s, buf, i, C_Size.fromInt sz,
Word.toInt (mk_out_flags out_flags),
- sa, C.Socklen.fromInt (Vector.length sa)))
+ sa, C_Socklen.fromInt (Vector.length sa)))
end
fun sendTo (sock, sock_addr, sl) =
sendTo' (sock, sock_addr, sl, no_out_flags)
@@ -433,11 +433,11 @@
in
nonBlock
(fn () =>
- primSendTo (s, buf, i, C.Size.fromInt sz,
+ primSendTo (s, buf, i, C_Size.fromInt sz,
Word.toInt (
Word.orb (Word.fromInt Prim.MSG_DONTWAIT,
mk_out_flags out_flags)),
- sa, C.Socklen.fromInt (Vector.length sa)),
+ sa, C_Socklen.fromInt (Vector.length sa)),
fn _ => true,
false)
end
@@ -471,7 +471,7 @@
val (buf, i, sz) = Word8ArraySlice.base sl
in
Syscall.simpleResultRestart
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
Word.toInt (mk_in_flags in_flags)))
end
@@ -499,7 +499,7 @@
val (sa, salen, finish) = new_sock_addr ()
val n =
Syscall.simpleResultRestart
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
Word.toInt (mk_in_flags in_flags),
sa, salen))
in
@@ -526,7 +526,7 @@
val (buf, i, sz) = Word8ArraySlice.base sl
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ (fn () => Prim.recv (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
Word.toInt (mk_in_flagsNB in_flags)),
SOME,
NONE)
@@ -537,7 +537,7 @@
val a = Word8Array.rawArray n
in
nonBlock
- (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
+ (fn () => Prim.recv (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
Word.toInt (mk_in_flagsNB in_flags)),
fn bytesRead => SOME (getVec (a, n, bytesRead)),
NONE)
@@ -553,7 +553,7 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C.Size.fromInt sz,
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly buf, i, C_Size.fromInt sz,
Word.toInt (mk_in_flagsNB in_flags), sa, salen),
fn n => SOME (n, finish ()),
NONE)
@@ -565,7 +565,7 @@
val (sa, salen, finish) = new_sock_addr ()
in
nonBlock
- (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C.Size.fromInt n,
+ (fn () => Prim.recvFrom (s, Word8Array.toPoly a, 0, C_Size.fromInt n,
Word.toInt (mk_in_flagsNB in_flags), sa, salen),
fn bytesRead => SOME (getVec (a, n, bytesRead), finish ()),
NONE)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/net/unix-sock.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -20,7 +20,7 @@
let
val (sa, salen, finish) = Socket.new_sock_addr ()
val _ = Prim.toAddr (NullString.nullTerm s,
- C.Size.fromInt (String.size s),
+ C_Size.fromInt (String.size s),
sa, salen)
in
finish ()
@@ -31,10 +31,10 @@
val sa = Socket.unpackSockAddr sa
val sa = Word8Vector.toPoly sa
val len = Prim.pathLen sa
- val a = CharArray.array (C.Size.toInt len, #"\000")
+ val a = CharArray.array (C_Size.toInt len, #"\000")
val _ = Prim.fromAddr (sa, CharArray.toPoly a, len)
in
- CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME (C.Size.toInt len)))
+ CharArraySlice.vector (CharArraySlice.slice (a, 0, SOME (C_Size.toInt len)))
end
structure Strm =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/error.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -11,7 +11,7 @@
structure Prim = PrimitiveFFI.Posix.Error
open Prim
- type syserror = C.Int.t
+ type syserror = C_Int.t
val acces = EACCES
val addrinuse = EADDRINUSE
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/file-sys.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -30,9 +30,9 @@
structure Stat = Prim.Stat
structure Flags = BitFlags
- type file_desc = C.Fd.t
- type uid = C.UId.t
- type gid = C.GId.t
+ type file_desc = C_Fd.t
+ type uid = C_UId.t
+ type gid = C_GId.t
val fdToWord = Primitive.FileDesc.toWord
val wordToFD = Primitive.FileDesc.fromWord
@@ -45,7 +45,7 @@
local
structure Prim = Prim.Dirstream
- datatype dirstream = DS of C.DirP.t option ref
+ datatype dirstream = DS of C_DirP.t option ref
fun get (DS r) =
case !r of
@@ -151,7 +151,7 @@
fun extract a = extractToChar (a, #"\000")
in
fun getcwd () =
- if Primitive.Pointer.isNull (Prim.getcwd (!buffer, C.Size.fromInt (!size)))
+ if Primitive.Pointer.isNull (Prim.getcwd (!buffer, C_Size.fromInt (!size)))
then (size := 2 * !size
; buffer := make ()
; getcwd ())
@@ -167,7 +167,7 @@
structure S =
struct
open S Flags
- type mode = C.Mode.t
+ type mode = C_Mode.t
val ifblk = IFBLK
val ifchr = IFCHR
val ifdir = IFDIR
@@ -285,7 +285,7 @@
in
SysCall.syscall
(fn () =>
- let val len = Prim.readlink (path, buf, C.Size.fromInt size)
+ let val len = Prim.readlink (path, buf, C_Size.fromInt size)
in
(len, fn () =>
ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len)))
@@ -293,13 +293,13 @@
end
end
- type dev = C.Dev.t
- val wordToDev = C.Dev.fromLargeWord o SysWord.toLargeWord
- val devToWord = SysWord.fromLargeWord o C.Dev.toLargeWord
+ type dev = C_Dev.t
+ val wordToDev = C_Dev.fromLargeWord o SysWord.toLargeWord
+ val devToWord = SysWord.fromLargeWord o C_Dev.toLargeWord
- type ino = C.INo.t
- val wordToIno = C.INo.fromLargeWord o SysWord.toLargeWord
- val inoToWord = SysWord.fromLargeWord o C.INo.toLargeWord
+ type ino = C_INo.t
+ val wordToIno = C_INo.fromLargeWord o SysWord.toLargeWord
+ val inoToWord = SysWord.fromLargeWord o C_INo.toLargeWord
structure ST =
struct
@@ -319,7 +319,7 @@
T {dev = Stat.getDev (),
ino = Stat.getINo (),
mode = Stat.getMode (),
- nlink = C.NLink.toInt (Stat.getNLink ()),
+ nlink = C_NLink.toInt (Stat.getNLink ()),
uid = Stat.getUId (),
gid = Stat.getGId (),
size = Stat.getSize (),
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/io.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -15,11 +15,11 @@
structure SysCall = Error.SysCall
structure FS = PosixFileSys
-type file_desc = C.Fd.t
-type pid = C.PId.t
+type file_desc = C_Fd.t
+type pid = C_PId.t
-val FD = C.Fd.fromInt
-val unFD = C.Fd.toInt
+val FD = C_Fd.fromInt
+val unFD = C_Fd.toInt
local
val a: file_desc array = Array.array (2, FD 0)
@@ -228,13 +228,13 @@
let
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
in
- SysCall.simpleResultRestart (fn () => read (fd, buf, i, C.Size.fromInt sz))
+ SysCall.simpleResultRestart (fn () => read (fd, buf, i, C_Size.fromInt sz))
end
fun readVec (fd, n) =
let
val a = Primitive.Array.array n
val bytesRead =
- SysCall.simpleResultRestart (fn () => read (fd, a, 0, C.Size.fromInt n))
+ SysCall.simpleResultRestart (fn () => read (fd, a, 0, C_Size.fromInt n))
in
fromVector
(if n = bytesRead
@@ -247,7 +247,7 @@
val (buf, i, sz) = ArraySlice.base (toArraySlice sl)
in
SysCall.simpleResultRestart
- (fn () => write (fd, buf, i, C.Size.fromInt sz))
+ (fn () => write (fd, buf, i, C_Size.fromInt sz))
end
val writeVec =
fn (fd, sl) =>
@@ -255,7 +255,7 @@
val (buf, i, sz) = VectorSlice.base (toVectorSlice sl)
in
SysCall.simpleResultRestart
- (fn () => writeVec (fd, buf, i, C.Size.fromInt sz))
+ (fn () => writeVec (fd, buf, i, C_Size.fromInt sz))
end
fun mkReader {fd, name, initBlkMode} =
let
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/proc-env.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -13,10 +13,10 @@
structure SysCall = Error.SysCall
structure CS = COld.CS
- type pid = C.PId.t
- type uid = C.UId.t
- type gid = C.GId.t
- type file_desc = C.Fd.t
+ type pid = C_PId.t
+ type uid = C_UId.t
+ type gid = C_GId.t
+ type file_desc = C_Fd.t
local
open Prim
@@ -222,9 +222,9 @@
val ticksPerSec = Int.toLarge (SysWord.toIntX (sysconf "CLK_TCK"))
- fun cvt (ticks: C.Clock.t) =
+ fun cvt (ticks: C_Clock.t) =
Time.fromTicks (LargeInt.quot
- (LargeInt.* (C.Clock.toLarge ticks,
+ (LargeInt.* (C_Clock.toLarge ticks,
Time.ticksPerSecond),
ticksPerSec))
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/process.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -92,7 +92,7 @@
end
local
- val status: C.Status.t ref = ref (C.Status.fromInt 0)
+ val status: C_Status.t ref = ref (C_Status.fromInt 0)
fun wait (wa, status, flags) =
let
val useCwait =
@@ -166,9 +166,9 @@
fun wrap prim (t: Time.time): Time.time =
Time.fromSeconds
(LargeInt.fromInt
- (C.UInt.toInt
+ (C_UInt.toInt
(prim
- (C.UInt.fromInt
+ (C_UInt.fromInt
(LargeInt.toInt (Time.toSeconds t)
handle Overflow => Error.raiseSys Error.inval)))))
in
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/signal.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -10,7 +10,7 @@
struct
open PrimitiveFFI.Posix.Signal
- type signal = C.Int.t
+ type signal = C_Int.t
val abrt = SIGABRT
val alrm = SIGALRM
@@ -41,8 +41,8 @@
val xcpu = SIGXCPU
val xfsz = SIGXFSZ
- val toInt = C.Int.toInt
- val fromInt = C.Int.fromInt
+ val toInt = C_Int.toInt
+ val fromInt = C_Int.fromInt
val toWord = SysWord.fromInt o toInt
val fromWord = fromInt o SysWord.toInt
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/sys-db.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -13,8 +13,8 @@
structure Error = PosixError
structure SysCall = Error.SysCall
- type uid = C.UId.t
- type gid = C.GId.t
+ type uid = C_UId.t
+ type gid = C_GId.t
structure Passwd =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/tty.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -14,9 +14,9 @@
structure Error = PosixError
structure SysCall = Error.SysCall
- type pid = C.PId.t
+ type pid = C_PId.t
- type file_desc = C.Fd.t
+ type file_desc = C_Fd.t
structure V =
struct
@@ -34,7 +34,7 @@
val start = VSTART
val stop = VSTOP
- type cc = C.CC.t array
+ type cc = C_CC.t array
val default = Byte.charToByte #"\000"
@@ -58,9 +58,9 @@
val sub = Byte.byteToChar o Array.sub
end
- structure IFlags =
+ structure I =
struct
- open IFlags BitFlags
+ open I BitFlags
val brkint = BRKINT
val icrnl = ICRNL
val ignbrk = IGNBRK
@@ -75,9 +75,9 @@
val parmrk = PARMRK
end
- structure OFlags =
+ structure O =
struct
- open OFlags BitFlags
+ open O BitFlags
val bs0 = BS0
val bs1 = BS1
val bsdly = BSDLY
@@ -108,9 +108,9 @@
val vtdly = VTDLY
end
- structure CFlags =
+ structure C =
struct
- open CFlags BitFlags
+ open C BitFlags
val clocal = CLOCAL
val cread = CREAD
val cs5 = CS5
@@ -124,9 +124,9 @@
val parodd = PARODD
end
- structure LFlags =
+ structure L =
struct
- open LFlags BitFlags
+ open L BitFlags
val echo = ECHO
val echoe = ECHOE
val echok = ECHOK
@@ -138,7 +138,7 @@
val tostop = TOSTOP
end
- type speed = C.Speed.t
+ type speed = C_Speed.t
val b0 = B0
val b110 = B110
@@ -162,10 +162,10 @@
val speedToWord = id
val wordToSpeed = id
- type termios = {iflag: IFlags.flags,
- oflag: OFlags.flags,
- cflag: CFlags.flags,
- lflag: LFlags.flags,
+ type termios = {iflag: I.flags,
+ oflag: O.flags,
+ cflag: C.flags,
+ lflag: L.flags,
cc: V.cc,
ispeed: speed,
ospeed: speed}
@@ -173,10 +173,10 @@
val termios = id
val fieldsOf = id
- val getiflag: termios -> IFlags.flags = #iflag
- val getoflag: termios -> OFlags.flags = #oflag
- val getcflag: termios -> CFlags.flags = #cflag
- val getlflag: termios -> LFlags.flags = #oflag
+ val getiflag: termios -> I.flags = #iflag
+ val getoflag: termios -> O.flags = #oflag
+ val getcflag: termios -> C.flags = #cflag
+ val getlflag: termios -> L.flags = #oflag
val getcc: termios -> V.cc = #cc
structure CF =
@@ -211,18 +211,18 @@
struct
open Prim.TC
- type set_action = C.Int.t
+ type set_action = C_Int.t
val sadrain = TCSADRAIN
val saflush = TCSAFLUSH
val sanow = TCSANOW
- type flow_action = C.Int.t
+ type flow_action = C_Int.t
val ioff = TCIOFF
val ion = TCION
val ooff = TCOOFF
val oon = TCOON
- type queue_sel = C.Int.t
+ type queue_sel = C_Int.t
val iflush = TCIFLUSH
val oflush = TCOFLUSH
val ioflush = TCIOFLUSH
@@ -275,9 +275,4 @@
fun setpgrp (fd, pid) =
SysCall.simpleRestart (fn () => Prim.TC.setpgrp (fd, pid))
end
-
- structure C = CFlags
- structure I = IFlags
- structure L = LFlags
- structure O = OFlags
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-02-05 01:56:00 UTC (rev 4344)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/primitive/basis-ffi.sml 2006-02-05 05:10:42 UTC (rev 4345)
@@ -1,145 +1,146 @@
(* This file is automatically generated. Do not edit. *)
+local open Primitive in
structure PrimitiveFFI =
struct
structure CommandLine =
struct
-val (argcGet, argcSet) = _symbol "CommandLine_argc": (unit -> (C.Int.t)) * ((C.Int.t) -> unit);
-val (argvGet, argvSet) = _symbol "CommandLine_argv": (unit -> (C.StringArray.t)) * ((C.StringArray.t) -> unit);
-val (commandNameGet, commandNameSet) = _symbol "CommandLine_commandName": (unit -> (C.String.t)) * ((C.String.t) -> unit);
+val (argcGet, argcSet) = _symbol "CommandLine_argc": (unit -> (C_Int.t)) * ((C_Int.t) -> unit);
+val (argvGet, argvSet) = _symbol "CommandLine_argv": (unit -> (C_StringArray.t)) * ((C_StringArray.t) -> unit);
+val (commandNameGet, commandNameSet) = _symbol "CommandLine_commandName": (unit -> (C_String.t)) * ((C_String.t) -> unit);
end
structure Date =
struct
-val gmTime = _import "Date_gmTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
-val localOffset = _import "Date_localOffset" : unit -> C.Double.t;
-val localTime = _import "Date_localTime" : (C.Time.t) ref -> (C.Int.t) C.Errno.t;
-val mkTime = _import "Date_mkTime" : unit -> (C.Time.t) C.Errno.t;
-val strfTime = _import "Date_strfTime" : (Char8.t) array * C.Size.t * NullString8.t -> C.Size.t;
+val gmTime = _import "Date_gmTime" : (C_Time.t) ref -> (C_Int.t) C_Errno.t;
+val localOffset = _import "Date_localOffset" : unit -> C_Double.t;
+val localTime = _import "Date_localTime" : (C_Time.t) ref -> (C_Int.t) C_Errno.t;
+val mkTime = _import "Date_mkTime" : unit -> (C_Time.t) C_Errno.t;
+val strfTime = _import "Date_strfTime" : (Char8.t) array * C_Size.t * NullString8.t -> C_Size.t;
structure Tm =
struct
-val getHour = _import "Date_Tm_getHour" : unit -> C.Int.t;
-val getIsDst = _import "Date_Tm_getIsDst" : unit -> C.Int.t;
-val getMDay = _import "Date_Tm_getMDay" : unit -> C.Int.t;
-val getMin = _import "Date_Tm_getMin" : unit -> C.Int.t;
-val getMon = _import "Date_Tm_getMon" : unit -> C.Int.t;
-val getSec = _import "Date_Tm_getSec" : unit -> C.Int.t;
-val getWDay = _import "Date_Tm_getWDay" : unit -> C.Int.t;
-val getYDay = _import "Date_Tm_getYDay" : unit -> C.Int.t;
-val getYear = _import "Date_Tm_getYear" : unit -> C.Int.t;
-val setHour = _import "Date_Tm_setHour" : C.Int.t -> unit;
-val setIsDst = _import "Date_Tm_setIsDst" : C.Int.t -> unit;
-val setMDay = _import "Date_Tm_setMDay" : C.Int.t -> unit;
-val setMin = _import "Date_Tm_setMin" : C.Int.t -> unit;
-val setMon = _import "Date_Tm_setMon" : C.Int.t -> unit;
-val setSec = _import "Date_Tm_setSec" : C.Int.t -> unit;
-val setWDay = _import "Date_Tm_setWDay" : C.Int.t -> unit;
-val setYDay = _import "Date_Tm_setYDay" : C.Int.t -> unit;
-val setYear = _import "Date_Tm_setYear" : C.Int.t -> unit;
+val getHour = _import "Date_Tm_getHour" : unit -> C_Int.t;
+val getIsDst = _import "Date_Tm_getIsDst" : unit -> C_Int.t;
+val getMDay = _import "Date_Tm_getMDay" : unit -> C_Int.t;
+val getMin = _import "Date_Tm_getMin" : unit -> C_Int.t;
+val getMon = _import "Date_Tm_getMon" : unit -> C_Int.t;
+val getSec = _import "Date_Tm_getSec" : unit -> C_Int.t;
+val getWDay = _import "Date_Tm_getWDay" : unit -> C_Int.t;
+val getYDay = _import "Date_Tm_getYDay" : unit -> C_Int.t;
+val getYear = _import "Date_Tm_getYear" : unit -> C_Int.t;
+val setHour = _import "Date_Tm_setHour" : C_Int.t -> unit;
+val setIsDst = _import "Date_Tm_setIsDst" : C_Int.t -> unit;
+val setMDay = _import "Date_Tm_setMDay" : C_Int.t -> unit;
+val setMin = _import "Date_Tm_setMin" : C_Int.t -> unit;
+val setMon = _import "Date_Tm_setMon" : C_Int.t -> unit;
+val setSec = _import "Date_Tm_setSec" : C_Int.t -> unit;
+val setWDay = _import "Date_Tm_setWDay" : C_Int.t -> unit;
+val setYDay = _import "Date_Tm_setYDay" : C_Int.t -> unit;
+val setYear = _import "Date_Tm_setYear" : C_Int.t -> unit;
end
end
structure IEEEReal =
struct
-val getRoundingMode = _import "IEEEReal_getRoundingMode" : unit -> C.Int.t;
+val getR...
[truncated message content] |
|
From: Stephen W. <sw...@ml...> - 2006-02-04 17:56:02
|
Fixed bug:
ElaborateEnv.functorClosure: firstTycons
functorClosure was mistakenly removing one element from the allTycons
list for each functor definition.
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-env.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2006-02-05 01:54:31 UTC (rev 4343)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2006-02-05 01:56:00 UTC (rev 4344)
@@ -3155,10 +3155,11 @@
fun loop cs =
case cs of
[] => Error.bug "ElaborateEnv.functorClosure: missing firstTycon"
- | c :: cs =>
- if Tycon.equals (c, firstTycon)
- then cs
- else loop cs
+ | c :: cs' =>
+ if Tycon.equals (c, firstTycon) then
+ cs
+ else
+ loop cs'
in
loop (!allTycons)
end
|
|
From: Stephen W. <sw...@ml...> - 2006-02-04 17:54:32
|
Tweaked call to Poly/ML.
----------------------------------------------------------------------
U mlton/trunk/benchmark/main.sml
----------------------------------------------------------------------
Modified: mlton/trunk/benchmark/main.sml
===================================================================
--- mlton/trunk/benchmark/main.sml 2006-02-03 17:32:06 UTC (rev 4342)
+++ mlton/trunk/benchmark/main.sml 2006-02-05 01:54:31 UTC (rev 4343)
@@ -267,7 +267,7 @@
(fn e =>
let
val originalDbase = "/usr/lib/poly/ML_dbase"
- val poly = "poly"
+ val poly = "/usr/bin/poly"
in File.withTemp
(fn dbase =>
let
@@ -286,7 +286,7 @@
withInput
(input, fn () =>
timeIt (Explicit {args = [dbase],
- com = "poly"})))
+ com = poly})))
val after = File.size dbase
in
if original = after
|
|
From: Matthew F. <fl...@ml...> - 2006-02-03 09:32:07
|
More generated C-types and _imports
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-02-03 00:58:35 UTC (rev 4341)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-02-03 17:32:06 UTC (rev 4342)
@@ -31,6 +31,7 @@
IEEEReal.RoundingMode.FE_UPWARD = _const : C.Int.t
IEEEReal.getRoundingMode = _import : unit -> C.Int.t
IEEEReal.setRoundingMode = _import : C.Int.t -> unit
+MLton.bug = _import : NullString8.t -> unit
MLton.Itimer.PROF = _const : C.Int.t
MLton.Itimer.REAL = _const : C.Int.t
MLton.Itimer.VIRTUAL = _const : C.Int.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-02-03 00:58:35 UTC (rev 4341)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-02-03 17:32:06 UTC (rev 4342)
@@ -345,6 +345,7 @@
fun println s = (print s; print "\n")
val () = println "(* This file is automatically generated. Do not edit. *)\n"
+ val () = println "local open Primitive in "
val () = println "structure PrimitiveFFI ="
val () = println "struct"
val cur =
@@ -377,6 +378,7 @@
entries
val () = List.app (fn _ => println "end") cur
val () = println "end"
+ val () = println "end"
val () = TextIO.closeOut f
in
()
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-02-03 00:58:35 UTC (rev 4341)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-02-03 17:32:06 UTC (rev 4342)
@@ -293,6 +293,7 @@
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
writeStringWithNewline (cTypesHFd, "/* C99 */");
writeStringWithNewline (cTypesSMLFd, "(* C99 *)");
+ chksystype(ptrdiff_t, "Ptrdiff");
chksystype(intmax_t, "Intmax");
chksystype(uintmax_t, "UIntmax");
|
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:58:38
|
Add UIntmax to generated C types; we'll use this for SysWord ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml =================================================================== --- mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-03 00:58:00 UTC (rev 4340) +++ mlton/branches/on-20050822-x86_64-branch/basis-library/config/c/amd64-linux/c-types.sml 2006-02-03 00:58:35 UTC (rev 4341) @@ -37,6 +37,10 @@ structure Status = Int structure Sock = Int +(* C99 *) +structure Intmax = struct open Int64 type t = int end +structure UIntmax = struct open Word64 type t = word end + (* from <dirent.h> *) structure DirP = struct open Word32 type t = word end |
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:58:03
|
Add UIntmax to generated C types; we'll use this for SysWord
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-02-03 00:54:06 UTC (rev 4339)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-types.c 2006-02-03 00:58:00 UTC (rev 4340)
@@ -291,6 +291,12 @@
aliastype("Int", "Sock");
writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
+ writeStringWithNewline (cTypesHFd, "/* C99 */");
+ writeStringWithNewline (cTypesSMLFd, "(* C99 *)");
+ chksystype(intmax_t, "Intmax");
+ chksystype(uintmax_t, "UIntmax");
+
+ writeNewline (cTypesHFd);writeNewline (cTypesSMLFd);
writeStringWithNewline (cTypesHFd, "/* from <dirent.h> */");
writeStringWithNewline (cTypesSMLFd, "(* from <dirent.h> *)");
// ptrtype(DIR*, "DirP");
|
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:54:08
|
Sample change for C-type differences
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2006-02-03 00:39:26 UTC (rev 4338)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2006-02-03 00:54:06 UTC (rev 4339)
@@ -71,8 +71,8 @@
(if ~1 = Prim.getTimeOfDay ()
then raise Fail "Time.now"
else ()
- ; timeAdd(fromSeconds (LargeInt.fromInt (Prim.sec ())),
- fromMicroseconds (LargeInt.fromInt (Prim.usec ()))))
+ ; timeAdd(fromSeconds (C.Time.toLarge (Prim.sec ())),
+ fromMicroseconds (C.SUSeconds.toLarge (Prim.usec ()))))
val prev = ref (getNow ())
in
fun now (): time =
|
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:39:32
|
Added ignores ---------------------------------------------------------------------- _U mlton/branches/on-20050822-x86_64-branch/runtime/ U mlton/branches/on-20050822-x86_64-branch/runtime/.ignore ---------------------------------------------------------------------- Property changes on: mlton/branches/on-20050822-x86_64-branch/runtime ___________________________________________________________________ Name: svn:ignore - *.a gdtoa runtime.c + *.a gdtoa runtime.c basis-ffi.h c-types.h ml-types.h Modified: mlton/branches/on-20050822-x86_64-branch/runtime/.ignore =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/.ignore 2006-02-03 00:36:01 UTC (rev 4337) +++ mlton/branches/on-20050822-x86_64-branch/runtime/.ignore 2006-02-03 00:39:26 UTC (rev 4338) @@ -1,3 +1,6 @@ *.a gdtoa runtime.c +basis-ffi.h +c-types.h +ml-types.h |
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:36:03
|
Revert to -m32 ---------------------------------------------------------------------- U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile ---------------------------------------------------------------------- Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile =================================================================== --- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-02-03 00:35:40 UTC (rev 4336) +++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-02-03 00:36:01 UTC (rev 4337) @@ -26,7 +26,7 @@ endif ifeq ($(TARGET_ARCH), amd64) -FLAGS += -m64 -mtune=opteron +FLAGS += -m32 -mtune=opteron endif ifeq ($(TARGET_ARCH), sparc) |
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:35:44
|
Rename int-inf-ops.c to int-inf.c; needed to commit before doing rename
----------------------------------------------------------------------
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
----------------------------------------------------------------------
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:35:24 UTC (rev 4335)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:35:40 UTC (rev 4336)
@@ -1,370 +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.
- */
-
-/* Import the global gcState so we can get and set the frontier. */
-extern struct GC_state gcState;
-
-/*
- * Test if a intInf is a fixnum.
- */
-static inline bool isSmall (objptr arg) {
- return (arg & 1);
-}
-
-static inline bool isEitherSmall (objptr arg1, objptr arg2) {
- return ((arg1 | arg2) & (objptr)1);
-}
-
-static inline bool areSmall (objptr arg1, objptr arg2) {
- return (arg1 & arg2 & (objptr)1);
-}
-
-/*
- * Convert a bignum intInf to a bignum pointer.
- */
-static inline GC_intInf toBignum (GC_state s, objptr arg) {
- GC_intInf bp;
-
- assert (not isSmall(arg));
- bp = (GC_intInf)(objptrToPointer(arg, s->heap.start)
- - offsetof(struct GC_intInf, isneg));
- if (DEBUG_INT_INF)
- fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
- assert (bp->header == GC_INTINF_HEADER);
- return bp;
-}
-
-/*
- * Given an intInf, a pointer to an __mpz_struct and space large
- * enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
- * __mpz_struct.
- */
-void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
- mp_limb_t space[LIMBS_PER_OBJPTR + 1]) {
- GC_intInf bp;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
- arg, (uintptr_t)res, (uintptr_t)space);
- if (isSmall(arg)) {
- res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
- res->_mp_d = space;
- if (arg == (objptr)1) {
- res->_mp_size = 0;
- } else {
- objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
- bool neg = (arg & highBitMask) != (objptr)0;
- if (neg) {
- res->_mp_size = - (mp_size_t)LIMBS_PER_OBJPTR;
- arg = -((arg >> 1) | highBitMask);
- } else {
- res->_mp_size = (mp_size_t)LIMBS_PER_OBJPTR;
- arg = (arg >> 1);
- }
- for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
- space[i] = (mp_limb_t)arg;
- arg = arg >> (CHAR_BIT * sizeof(mp_limb_t));
- }
- }
- } else {
- bp = toBignum (s, arg);
- res->_mp_alloc = bp->length - 1;
- res->_mp_d = (mp_limb_t*)(bp->limbs);
- res->_mp_size = bp->isneg ? - res->_mp_alloc : res->_mp_alloc;
- }
- assert ((res->_mp_size == 0)
- or (res->_mp_d[(res->_mp_size < 0
- ? - res->_mp_size
- : res->_mp_size) - 1] != 0));
- if (DEBUG_INT_INF_DETAILED)
- fprintf (stderr, "arg --> %s\n",
- mpz_get_str (NULL, 10, res));
-}
-
-/*
- * Initialize an __mpz_struct to use the space provided by the heap.
- */
-void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
- GC_intInf bp;
-
- assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
- bp = (GC_intInf)s->frontier;
- /* We have as much space for the limbs as there is to the end of the
- * heap. Divide by (sizeof(mp_limb_t)) to get number of limbs.
- */
- res->_mp_alloc = (s->limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
- res->_mp_d = (mp_limb_t*)(bp->limbs);
- res->_mp_size = 0; /* is this necessary? */
-}
-
-/*
- * Given an __mpz_struct pointer which reflects the answer, set
- * gcState.frontier and return the answer.
- * If the answer fits in a fixnum, we return that, with the frontier
- * rolled back.
- * If the answer doesn't need all of the space allocated, we adjust
- * the array size and roll the frontier slightly back.
- */
-objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
- GC_intInf bp;
- mp_size_t size;
-
- assert ((res->_mp_size == 0)
- or (res->_mp_d[(res->_mp_size < 0
- ? - res->_mp_size
- : res->_mp_size) - 1] != 0));
- if (DEBUG_INT_INF)
- fprintf (stderr, "finiIntInfRes ("FMTPTR", %zu)\n",
- (uintptr_t)res, bytes);
- if (DEBUG_INT_INF_DETAILED)
- fprintf (stderr, "res --> %s\n",
- mpz_get_str (NULL, 10, res));
- bp = (GC_intInf)((pointer)res->_mp_d - offsetof(struct GC_intInf, limbs));
- assert (res->_mp_d == (mp_limb_t*)(bp->limbs));
- size = res->_mp_size;
- if (size < 0) {
- bp->isneg = TRUE;
- size = - size;
- } else
- bp->isneg = FALSE;
- if (size <= 1) {
- uintmax_t val, ans;
-
- if (size == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (bp->isneg) {
- /*
- * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
- */
- ans = val;
- if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
- return (objptr)(ans<<1 | 1);
- }
- }
- setFrontier (s, (pointer)(&bp->limbs[size]), bytes);
- bp->counter = 0;
- bp->length = size + 1; /* +1 for isneg field */
- bp->header = GC_INTINF_HEADER;
- return pointerToObjptr ((pointer)&bp->isneg, s->heap.start);
-}
-
-static inline objptr binary (objptr lhs, objptr rhs, size_t bytes,
- void(*binop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *lhsspace,
- __gmp_const __mpz_struct *rhsspace)) {
- __mpz_struct lhsmpz, rhsmpz, resmpz;
- mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
-
- initIntInfRes (&gcState, &resmpz, bytes);
- fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
- fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
- binop (&resmpz, &lhsmpz, &rhsmpz);
- return finiIntInfRes (&gcState, &resmpz, bytes);
-}
-
-objptr IntInf_add (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_add ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_add);
-}
-
-objptr IntInf_andb (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_andb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_and);
-}
-
-objptr IntInf_gcd (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_gcd ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_gcd);
-}
-
-objptr IntInf_mul (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_mul ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_mul);
-}
-
-objptr IntInf_quot (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_tdiv_q);
-}
-
-objptr IntInf_orb (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_orb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_ior);
-}
-
-objptr IntInf_rem (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_tdiv_r);
-}
-
-objptr IntInf_sub (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_sub ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_sub);
-}
-
-objptr IntInf_xorb (objptr lhs, objptr rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_xorb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
- lhs, rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_xor);
-}
-
-static objptr unary (objptr arg, size_t bytes,
- void(*unop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace)) {
- __mpz_struct argmpz, resmpz;
- mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-
- initIntInfRes (&gcState, &resmpz, bytes);
- fillIntInfArg (&gcState, arg, &argmpz, argspace);
- unop (&resmpz, &argmpz);
- return finiIntInfRes (&gcState, &resmpz, bytes);
-}
-
-objptr IntInf_neg (objptr arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_neg ("FMTOBJPTR", %zu)\n",
- arg, bytes);
- return unary (arg, bytes, &mpz_neg);
-}
-
-objptr IntInf_notb (objptr arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_notb ("FMTOBJPTR", %zu)\n",
- arg, bytes);
- return unary (arg, bytes, &mpz_com);
-}
-
-static objptr shary (objptr arg, uint32_t shift, size_t bytes,
- void(*shop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace,
- unsigned long shift))
-{
- __mpz_struct argmpz, resmpz;
- mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-
- initIntInfRes (&gcState, &resmpz, bytes);
- fillIntInfArg (&gcState, arg, &argmpz, argspace);
- shop (&resmpz, &argmpz, (unsigned long)shift);
- return finiIntInfRes (&gcState, &resmpz, bytes);
-}
-
-objptr IntInf_arshift (objptr arg, uint32_t shift, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_arshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
- arg, shift, bytes);
- return shary (arg, shift, bytes, &mpz_fdiv_q_2exp);
-}
-
-objptr IntInf_lshift (objptr arg, uint32_t shift, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_lshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
- arg, shift, bytes);
- return shary(arg, shift, bytes, &mpz_mul_2exp);
-}
-
-/*
- * Return an integer which compares to 0 as the two intInf args compare
- * to each other.
- */
-Int32_t IntInf_compare (objptr lhs, objptr rhs) {
- __mpz_struct lhsmpz, rhsmpz;
- mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
- int res;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_compare ("FMTOBJPTR", "FMTOBJPTR")\n",
- lhs, rhs);
- fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
- fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
- res = mpz_cmp (&lhsmpz, &rhsmpz);
- if (res < 0) return -1;
- if (res > 0) return 1;
- return 0;
-}
-
-/*
- * Check if two IntInf.int's are equal.
- */
-Bool_t IntInf_equal (objptr lhs, objptr rhs) {
- if (lhs == rhs)
- return TRUE;
- if (isEitherSmall (lhs, rhs))
- return FALSE;
- else
- return 0 == IntInf_compare (lhs, rhs);
-}
-
-/*
- * Convert an intInf to a string.
- * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and
- * space is a string (mutable) which is large enough.
- */
-objptr IntInf_toString (objptr arg, int32_t base, size_t bytes) {
- GC_string8 sp;
- __mpz_struct argmpz;
- mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
- char *str;
- size_t size;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_toString ("FMTOBJPTR", %"PRId32", %zu)\n",
- arg, base, bytes);
- assert (base == 2 || base == 8 || base == 10 || base == 16);
- fillIntInfArg (&gcState, arg, &argmpz, argspace);
- sp = (GC_string8)gcState.frontier;
- str = mpz_get_str(sp->chars, base, &argmpz);
- assert (str == sp->chars);
- size = strlen(str);
- if (*sp->chars == '-')
- *sp->chars = '~';
- if (base > 0)
- for (unsigned int i = 0; i < size; i++) {
- char c = sp->chars[i];
- if (('a' <= c) && (c <= 'z'))
- sp->chars[i] = c + ('A' - 'a');
- }
- setFrontier (&gcState, (pointer)(&sp->chars[size]), bytes);
- sp->counter = 0;
- sp->length = size;
- sp->header = GC_STRING8_HEADER;
- return pointerToObjptr ((pointer)&sp->chars, gcState.heap.start);
-}
-
-Word32_t
-IntInf_smallMul(Word32_t lhs, Word32_t rhs, Ref(Word32_t) carry) {
- intmax_t prod;
-
- prod = (intmax_t)(Int32_t)lhs * (intmax_t)(Int32_t)rhs;
- *(Word32_t *)carry = (Word32_t)((uintmax_t)prod >> 32);
- return ((Word32_t)(uintmax_t)prod);
-}
|
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:35:26
|
Rename int-inf-ops.c to int-inf.c; needed to commit before doing rename
----------------------------------------------------------------------
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
----------------------------------------------------------------------
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c (from rev 4334, mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:28:44 UTC (rev 4334)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c 2006-02-03 00:35:24 UTC (rev 4335)
@@ -0,0 +1,367 @@
+/* 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.
+ */
+
+/*
+ * Test if a intInf is a fixnum.
+ */
+static inline bool isSmall (objptr arg) {
+ return (arg & 1);
+}
+
+static inline bool isEitherSmall (objptr arg1, objptr arg2) {
+ return ((arg1 | arg2) & (objptr)1);
+}
+
+static inline bool areSmall (objptr arg1, objptr arg2) {
+ return (arg1 & arg2 & (objptr)1);
+}
+
+/*
+ * Convert a bignum intInf to a bignum pointer.
+ */
+static inline GC_intInf toBignum (GC_state s, objptr arg) {
+ GC_intInf bp;
+
+ assert (not isSmall(arg));
+ bp = (GC_intInf)(objptrToPointer(arg, s->heap.start)
+ - offsetof(struct GC_intInf, isneg));
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
+ assert (bp->header == GC_INTINF_HEADER);
+ return bp;
+}
+
+/*
+ * Given an intInf, a pointer to an __mpz_struct and space large
+ * enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
+ * __mpz_struct.
+ */
+void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
+ mp_limb_t space[LIMBS_PER_OBJPTR + 1]) {
+ GC_intInf bp;
+
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
+ arg, (uintptr_t)res, (uintptr_t)space);
+ if (isSmall(arg)) {
+ res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
+ res->_mp_d = space;
+ if (arg == (objptr)1) {
+ res->_mp_size = 0;
+ } else {
+ objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
+ bool neg = (arg & highBitMask) != (objptr)0;
+ if (neg) {
+ res->_mp_size = - (mp_size_t)LIMBS_PER_OBJPTR;
+ arg = -((arg >> 1) | highBitMask);
+ } else {
+ res->_mp_size = (mp_size_t)LIMBS_PER_OBJPTR;
+ arg = (arg >> 1);
+ }
+ for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
+ space[i] = (mp_limb_t)arg;
+ arg = arg >> (CHAR_BIT * sizeof(mp_limb_t));
+ }
+ }
+ } else {
+ bp = toBignum (s, arg);
+ res->_mp_alloc = bp->length - 1;
+ res->_mp_d = (mp_limb_t*)(bp->limbs);
+ res->_mp_size = bp->isneg ? - res->_mp_alloc : res->_mp_alloc;
+ }
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "arg --> %s\n",
+ mpz_get_str (NULL, 10, res));
+}
+
+/*
+ * Initialize an __mpz_struct to use the space provided by the heap.
+ */
+void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
+
+ assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
+ bp = (GC_intInf)s->frontier;
+ /* We have as much space for the limbs as there is to the end of the
+ * heap. Divide by (sizeof(mp_limb_t)) to get number of limbs.
+ */
+ res->_mp_alloc = (s->limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
+ res->_mp_d = (mp_limb_t*)(bp->limbs);
+ res->_mp_size = 0; /* is this necessary? */
+}
+
+/*
+ * Given an __mpz_struct pointer which reflects the answer, set
+ * gcState.frontier and return the answer.
+ * If the answer fits in a fixnum, we return that, with the frontier
+ * rolled back.
+ * If the answer doesn't need all of the space allocated, we adjust
+ * the array size and roll the frontier slightly back.
+ */
+objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
+ mp_size_t size;
+
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "finiIntInfRes ("FMTPTR", %zu)\n",
+ (uintptr_t)res, bytes);
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "res --> %s\n",
+ mpz_get_str (NULL, 10, res));
+ bp = (GC_intInf)((pointer)res->_mp_d - offsetof(struct GC_intInf, limbs));
+ assert (res->_mp_d == (mp_limb_t*)(bp->limbs));
+ size = res->_mp_size;
+ if (size < 0) {
+ bp->isneg = TRUE;
+ size = - size;
+ } else
+ bp->isneg = FALSE;
+ if (size <= 1) {
+ uintmax_t val, ans;
+
+ if (size == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (bp->isneg) {
+ /*
+ * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
+ */
+ ans = val;
+ if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
+ return (objptr)(ans<<1 | 1);
+ }
+ }
+ setFrontier (s, (pointer)(&bp->limbs[size]), bytes);
+ bp->counter = 0;
+ bp->length = size + 1; /* +1 for isneg field */
+ bp->header = GC_INTINF_HEADER;
+ return pointerToObjptr ((pointer)&bp->isneg, s->heap.start);
+}
+
+static inline objptr binary (objptr lhs, objptr rhs, size_t bytes,
+ void(*binop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *lhsspace,
+ __gmp_const __mpz_struct *rhsspace)) {
+ __mpz_struct lhsmpz, rhsmpz, resmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ binop (&resmpz, &lhsmpz, &rhsmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
+
+objptr IntInf_add (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_add ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_add);
+}
+
+objptr IntInf_andb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_andb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_and);
+}
+
+objptr IntInf_gcd (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_gcd ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_gcd);
+}
+
+objptr IntInf_mul (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_mul ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_mul);
+}
+
+objptr IntInf_quot (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_q);
+}
+
+objptr IntInf_orb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_orb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_ior);
+}
+
+objptr IntInf_rem (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_r);
+}
+
+objptr IntInf_sub (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_sub ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_sub);
+}
+
+objptr IntInf_xorb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_xorb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_xor);
+}
+
+static objptr unary (objptr arg, size_t bytes,
+ void(*unop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace)) {
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
+
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ unop (&resmpz, &argmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
+
+objptr IntInf_neg (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_neg ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_neg);
+}
+
+objptr IntInf_notb (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_notb ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_com);
+}
+
+static objptr shary (objptr arg, uint32_t shift, size_t bytes,
+ void(*shop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace,
+ unsigned long shift))
+{
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
+
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ shop (&resmpz, &argmpz, (unsigned long)shift);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
+
+objptr IntInf_arshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_arshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary (arg, shift, bytes, &mpz_fdiv_q_2exp);
+}
+
+objptr IntInf_lshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_lshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary(arg, shift, bytes, &mpz_mul_2exp);
+}
+
+/*
+ * Return an integer which compares to 0 as the two intInf args compare
+ * to each other.
+ */
+Int32_t IntInf_compare (objptr lhs, objptr rhs) {
+ __mpz_struct lhsmpz, rhsmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+ int res;
+
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_compare ("FMTOBJPTR", "FMTOBJPTR")\n",
+ lhs, rhs);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ res = mpz_cmp (&lhsmpz, &rhsmpz);
+ if (res < 0) return -1;
+ if (res > 0) return 1;
+ return 0;
+}
+
+/*
+ * Check if two IntInf.int's are equal.
+ */
+Bool_t IntInf_equal (objptr lhs, objptr rhs) {
+ if (lhs == rhs)
+ return TRUE;
+ if (isEitherSmall (lhs, rhs))
+ return FALSE;
+ else
+ return 0 == IntInf_compare (lhs, rhs);
+}
+
+/*
+ * Convert an intInf to a string.
+ * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and
+ * space is a string (mutable) which is large enough.
+ */
+objptr IntInf_toString (objptr arg, int32_t base, size_t bytes) {
+ GC_string8 sp;
+ __mpz_struct argmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
+ char *str;
+ size_t size;
+
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_toString ("FMTOBJPTR", %"PRId32", %zu)\n",
+ arg, base, bytes);
+ assert (base == 2 || base == 8 || base == 10 || base == 16);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ sp = (GC_string8)gcState.frontier;
+ str = mpz_get_str(sp->chars, base, &argmpz);
+ assert (str == sp->chars);
+ size = strlen(str);
+ if (*sp->chars == '-')
+ *sp->chars = '~';
+ if (base > 0)
+ for (unsigned int i = 0; i < size; i++) {
+ char c = sp->chars[i];
+ if (('a' <= c) && (c <= 'z'))
+ sp->chars[i] = c + ('A' - 'a');
+ }
+ setFrontier (&gcState, (pointer)(&sp->chars[size]), bytes);
+ sp->counter = 0;
+ sp->length = size;
+ sp->header = GC_STRING8_HEADER;
+ return pointerToObjptr ((pointer)&sp->chars, gcState.heap.start);
+}
+
+Word32_t
+IntInf_smallMul(Word32_t lhs, Word32_t rhs, Ref(Word32_t) carry) {
+ intmax_t prod;
+
+ prod = (intmax_t)(Int32_t)lhs * (intmax_t)(Int32_t)rhs;
+ *(Word32_t *)carry = (Word32_t)((uintmax_t)prod >> 32);
+ return ((Word32_t)(uintmax_t)prod);
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-02-03 00:28:44 UTC (rev 4334)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2006-02-03 00:35:24 UTC (rev 4335)
@@ -16,6 +16,9 @@
#include "gc/align.c"
#include "gc/read_write.c"
+/* Import the global gcState (but try not to use it too much). */
+extern struct GC_state gcState;
+
#include "gc/array-allocate.c"
#include "gc/array.c"
#include "gc/atomic.c"
@@ -39,6 +42,7 @@
#include "gc/heap_predicates.c"
#include "gc/init-world.c"
#include "gc/init.c"
+#include "gc/int-inf.c"
#include "gc/invariant.c"
#include "gc/mark-compact.c"
#include "gc/model.c"
@@ -60,4 +64,3 @@
#include "gc/translate.c"
#include "gc/weak.c"
#include "gc/world.c"
-#include "gc/int-inf-ops.c"
|
|
From: Matthew F. <fl...@ml...> - 2006-02-02 16:28:54
|
Moved IntInf operations into gc runtime, where it has access to objptr
representation.
Simplified IntInf_{quot,rem} by calling mpz_tdiv_{q,r}, which have the
right semantics (round _t_oward zero).
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/TODO
D mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/string.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2006-02-03 00:28:44 UTC (rev 4334)
@@ -26,7 +26,7 @@
endif
ifeq ($(TARGET_ARCH), amd64)
-FLAGS += -m32 -mtune=opteron
+FLAGS += -m64 -mtune=opteron
endif
ifeq ($(TARGET_ARCH), sparc)
@@ -53,6 +53,7 @@
CC = gcc -std=gnu99
CFLAGS = -Wall -I. -Iplatform $(FLAGS)
OPTCFLAGS = $(CFLAGS) -O2 $(OPTFLAGS)
+GCOPTCFLAGS = --param inline-unit-growth=75 --param max-inline-insns-single=1000
DEBUGCFLAGS = $(CFLAGS) -gstabs+ -g2 -O1 -DASSERT=1
WARNFLAGS = -pedantic -Wall -Wextra -Wno-unused-parameter -Wno-unused-function \
-Wformat-nonliteral \
@@ -189,7 +190,7 @@
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNFLAGS) -c -o $@ $<
gc.o: gc.c $(GCCFILES) $(HFILES)
- $(CC) $(OPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
+ $(CC) $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNFLAGS) -c -o $@ $<
# It looks like we don't follow the C spec w.r.t. aliasing. And gcc
# -O2 catches us on the code in Real/*.c where we treat a double as a
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/TODO 2006-02-03 00:28:44 UTC (rev 4334)
@@ -4,10 +4,9 @@
* Use C99 <assert.h> instead of util/assert.{c,h}
+Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset; This
+requires fixing the semantics of the primitives as well.
-Fix PackWord{16,32,64}_{sub,upadate}{,Rev} to use byte offset;
-This requires fixing the semantics of the primitives as well.
-
basis/Int/Word.c
basis/IntInf.c
basis/MLton/allocTooLarge.c
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/IntInf.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -1,545 +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.
- */
-
-#define MLTON_GC_INTERNAL_TYPES
-#define MLTON_GC_INTERNAL_BASIS
-#include "platform.h"
-typedef unsigned int uint;
-
-/* Import the global gcState so we can get and set the frontier. */
-extern struct GC_state gcState;
-
-/*
- * Test if a intInf is a fixnum.
- */
-static inline bool isSmall (pointer arg) {
- return ((uintptr_t)arg & 1);
-}
-
-static inline bool eitherIsSmall (pointer arg1, pointer arg2) {
- return (((uintptr_t)arg1 | (uintptr_t)arg2) & 1);
-}
-
-static inline bool areSmall (pointer arg1, pointer arg2) {
- return ((uintptr_t)arg1 & (uintptr_t)arg2 & 1);
-}
-
-/*
- * Convert a bignum intInf to a bignum pointer.
- */
-static inline GC_intInf toBignum (pointer arg) {
- GC_intInf bp;
-
- assert(not isSmall(arg));
- bp = (GC_intInf)(arg - offsetof(struct GC_intInf, isneg));
- if (DEBUG_INT_INF)
- fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
- assert (bp->header == GC_intInfHeader ());
- return bp;
-}
-
-/*
- * Given an intInf, a pointer to an __mpz_struct and something large enough
- * to contain 2 limbs, fill in the __mpz_struct.
- */
-static inline void fill (pointer arg, __mpz_struct *res, mp_limb_t space[2]) {
- GC_intInf bp;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "fill ("FMTPTR", "FMTPTR", "FMTPTR")\n",
- (uintptr_t)arg, (uintptr_t)res, (uintptr_t)space);
- if (isSmall(arg)) {
- res->_mp_alloc = 2;
- res->_mp_d = space;
- if ((int)arg > 1) {
- res->_mp_size = 1;
- space[0] = (uint)arg >> 1;
- } else if ((int)arg < 0) {
- res->_mp_size = -1;
- space[0] = - (int)((uint)arg>>1 | (uint)1<<31);
- } else
- res->_mp_size = 0;
- } else {
- bp = toBignum(arg);
- res->_mp_alloc = bp->length - 1;
- res->_mp_d = (mp_limb_t*)(bp->limbs);
- res->_mp_size = bp->isneg ? - res->_mp_alloc
- : res->_mp_alloc;
- }
-}
-
-/*
- * Initialize an __mpz_struct to use the space provided by an ML array.
- */
-static inline void initRes (__mpz_struct *mpzp, size_t bytes) {
- GC_intInf bp;
-
- assert (bytes <= (size_t)(gcState.limitPlusSlop - gcState.frontier));
- bp = (GC_intInf)gcState.frontier;
- /* We have as much space for the limbs as there is to the end
- * of the heap. Divide by (sizeof(mp_limb_t)) to get number
- * of limbs.
- */
- mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
- mpzp->_mp_size = 0; /* is this necessary? */
- mpzp->_mp_d = (mp_limb_t*)(bp->limbs);
-}
-
-/*
- * Count number of leading zeros. The argument will not be zero.
- * This MUST be replaced with assembler.
- */
-static inline uint leadingZeros (mp_limb_t word) {
- uint res;
-
- assert(word != 0);
- res = 0;
- while ((int)word > 0) {
- ++res;
- word <<= 1;
- }
- return (res);
-}
-
-static inline void setFrontier (pointer p, size_t bytes) {
- p = GC_alignFrontier (&gcState, p);
- assert ((size_t)(p - gcState.frontier) <= bytes);
- GC_profileAllocInc (&gcState, p - gcState.frontier);
- gcState.frontier = p;
- assert (gcState.frontier <= gcState.limitPlusSlop);
-}
-
-/*
- * Given an __mpz_struct pointer which reflects the answer, set gcState.frontier
- * and return the answer.
- * If the answer fits in a fixnum, we return that, with the frontier
- * rolled back.
- * If the answer doesn't need all of the space allocated, we adjust
- * the array size and roll the frontier slightly back.
- */
-static pointer answer (__mpz_struct *ans, size_t bytes) {
- GC_intInf bp;
- int size;
-
- bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs));
- assert(ans->_mp_d == (mp_limb_t*)(bp->limbs));
- size = ans->_mp_size;
- if (size < 0) {
- bp->isneg = TRUE;
- size = - size;
- } else
- bp->isneg = FALSE;
- if (size <= 1) {
- uint val,
- ans;
-
- if (size == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (bp->isneg) {
- /*
- * We only fit if val in [1, 2^30].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^30 - 1].
- */
- ans = val;
- if (val < (uint)1<<30) {
- return (pointer)(ans<<1 | 1);
- }
- }
- setFrontier ((pointer)(&bp->limbs[size]), bytes);
- bp->counter = 0;
- bp->length = size + 1; /* +1 for isNeg word */
- bp->header = GC_intInfHeader ();
- return (pointer)&bp->isneg;
-}
-
-static inline pointer binary (pointer lhs, pointer rhs, size_t bytes,
- void(*binop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *lhsspace,
- __gmp_const __mpz_struct *rhsspace)) {
- __mpz_struct lhsmpz,
- rhsmpz,
- resmpz;
- mp_limb_t lhsspace[2],
- rhsspace[2];
-
- initRes (&resmpz, bytes);
- fill (lhs, &lhsmpz, lhsspace);
- fill (rhs, &rhsmpz, rhsspace);
- binop (&resmpz, &lhsmpz, &rhsmpz);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_add (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_add);
-}
-
-pointer IntInf_gcd (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_gcd);
-}
-
-pointer IntInf_mul (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_mul);
-}
-
-pointer IntInf_sub (pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary (lhs, rhs, bytes, &mpz_sub);
-}
-
-pointer IntInf_andb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_and);
-}
-
-pointer IntInf_orb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_ior);
-}
-
-pointer IntInf_xorb(pointer lhs, pointer rhs, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %zu)\n",
- (uintptr_t)lhs, (uintptr_t)rhs, bytes);
- return binary(lhs, rhs, bytes, &mpz_xor);
-}
-
-static pointer
-unary(pointer arg, size_t bytes,
- void(*unop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace))
-{
- __mpz_struct argmpz,
- resmpz;
- mp_limb_t argspace[2];
-
- initRes(&resmpz, bytes);
- fill(arg, &argmpz, argspace);
- unop(&resmpz, &argmpz);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_neg(pointer arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_neg ("FMTPTR", %zu)\n",
- (uintptr_t)arg, bytes);
- return unary(arg, bytes, &mpz_neg);
-}
-
-pointer IntInf_notb(pointer arg, size_t bytes) {
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_notb ("FMTPTR", %zu)\n",
- (uintptr_t)arg, bytes);
- return unary(arg, bytes, &mpz_com);
-}
-
-static pointer
-shary(pointer arg, uint shift, size_t bytes,
- void(*shop)(__mpz_struct *resmpz,
- __gmp_const __mpz_struct *argspace,
- unsigned long shift))
-{
- __mpz_struct argmpz,
- resmpz;
- mp_limb_t argspace[2];
-
- initRes(&resmpz, bytes);
- fill(arg, &argmpz, argspace);
- shop(&resmpz, &argmpz, (unsigned long)shift);
- return answer (&resmpz, bytes);
-}
-
-pointer IntInf_arshift(pointer arg, Word shift_w, size_t bytes) {
- uint shift = (uint)shift_w;
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %zu)\n",
- (uintptr_t)arg, shift, bytes);
- return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
-}
-
-pointer IntInf_lshift(pointer arg, Word shift_w, size_t bytes) {
- uint shift = (uint)shift_w;
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %zu)\n",
- (uintptr_t)arg, shift, bytes);
- return shary(arg, shift, bytes, &mpz_mul_2exp);
-}
-
-Word
-IntInf_smallMul(Word lhs, Word rhs, pointer carry)
-{
- intmax_t prod;
-
- prod = (intmax_t)(int)lhs * (int)rhs;
- *(uint *)carry = (uintmax_t)prod >> 32;
- return ((uint)(uintmax_t)prod);
-}
-
-/*
- * Return an integer which compares to 0 as the two intInf args compare
- * to each other.
- */
-Int IntInf_compare (pointer lhs, pointer rhs) {
- __mpz_struct lhsmpz,
- rhsmpz;
- mp_limb_t lhsspace[2],
- rhsspace[2];
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n",
- (uintptr_t)lhs, (uintptr_t)rhs);
- fill (lhs, &lhsmpz, lhsspace);
- fill (rhs, &rhsmpz, rhsspace);
- return mpz_cmp (&lhsmpz, &rhsmpz);
-}
-
-/*
- * Check if two IntInf.int's are equal.
- */
-Bool IntInf_equal (pointer lhs, pointer rhs) {
- if (lhs == rhs)
- return TRUE;
- if (eitherIsSmall (lhs, rhs))
- return FALSE;
- else
- return 0 == IntInf_compare (lhs, rhs);
-}
-
-/*
- * Convert an intInf to a string.
- * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and space is a
- * string (mutable) which is large enough.
- */
-pointer IntInf_toString (pointer arg, int base, size_t bytes) {
- GC_string sp;
- __mpz_struct argmpz;
- mp_limb_t argspace[2];
- char *str;
- uint size;
- uint i;
- char c;
-
- if (DEBUG_INT_INF)
- fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %zu)\n",
- (uintptr_t)arg, base, bytes);
- assert (base == 2 || base == 8 || base == 10 || base == 16);
- fill (arg, &argmpz, argspace);
- sp = (GC_string)gcState.frontier;
- str = mpz_get_str(sp->chars, base, &argmpz);
- assert(str == sp->chars);
- size = strlen(str);
- if (*sp->chars == '-')
- *sp->chars = '~';
- if (base > 0)
- for (i = 0; i < size; i++) {
- c = sp->chars[i];
- if (('a' <= c) && (c <= 'z'))
- sp->chars[i] = c + ('A' - 'a');
- }
- sp->counter = 0;
- sp->length = size;
- sp->header = GC_stringHeader ();
- setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes);
- return (pointer)str;
-}
-
-/*
- * Quotient (round towards 0, remainder is returned by IntInf_rem).
- * space is a word array with enough space for the quotient
- * num limbs + 1 - den limbs
- * shifted numerator
- * num limbs + 1
- * and shifted denominator
- * den limbs
- * and the isNeg word.
- * It must be the last thing allocated.
- * num is the numerator bignum, den is the denominator and frontier is
- * the current frontier.
- */
-pointer IntInf_quot (pointer num, pointer den, size_t bytes) {
- __mpz_struct resmpz,
- nmpz,
- dmpz;
- mp_limb_t nss[2],
- dss[2],
- carry,
- *np,
- *dp;
- int nsize,
- dsize,
- qsize;
- bool resIsNeg;
- uint shift;
-
- initRes(&resmpz, bytes);
- fill(num, &nmpz, nss);
- resIsNeg = FALSE;
- nsize = nmpz._mp_size;
- if (nsize < 0) {
- nsize = - nsize;
- resIsNeg = TRUE;
- }
- fill(den, &dmpz, dss);
- dsize = dmpz._mp_size;
- if (dsize < 0) {
- dsize = - dsize;
- resIsNeg = not resIsNeg;
- }
- assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
- assert((nsize == 0 && dsize == 1)
- or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
- qsize = 1 + nsize - dsize;
- if (dsize == 1) {
- if (nsize == 0)
- return (pointer)1; /* tagged 0 */
- mpn_divrem_1(resmpz._mp_d,
- (mp_size_t)0,
- nmpz._mp_d,
- nsize,
- dmpz._mp_d[0]);
- if (resmpz._mp_d[qsize - 1] == 0)
- --qsize;
- } else {
- np = &resmpz._mp_d[qsize];
- shift = leadingZeros(dmpz._mp_d[dsize - 1]);
- if (shift == 0) {
- dp = dmpz._mp_d;
- memcpy((void *)np,
- nmpz._mp_d,
- nsize * sizeof(*nmpz._mp_d));
- } else {
- carry = mpn_lshift(np, nmpz._mp_d, nsize, shift);
- unless (carry == 0)
- np[nsize++] = carry;
- dp = &np[nsize];
- mpn_lshift(dp, dmpz._mp_d, dsize, shift);
- }
- carry = mpn_divrem(resmpz._mp_d,
- (mp_size_t)0,
- np,
- nsize,
- dp,
- dsize);
- qsize = nsize - dsize;
- if (carry != 0)
- resmpz._mp_d[qsize++] = carry;
- }
- resmpz._mp_size = resIsNeg ? - qsize : qsize;
- return answer (&resmpz, bytes);
-}
-
-
-/*
- * Remainder (sign taken from numerator, quotient is returned by IntInf_quot).
- * space is a word array with enough space for the remainder
- * den limbs
- * shifted numerator
- * num limbs + 1
- * and shifted denominator
- * den limbs
- * and the isNeg word.
- * It must be the last thing allocated.
- * num is the numerator bignum, den is the denominator and frontier is
- * the current frontier.
- */
-pointer IntInf_rem (pointer num, pointer den, size_t bytes) {
- __mpz_struct resmpz,
- nmpz,
- dmpz;
- mp_limb_t nss[2],
- dss[2],
- carry,
- *dp;
- int nsize,
- dsize;
- bool resIsNeg;
- uint shift;
-
- initRes(&resmpz, bytes);
- fill(num, &nmpz, nss);
- nsize = nmpz._mp_size;
- resIsNeg = nsize < 0;
- if (resIsNeg)
- nsize = - nsize;
- fill(den, &dmpz, dss);
- dsize = dmpz._mp_size;
- if (dsize < 0)
- dsize = - dsize;
- assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0);
- assert((nsize == 0 && dsize == 1)
- or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0));
- if (dsize == 1) {
- if (nsize == 0)
- resmpz._mp_size = 0;
- else {
- carry = mpn_mod_1(nmpz._mp_d, nsize, dmpz._mp_d[0]);
- if (carry == 0)
- nsize = 0;
- else {
- resmpz._mp_d[0] = carry;
- nsize = 1;
- }
- }
- } else {
- shift = leadingZeros(dmpz._mp_d[dsize - 1]);
- if (shift == 0) {
- dp = dmpz._mp_d;
- memcpy((void *)resmpz._mp_d,
- (void *)nmpz._mp_d,
- nsize * sizeof(*nmpz._mp_d));
- } else {
- carry = mpn_lshift(resmpz._mp_d,
- nmpz._mp_d,
- nsize,
- shift);
- unless (carry == 0)
- resmpz._mp_d[nsize++] = carry;
- dp = &resmpz._mp_d[nsize];
- mpn_lshift(dp, dmpz._mp_d, dsize, shift);
- }
- mpn_divrem(&resmpz._mp_d[dsize],
- (mp_size_t)0,
- resmpz._mp_d,
- nsize,
- dp,
- dsize);
- nsize = dsize;
- assert(nsize > 0);
- while (resmpz._mp_d[nsize - 1] == 0)
- if (--nsize == 0)
- break;
- unless (nsize == 0 || shift == 0) {
- mpn_rshift(resmpz._mp_d, resmpz._mp_d, nsize, shift);
- if (resmpz._mp_d[nsize - 1] == 0)
- --nsize;
- }
- }
- resmpz._mp_size = resIsNeg ? - nsize : nsize;
- return answer (&resmpz, bytes);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -26,6 +26,3 @@
return (pointer)res;
}
-pointer GC_alignFrontier (GC_state s, pointer p) {
- return alignFrontier (s, p);
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -13,9 +13,3 @@
static inline pointer alignFrontier (GC_state s, pointer p);
#endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */
-
-#if (defined (MLTON_GC_INTERNAL_BASIS))
-
-pointer GC_alignFrontier (GC_state s, pointer p);
-
-#endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */
Deleted: mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/assumptions.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -1,17 +0,0 @@
-/* Copyright (C) 2005-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.
- */
-
-/*
- * Various assumptions about the underlying C translator. This is the
- * place for characteristics that are not dictated by the C standard,
- * but which are reasonable to assume on a wide variety of target
- * platforms. Working around these assumptions would be difficult.
- */
-void checkAssumptions (void) {
- assert(CHAR_BIT == 8);
- /* assert(repof(uintptr_t) == TWOS); */
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -19,6 +19,7 @@
DEBUG_ENTER_LEAVE = FALSE,
DEBUG_GENERATIONAL = FALSE,
DEBUG_INT_INF = FALSE,
+ DEBUG_INT_INF_DETAILED = FALSE,
DEBUG_MARK_COMPACT = FALSE,
DEBUG_MEM = FALSE,
DEBUG_PROFILE = FALSE,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -10,27 +10,27 @@
/* Initialization */
/* ---------------------------------------------------------------- */
+size_t sizeofIntInfFromString (GC_state s, const char *str) {
+ size_t slen = strlen (str);
+
+ /* A slight overestimate. */
+ double bytesPerChar = 0.415241011861 /* = ((log(10.0) / log(2.0)) / 8.0) */ ;
+ double bytes = ceil((double)slen * bytesPerChar);
+ return align (GC_ARRAY_HEADER_SIZE
+ + sizeof(mp_limb_t) // for the sign
+ + align((size_t)bytes, sizeof(mp_limb_t)),
+ s->alignment);
+}
+
size_t sizeofInitialBytesLive (GC_state s) {
uint32_t i;
- size_t maxSLen = 0;
size_t numBytes;
size_t total;
total = 0;
for (i = 0; i < s->intInfInitsLength; ++i) {
- size_t slen = strlen (s->intInfInits[i].mlstr);
- maxSLen = max (maxSLen, slen);
- double bytesPerChar = 0.415241011861 /* = ((log(10.0) / log(2.0)) / 8.0) */ ;
- double bytes = ceil((double)slen * bytesPerChar);
- /* A slight overestimate. */
- numBytes =
- sizeof(mp_limb_t) // for the sign
- + (align((size_t)bytes, sizeof(mp_limb_t)));
- total += align (GC_ARRAY_HEADER_SIZE
- + numBytes,
- s->alignment);
+ total += sizeofIntInfFromString (s, s->intInfInits[i].mlstr);
}
- total += maxSLen;
for (i = 0; i < s->vectorInitsLength; ++i) {
numBytes =
s->vectorInits[i].bytesPerElement
@@ -46,68 +46,30 @@
void initIntInfs (GC_state s) {
struct GC_intInfInit *inits;
- pointer frontier;
+ uint32_t i;
const char *str;
- size_t slen;
- mp_size_t alen;
- uint32_t i, j;
+ size_t bytes;
bool neg;
- GC_intInf bp;
- unsigned char *cp;
+ __mpz_struct resmpz;
+ int ans;
assert (isFrontierAligned (s, s->frontier));
- frontier = s->frontier;
for (i = 0; i < s->intInfInitsLength; i++) {
inits = &(s->intInfInits[i]);
- str = inits->mlstr;
assert (inits->globalIndex < s->globalsLength);
+ str = inits->mlstr;
+ bytes = sizeofIntInfFromString (s, str);
neg = *str == '~';
if (neg)
str++;
- slen = strlen (str);
- assert (slen > 0);
- bp = (GC_intInf)frontier;
- cp = (unsigned char*)(s->heap.start + (s->heap.size - slen));
-
- for (j = 0; j != slen; j++) {
- assert ('0' <= str[j] && str[j] <= '9');
- cp[j] = str[j] - '0' + 0;
- }
- alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, 10);
- if (alen <= 1) {
- uintmax_t val, ans;
-
- if (alen == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (neg) {
- /*
- * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
- */
- ans = val;
- if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
- s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
- continue;
- }
- }
- s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
- bp->counter = 0;
- bp->length = alen + 1;
- bp->header = GC_INTINF_HEADER;
- bp->isneg = neg;
- frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+ initIntInfRes (s, &resmpz, bytes);
+ ans = mpz_set_str (&resmpz, str, 10);
+ assert (ans == 0);
+ if (neg)
+ resmpz._mp_size = - resmpz._mp_size;
+ s->globals[inits->globalIndex] = finiIntInfRes (s, &resmpz, bytes);
}
- assert (isFrontierAligned (s, frontier));
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->frontier = frontier;
- s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
+ assert (isFrontierAligned (s, s->frontier));
}
void initVectors (GC_state s) {
@@ -185,6 +147,8 @@
createCardMapAndCrossMap (s);
start = alignFrontier (s, s->heap.start);
s->frontier = start;
+ s->limitPlusSlop = s->heap.start + s->heap.size;
+ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
initIntInfs (s);
initVectors (s);
assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2006-02-03 00:28:44 UTC (rev 4334)
@@ -36,7 +36,8 @@
#if (defined (MLTON_GC_INTERNAL_FUNCS))
-static size_t sizeofInitialBytesLive (GC_state s);
+static inline size_t sizeofIntInfFromString (GC_state s, const char *str);
+static inline size_t sizeofInitialBytesLive (GC_state s);
static void initIntInfs (GC_state s);
static void initVectors (GC_state s);
static void initWorld (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-01-31 02:01:34 UTC (rev 4333)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/int-inf-ops.c 2006-02-03 00:28:44 UTC (rev 4334)
@@ -6,15 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-typedef unsigned int uint;
-
-COMPILE_TIME_ASSERT(sizeof_mp_limb_t__compat__sizeof_objptr,
- (sizeof(mp_limb_t) >= sizeof(objptr)) ||
- (sizeof(objptr) % sizeof(mp_limb_t) == 0));
-#define LIMBS_PER_OBJPTR ( \
- sizeof(mp_limb_t) >= sizeof(objptr) ? \
- 1 : sizeof(objptr) / sizeof(mp_limb_t))
-
/* Import the global gcState so we can get and set the frontier. */
extern struct GC_state gcState;
@@ -25,22 +16,22 @@
return (arg & 1);
}
-static inline bool eitherIsSmall (objptr arg1, objptr arg2) {
- return ((arg1 | arg2) & 1);
+static inline bool isEitherSmall (objptr arg1, objptr arg2) {
+ return ((arg1 | arg2) & (objptr)1);
}
static inline bool areSmall (objptr arg1, objptr arg2) {
- return (arg1 & arg2 & 1);
+ return (arg1 & arg2 & (objptr)1);
}
/*
* Convert a bignum intInf to a bignum pointer.
*/
-static inline GC_intInf toBignum (objptr arg) {
+static inline GC_intInf toBignum (GC_state s, objptr arg) {
GC_intInf bp;
- assert(not isSmall(arg));
- bp = (GC_intInf)(objptrToPointer(arg, gcState.heap.start)
+ assert (not isSmall(arg));
+ bp = (GC_intInf)(objptrToPointer(arg, s->heap.start)
- offsetof(struct GC_intInf, isneg));
if (DEBUG_INT_INF)
fprintf (stderr, "bp->header = "FMTHDR"\n", bp->header);
@@ -50,29 +41,29 @@
/*
* Given an intInf, a pointer to an __mpz_struct and space large
- * enough to contain 2 * LIMBS_PER_OBJPTR limbs, fill in the
+ * enough to contain LIMBS_PER_OBJPTR + 1 limbs, fill in the
* __mpz_struct.
*/
-static inline void fill (objptr arg, __mpz_struct *res,
- mp_limb_t space[2 * LIMBS_PER_OBJPTR]) {
+void fillIntInfArg (GC_state s, objptr arg, __mpz_struct *res,
+ mp_limb_t space[LIMBS_PER_OBJPTR + 1]) {
GC_intInf bp;
if (DEBUG_INT_INF)
- fprintf (stderr, "fill ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
+ fprintf (stderr, "fillIntInfArg ("FMTOBJPTR", "FMTPTR", "FMTPTR")\n",
arg, (uintptr_t)res, (uintptr_t)space);
if (isSmall(arg)) {
- res->_mp_alloc = 2 * LIMBS_PER_OBJPTR;
+ res->_mp_alloc = LIMBS_PER_OBJPTR + 1;
res->_mp_d = space;
- if (arg == 0) {
+ if (arg == (objptr)1) {
res->_mp_size = 0;
} else {
- objptr highBit = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
- bool neg = (arg & highBit) != (objptr)0;
+ objptr highBitMask = (objptr)1 << (CHAR_BIT * OBJPTR_SIZE - 1);
+ bool neg = (arg & highBitMask) != (objptr)0;
if (neg) {
- res->_mp_size = - LIMBS_PER_OBJPTR;
- arg = -((arg >> 1) | highBit);
+ res->_mp_size = - (mp_size_t)LIMBS_PER_OBJPTR;
+ arg = -((arg >> 1) | highBitMask);
} else {
- res->_mp_size = LIMBS_PER_OBJPTR;
+ res->_mp_size = (mp_size_t)LIMBS_PER_OBJPTR;
arg = (arg >> 1);
}
for (unsigned int i = 0; i < LIMBS_PER_OBJPTR; i++) {
@@ -81,480 +72,299 @@
}
}
} else {
- bp = toBignum(arg);
+ bp = toBignum (s, arg);
res->_mp_alloc = bp->length - 1;
res->_mp_d = (mp_limb_t*)(bp->limbs);
res->_mp_size = bp->isneg ? - res->_mp_alloc : res->_mp_alloc;
}
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "arg --> %s\n",
+ mpz_get_str (NULL, 10, res));
}
-/* /\* */
-/* * Initialize an __mpz_struct to use the space provided by an ML array. */
-/* *\/ */
-/* static inline void initRes (__mpz_struct *mpzp, size_t bytes) { */
-/* GC_intInf bp; */
+/*
+ * Initialize an __mpz_struct to use the space provided by the heap.
+ */
+void initIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
-/* assert (bytes <= (size_t)(gcState.limitPlusSlop - gcState.frontier)); */
-/* bp = (GC_intInf)gcState.frontier; */
-/* /\* We have as much space for the limbs as there is to the end */
-/* * of the heap. Divide by (sizeof(mp_limb_t)) to get number */
-/* * of limbs. */
-/* *\/ */
-/* mpzp->_mp_alloc = (gcState.limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t)); */
-/* mpzp->_mp_size = 0; /\* is this necessary? *\/ */
-/* mpzp->_mp_d = (mp_limb_t*)(bp->limbs); */
-/* } */
+ assert (bytes <= (size_t)(s->limitPlusSlop - s->frontier));
+ bp = (GC_intInf)s->frontier;
+ /* We have as much space for the limbs as there is to the end of the
+ * heap. Divide by (sizeof(mp_limb_t)) to get number of limbs.
+ */
+ res->_mp_alloc = (s->limitPlusSlop - (pointer)bp->limbs) / (sizeof(mp_limb_t));
+ res->_mp_d = (mp_limb_t*)(bp->limbs);
+ res->_mp_size = 0; /* is this necessary? */
+}
-/* /\* */
-/* * Count number of leading zeros. The argument will not be zero. */
-/* * This MUST be replaced with assembler. */
-/* *\/ */
-/* static inline uint leadingZeros (mp_limb_t word) { */
-/* uint res; */
+/*
+ * Given an __mpz_struct pointer which reflects the answer, set
+ * gcState.frontier and return the answer.
+ * If the answer fits in a fixnum, we return that, with the frontier
+ * rolled back.
+ * If the answer doesn't need all of the space allocated, we adjust
+ * the array size and roll the frontier slightly back.
+ */
+objptr finiIntInfRes (GC_state s, __mpz_struct *res, size_t bytes) {
+ GC_intInf bp;
+ mp_size_t size;
-/* assert(word != 0); */
-/* res = 0; */
-/* while ((int)word > 0) { */
-/* ++res; */
-/* word <<= 1; */
-/* } */
-/* return (res); */
-/* } */
+ assert ((res->_mp_size == 0)
+ or (res->_mp_d[(res->_mp_size < 0
+ ? - res->_mp_size
+ : res->_mp_size) - 1] != 0));
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "finiIntInfRes ("FMTPTR", %zu)\n",
+ (uintptr_t)res, bytes);
+ if (DEBUG_INT_INF_DETAILED)
+ fprintf (stderr, "res --> %s\n",
+ mpz_get_str (NULL, 10, res));
+ bp = (GC_intInf)((pointer)res->_mp_d - offsetof(struct GC_intInf, limbs));
+ assert (res->_mp_d == (mp_limb_t*)(bp->limbs));
+ size = res->_mp_size;
+ if (size < 0) {
+ bp->isneg = TRUE;
+ size = - size;
+ } else
+ bp->isneg = FALSE;
+ if (size <= 1) {
+ uintmax_t val, ans;
-/* static inline void setFrontier (pointer p, size_t bytes) { */
-/* p = GC_alignFrontier (&gcState, p); */
-/* assert ((size_t)(p - gcState.frontier) <= bytes); */
-/* GC_profileAllocInc (&gcState, p - gcState.frontier); */
-/* gcState.frontier = p; */
-/* assert (gcState.frontier <= gcState.limitPlusSlop); */
-/* } */
+ if (size == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (bp->isneg) {
+ /*
+ * We only fit if val in [1, 2^(CHAR_BIT * OBJPTR_SIZE - 2)].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^(CHAR_BIT * OBJPTR_SIZE - 2) - 1].
+ */
+ ans = val;
+ if (val < (uintmax_t)1<<(CHAR_BIT * OBJPTR_SIZE - 2)) {
+ return (objptr)(ans<<1 | 1);
+ }
+ }
+ setFrontier (s, (pointer)(&bp->limbs[size]), bytes);
+ bp->counter = 0;
+ bp->length = size + 1; /* +1 for isneg field */
+ bp->header = GC_INTINF_HEADER;
+ return pointerToObjptr ((pointer)&bp->isneg, s->heap.start);
+}
-/* /\* */
-/* * Given an __mpz_struct pointer which reflects the answer, set gcState.frontier */
-/* * and return the answer. */
-/* * If the answer fits in a fixnum, we return that, with the frontier */
-/* * rolled back. */
-/* * If the answer doesn't need all of the space allocated, we adjust */
-/* * the array size and roll the frontier slightly back. */
-/* *\/ */
-/* static pointer answer (__mpz_struct *ans, size_t bytes) { */
-/* GC_intInf bp; */
-/* int size; */
+static inline objptr binary (objptr lhs, objptr rhs, size_t bytes,
+ void(*binop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *lhsspace,
+ __gmp_const __mpz_struct *rhsspace)) {
+ __mpz_struct lhsmpz, rhsmpz, resmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ binop (&resmpz, &lhsmpz, &rhsmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* bp = (GC_intInf)((pointer)ans->_mp_d - offsetof(struct GC_intInf, limbs)); */
-/* assert(ans->_mp_d == (mp_limb_t*)(bp->limbs)); */
-/* size = ans->_mp_size; */
-/* if (size < 0) { */
-/* bp->isneg = TRUE; */
-/* size = - size; */
-/* } else */
-/* bp->isneg = FALSE; */
-/* if (size <= 1) { */
-/* uint val, */
-/* ans; */
+objptr IntInf_add (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_add ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_add);
+}
-/* if (size == 0) */
-/* val = 0; */
-/* else */
-/* val = bp->limbs[0]; */
-/* if (bp->isneg) { */
-/* /\* */
-/* * We only fit if val in [1, 2^30]. */
-/* *\/ */
-/* ans = - val; */
-/* val = val - 1; */
-/* } else */
-/* /\* */
-/* * We only fit if val in [0, 2^30 - 1]. */
-/* *\/ */
-/* ans = val; */
-/* if (val < (uint)1<<30) { */
-/* return (pointer)(ans<<1 | 1); */
-/* } */
-/* } */
-/* setFrontier ((pointer)(&bp->limbs[size]), bytes); */
-/* bp->counter = 0; */
-/* bp->length = size + 1; /\* +1 for isNeg word *\/ */
-/* bp->header = GC_intInfHeader (); */
-/* return (pointer)&bp->isneg; */
-/* } */
+objptr IntInf_andb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_andb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_and);
+}
-/* static inline pointer binary (pointer lhs, pointer rhs, size_t bytes, */
-/* void(*binop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *lhsspace, */
-/* __gmp_const __mpz_struct *rhsspace)) { */
-/* __mpz_struct lhsmpz, */
-/* rhsmpz, */
-/* resmpz; */
-/* mp_limb_t lhsspace[2], */
-/* rhsspace[2]; */
+objptr IntInf_gcd (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_gcd ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_gcd);
+}
-/* initRes (&resmpz, bytes); */
-/* fill (lhs, &lhsmpz, lhsspace); */
-/* fill (rhs, &rhsmpz, rhsspace); */
-/* binop (&resmpz, &lhsmpz, &rhsmpz); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_mul (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_mul ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_mul);
+}
-/* pointer IntInf_add (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_add ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_add); */
-/* } */
+objptr IntInf_quot (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_q);
+}
-/* pointer IntInf_gcd (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_gcd ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_gcd); */
-/* } */
+objptr IntInf_orb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_orb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_ior);
+}
-/* pointer IntInf_mul (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_mul ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_mul); */
-/* } */
+objptr IntInf_rem (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_quot ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_tdiv_r);
+}
-/* pointer IntInf_sub (pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_sub ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary (lhs, rhs, bytes, &mpz_sub); */
-/* } */
+objptr IntInf_sub (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_sub ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_sub);
+}
-/* pointer IntInf_andb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_andb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_and); */
-/* } */
+objptr IntInf_xorb (objptr lhs, objptr rhs, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_xorb ("FMTOBJPTR", "FMTOBJPTR", %zu)\n",
+ lhs, rhs, bytes);
+ return binary (lhs, rhs, bytes, &mpz_xor);
+}
-/* pointer IntInf_orb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_orb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_ior); */
-/* } */
+static objptr unary (objptr arg, size_t bytes,
+ void(*unop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace)) {
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-/* pointer IntInf_xorb(pointer lhs, pointer rhs, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_xorb ("FMTPTR", "FMTPTR", %zu)\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs, bytes); */
-/* return binary(lhs, rhs, bytes, &mpz_xor); */
-/* } */
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ unop (&resmpz, &argmpz);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* static pointer */
-/* unary(pointer arg, size_t bytes, */
-/* void(*unop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *argspace)) */
-/* { */
-/* __mpz_struct argmpz, */
-/* resmpz; */
-/* mp_limb_t argspace[2]; */
+objptr IntInf_neg (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_neg ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_neg);
+}
-/* initRes(&resmpz, bytes); */
-/* fill(arg, &argmpz, argspace); */
-/* unop(&resmpz, &argmpz); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_notb (objptr arg, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_notb ("FMTOBJPTR", %zu)\n",
+ arg, bytes);
+ return unary (arg, bytes, &mpz_com);
+}
-/* pointer IntInf_neg(pointer arg, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_neg ("FMTPTR", %zu)\n", */
-/* (uintptr_t)arg, bytes); */
-/* return unary(arg, bytes, &mpz_neg); */
-/* } */
+static objptr shary (objptr arg, uint32_t shift, size_t bytes,
+ void(*shop)(__mpz_struct *resmpz,
+ __gmp_const __mpz_struct *argspace,
+ unsigned long shift))
+{
+ __mpz_struct argmpz, resmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
-/* pointer IntInf_notb(pointer arg, size_t bytes) { */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_notb ("FMTPTR", %zu)\n", */
-/* (uintptr_t)arg, bytes); */
-/* return unary(arg, bytes, &mpz_com); */
-/* } */
+ initIntInfRes (&gcState, &resmpz, bytes);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ shop (&resmpz, &argmpz, (unsigned long)shift);
+ return finiIntInfRes (&gcState, &resmpz, bytes);
+}
-/* static pointer */
-/* shary(pointer arg, uint shift, size_t bytes, */
-/* void(*shop)(__mpz_struct *resmpz, */
-/* __gmp_const __mpz_struct *argspace, */
-/* unsigned long shift)) */
-/* { */
-/* __mpz_struct argmpz, */
-/* resmpz; */
-/* mp_limb_t argspace[2]; */
+objptr IntInf_arshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_arshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary (arg, shift, bytes, &mpz_fdiv_q_2exp);
+}
-/* initRes(&resmpz, bytes); */
-/* fill(arg, &argmpz, argspace); */
-/* shop(&resmpz, &argmpz, (unsigned long)shift); */
-/* return answer (&resmpz, bytes); */
-/* } */
+objptr IntInf_lshift (objptr arg, uint32_t shift, size_t bytes) {
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_lshift ("FMTOBJPTR", %"PRIu32", %zu)\n",
+ arg, shift, bytes);
+ return shary(arg, shift, bytes, &mpz_mul_2exp);
+}
-/* pointer IntInf_arshift(pointer arg, Word shift_w, size_t bytes) { */
-/* uint shift = (uint)shift_w; */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_arshift ("FMTPTR", %u, %zu)\n", */
-/* (uintptr_t)arg, shift, bytes); */
-/* return shary(arg, shift, bytes, &mpz_fdiv_q_2exp); */
-/* } */
+/*
+ * Return an integer which compares to 0 as the two intInf args compare
+ * to each other.
+ */
+Int32_t IntInf_compare (objptr lhs, objptr rhs) {
+ __mpz_struct lhsmpz, rhsmpz;
+ mp_limb_t lhsspace[LIMBS_PER_OBJPTR + 1], rhsspace[LIMBS_PER_OBJPTR + 1];
+ int res;
-/* pointer IntInf_lshift(pointer arg, Word shift_w, size_t bytes) { */
-/* uint shift = (uint)shift_w; */
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_lshift ("FMTPTR", %u, %zu)\n", */
-/* (uintptr_t)arg, shift, bytes); */
-/* return shary(arg, shift, bytes, &mpz_mul_2exp); */
-/* } */
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_compare ("FMTOBJPTR", "FMTOBJPTR")\n",
+ lhs, rhs);
+ fillIntInfArg (&gcState, lhs, &lhsmpz, lhsspace);
+ fillIntInfArg (&gcState, rhs, &rhsmpz, rhsspace);
+ res = mpz_cmp (&lhsmpz, &rhsmpz);
+ if (res < 0) return -1;
+ if (res > 0) return 1;
+ return 0;
+}
-/* Word */
-/* IntInf_smallMul(Word lhs, Word rhs, pointer carry) */
-/* { */
-/* intmax_t prod; */
+/*
+ * Check if two IntInf.int's are equal.
+ */
+Bool_t IntInf_equal (objptr lhs, objptr rhs) {
+ if (lhs == rhs)
+ return TRUE;
+ if (isEitherSmall (lhs, rhs))
+ return FALSE;
+ else
+ return 0 == IntInf_compare (lhs, rhs);
+}
-/* prod = (intmax_t)(int)lhs * (int)rhs; */
-/* *(uint *)carry = (uintmax_t)prod >> 32; */
-/* return ((uint)(uintmax_t)prod); */
-/* } */
+/*
+ * Convert an intInf to a string.
+ * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and
+ * space is a string (mutable) which is large enough.
+ */
+objptr IntInf_toString (objptr arg, int32_t base, size_t bytes) {
+ GC_string8 sp;
+ __mpz_struct argmpz;
+ mp_limb_t argspace[LIMBS_PER_OBJPTR + 1];
+ char *str;
+ size_t size;
-/* /\* */
-/* * Return an integer which compares to 0 as the two intInf args compare */
-/* * to each other. */
-/* *\/ */
-/* Int IntInf_compare (pointer lhs, pointer rhs) { */
-/* __mpz_struct lhsmpz, */
-/* rhsmpz; */
-/* mp_limb_t lhsspace[2], */
-/* rhsspace[2]; */
+ if (DEBUG_INT_INF)
+ fprintf (stderr, "IntInf_toString ("FMTOBJPTR", %"PRId32", %zu)\n",
+ arg, base, bytes);
+ assert (base == 2 || base == 8 || base == 10 || base == 16);
+ fillIntInfArg (&gcState, arg, &argmpz, argspace);
+ sp = (GC_string8)gcState.frontier;
+ str = mpz_get_str(sp->chars, base, &argmpz);
+ assert (str == sp->chars);
+ size = strlen(str);
+ if (*sp->chars == '-')
+ *sp->chars = '~';
+ if (base > 0)
+ for (unsigned int i = 0; i < size; i++) {
+ char c = sp->chars[i];
+ if (('a' <= c) && (c <= 'z'))
+ sp->chars[i] = c + ('A' - 'a');
+ }
+ setFrontier (&gcState, (pointer)(&sp->chars[size]), bytes);
+ sp->counter = 0;
+ sp->length = size;
+ sp->header = GC_STRING8_HEADER;
+ return pointerToObjptr ((pointer)&sp->chars, gcState.heap.start);
+}
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_compare ("FMTPTR", "FMTPTR")\n", */
-/* (uintptr_t)lhs, (uintptr_t)rhs); */
-/* fill (lhs, &lhsmpz, lhsspace); */
-/* fill (rhs, &rhsmpz, rhsspace); */
-/* return mpz_cmp (&lhsmpz, &rhsmpz); */
-/* } */
+Word32_t
+IntInf_smallMul(Word32_t lhs, Word32_t rhs, Ref(Word32_t) carry) {
+ intmax_t prod;
-/* /\* */
-/* * Check if two IntInf.int's are equal. */
-/* *\/ */
-/* Bool IntInf_equal (pointer lhs, pointer rhs) { */
-/* if (lhs == rhs) */
-/* return TRUE; */
-/* if (eitherIsSmall (lhs, rhs)) */
-/* return FALSE; */
-/* else */
-/* return 0 == IntInf_compare (lhs, rhs); */
-/* } */
-
-/* /\* */
-/* * Convert an intInf to a string. */
-/* * Arg is an intInf, base is the base to use (2, 8, 10 or 16) and space is a */
-/* * string (mutable) which is large enough. */
-/* *\/ */
-/* pointer IntInf_toString (pointer arg, int base, size_t bytes) { */
-/* GC_string sp; */
-/* __mpz_struct argmpz; */
-/* mp_limb_t argspace[2]; */
-/* char *str; */
-/* uint size; */
-/* uint i; */
-/* char c; */
-
-/* if (DEBUG_INT_INF) */
-/* fprintf (stderr, "IntInf_toString ("FMTPTR", %d, %zu)\n", */
-/* (uintptr_t)arg, base, bytes); */
-/* assert (base == 2 || base == 8 || base == 10 || base == 16); */
-/* fill (arg, &argmpz, argspace); */
-/* sp = (GC_string)gcState.frontier; */
-/* str = mpz_get_str(sp->chars, base, &argmpz); */
-/* assert(str == sp->chars); */
-/* size = strlen(str); */
-/* if (*sp->chars == '-') */
-/* *sp->chars = '~'; */
-/* if (base > 0) */
-/* for (i = 0; i < size; i++) { */
-/* c = sp->chars[i]; */
-/* if (('a' <= c) && (c <= 'z')) */
-/* sp->chars[i] = c + ('A' - 'a'); */
-/* } */
-/* sp->counter = 0; */
-/* sp->length = size; */
-/* sp->header = GC_stringHeader (); */
-/* setFrontier ((pointer)(&sp->chars[align(size, 4)]), bytes); */
-/* return (pointer)str; */
-/* } */
-
-/* /\* */
-/* * Quotient (round towards 0, remainder is returned by IntInf_rem). */
-/* * space is a word array with enough space for the quotient */
-/* * num limbs + 1 - den limbs */
-/* * shifted numerator */
-/* * num limbs + 1 */
-/* * and shifted denominator */
-/* * den limbs */
-/* * and the isNeg word. */
-/* * It must be the last thing allocated. */
-/* * num is the numerator bignum, den is the denominator and frontier is */
-/* * the current frontier. */
-/* *\/ */
-/* pointer IntInf_quot (pointer num, pointer den, size_t bytes) { */
-/* __mpz_struct resmpz, */
-/* nmpz, */
-/* dmpz; */
-/* mp_limb_t nss[2], */
-/* dss[2], */
-/* carry, */
-/* *np, */
-/* *dp; */
-/* int nsize, */
-/* dsize, */
-/* qsize; */
-/* bool resIsNeg; */
-/* uint shift; */
-
-/* initRes(&resmpz, bytes); */
-/* fill(num, &nmpz, nss); */
-/* resIsNeg = FALSE; */
-/* nsize = nmpz._mp_size; */
-/* if (nsize < 0) { */
-/* nsize = - nsize; */
-/* resIsNeg = TRUE; */
-/* } */
-/* fill(den, &dmpz, dss); */
-/* dsize = dmpz._mp_size; */
-/* if (dsize < 0) { */
-/* dsize = - dsize; */
-/* resIsNeg = not resIsNeg; */
-/* } */
-/* assert(dsize != 0 && dmpz._mp_d[dsize - 1] != 0); */
-/* assert((nsize == 0 && dsize == 1) */
-/* or (nsize >= dsize && nmpz._mp_d[nsize - 1] != 0)); */
-/* qsize = 1 + nsize - dsize; */
-/* if (dsize == 1) { */
-/* if (nsize == 0) */
-/* return (pointer)1; /\* tagged 0 *\/ */
-/* mpn_divrem_1(resmpz._mp_d, */
-/* (mp_size_t)0, */
-/* nmpz._mp_d, */
-/* nsize, */
-/* dmpz._mp_d[0]); */
-/* if (resmpz._mp_d[qsize - 1] == 0) */
-/* --qsize; */
-/* } else { */
-/* np = &resmpz._mp_d[qsize]; */
-/* shift = leadingZeros(dmpz._mp_d[dsize - 1]); */
-/* if (shift == 0) { */
-/* dp = dmpz._mp_d; */
-/* memcpy((void *)np, */
-/* nmpz._mp_d, */
-/* nsize * sizeof(*nmpz._mp_d)); */
-/* } else { */
-/* carry = mpn_lshift(np, nmpz._mp_d, nsize, shift); */
-/* unless (carry == 0) */
-/* np[nsize++] = carry; */
-/* dp = &np[nsize]; */
-/* mpn_lshift(dp, dmpz._mp_d, dsize, shift); */
-/* } */
-/* carry = mpn_divrem(resmpz._mp_d, */
-/* (mp_size_t)0, */
-/* np, */
-/* nsize, */
-/* dp, */
-/* dsize); */
-/* qsize = nsize - dsize; */
-/* if (carry != 0) */
-/* resmpz._mp_d[qsize++] = carry; */
-/* } */
-/* resmpz._mp_size = resIsNeg ? - qsize : qsize; */
-/* return answer (&resmpz, bytes); */
-/* } */
-
-
-/* /\* */
-/* * Remainder (sign taken from numerator, quotient is returned by IntInf_quot). */
-/* * space is a word array with enough space for the remainder */
-/* * den limbs */
-/* * shifted numerator */
-/* * num limbs + 1 */
-/* * and shifted denominator */
-/* * den limbs */
-/* * and the isNeg word. */
-/* * It must be the last thing allocated. */
-/* * num is the numerator bignum, den is the denominator and frontier is */
-/* * the current frontier. */
-/* *\/ */
-/* pointer IntInf_rem (pointer num, pointer den, size_t bytes) { */
-/* __mpz_struct resmpz, */
-/* nmpz, */
-/* dmpz; */
-/* mp_limb_t ...
[truncated message content] |
