[MLton-commit] r4369
Matthew Fluet
MLton@mlton.org
Fri, 3 Mar 2006 10:51:46 -0800
Refactored int/word/int-inf implementations to be robust against
changes in defaults and primitive sizes.
Doing the same thing for Char/String would be the "RightThing(tm)",
but since the Basis Library specifies that Char is necessarily Char8,
doesn't seem worth it.
----------------------------------------------------------------------
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/config/bind-for-choose.sml
U 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/bind-for-config2.sml
A mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config3.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-inf.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/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
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/integer/word1.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/primitive/primitive.mlb
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
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string0.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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-03-03 18:51:40 UTC (rev 4369)
@@ -92,10 +92,13 @@
../integer/int.sml
../integer/word.sig
../integer/word.sml
+ local ../config/bind-for-config1.sml in ann "forceUsed" in
+ ../config/objptr/$(OBJPTR_REP)
+ ../config/c/misc/$(CTYPES)
+ end end
../integer/int-inf.sig
-(*
../integer/int-inf.sml
- local in ann "forceUsed" in
+ local ../config/bind-for-config2.sml in ann "forceUsed" in
../config/default/$(DEFAULT_INT)
../config/default/$(DEFAULT_WORD)
../config/default/large-int.sml
@@ -103,15 +106,19 @@
end end
../integer/int-global.sml
../integer/word-global.sml
+ ../top-level/arithmetic.sml
+
+(*
../text/char.sig
../text/char.sml
../text/substring.sig
../text/substring.sml
../text/string.sig
../text/string.sml
-*)
+ local ../config/bind-for-config3.sml in ann "forceUsed" in
+ ../config/default/$(DEFAULT_CHAR)
+ end end
-(*
../../misc/C.sig
../../misc/C.sml
../../real/IEEE-real.sig
@@ -136,7 +143,6 @@
../../config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml
end
- ../../top-level/arithmetic.sml
(* misc/unique-id.sig *)
(* misc/unique-id.fun *)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-choose.sml (from rev 4348, 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 15:30:17 UTC (rev 4348)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-choose.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -0,0 +1,28 @@
+(* 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 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
Modified: 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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -13,7 +13,7 @@
structure Int16 = Int16
structure Int32 = Int32
structure Int64 = Int64
-structure IntInf = IntInf
+structure IntInf = Primitive.IntInf
structure Pointer = Primitive.Pointer
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config2.sml (from rev 4348, mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config1.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config3.sml (from rev 4348, 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 15:30:17 UTC (rev 4348)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/bind-for-config3.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -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 = 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 = String8
+structure String16 = Primitive.String16
+structure String32 = Primitive.String32
+
+structure Word8 = Word8
+structure Word16 = Word16
+structure Word32 = Word32
+structure Word64 = Word64
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/general/general.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -14,13 +14,13 @@
exception Bind = Bind
exception Match = Match
exception Chr
- exception Div
- exception Domain
+ exception Div = Div
+ exception Domain = Domain
exception Fail of string
exception Overflow = Overflow
exception Size = Size
exception Span
- exception Subscript
+ exception Subscript = Subscript
datatype order = datatype Primitive.Order.order
Modified: 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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -6,627 +6,113 @@
* 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)
+ open Primitive.IntInf
- (* 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
+ structure BigWord = C_MPLimb
+ structure SmallInt = ObjptrInt
- 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)))
+ structure W = ObjptrWord
+ structure I = ObjptrInt
+ structure MPLimb = C_MPLimb
- (*
- * 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)
+ val precision: Int.int option = NONE
- (*
- * 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)
+ fun sign (arg: int): Int.int =
+ if Prim.isSmall arg
+ then I.sign (Prim.dropTagCoerceInt arg)
+ else if isNeg arg
+ then ~1
+ else 1
- (*
- * 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
+ fun sameSign (x, y) = sign x = sign y
- (*
- * 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
+ local
+ val maxShift32 = 0w128
+ val maxShift = Word32.toWord maxShift32
+ fun make f (arg, shift) =
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
+ fun loop (arg, shift) =
+ if Word.<= (shift, maxShift)
+ then f (arg, Word32.fromWord shift)
+ else loop (f (arg, maxShift32),
+ Word.- (shift, maxShift))
in
- if Int64.>= (i, 0)
- then doit (i, 0w0)
- else
- if i = valOf Int64.minInt
- then ~0x8000000000000000
- else doit (Int64.~? i, 0w1)
+ loop (arg, shift)
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
-
-
- 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 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
-
- (*
- * 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 <)
+ val << = make <<
+ val ~>> = make ~>>
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}
+ val binCvt = mkCvt {base = 2, smallCvt = I.fmt BIN}
+ val octCvt = mkCvt {base = 8, smallCvt = I.fmt OCT}
+ val decCvt = mkCvt {base = 10, smallCvt = I.fmt DEC}
+ val hexCvt = mkCvt {base = 16, smallCvt = I.fmt HEX}
in
- val bigToString = cvt {base = 10,
- dpc = 0w10,
- smallCvt = Int.toString}
- fun bigFmt radix =
+ fun fmt radix =
case radix of
BIN => binCvt
| OCT => octCvt
- | DEC => bigToString
+ | DEC => decCvt
| HEX => hexCvt
+ val toString = fmt DEC
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 =
+ fun binDig (ch: char): W.word option =
case ch of
#"0" => SOME 0w0
| #"1" => SOME 0w1
| _ => NONE
local
- val op <= = Char.<=
+ val op <= = PreChar.<=
in
- fun octDig (ch: char): Word.word option =
+ fun octDig (ch: char): W.word option =
if #"0" <= ch andalso ch <= #"7"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
+ then SOME (W.fromInt (Int.- (PreChar.ord ch,
+ PreChar.ord #"0")))
else NONE
- fun decDig (ch: char): Word.word option =
+ fun decDig (ch: char): W.word option =
if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
+ then SOME (W.fromInt (Int.- (PreChar.ord ch,
+ PreChar.ord #"0")))
else NONE
- fun hexDig (ch: char): Word.word option =
+ fun hexDig (ch: char): W.word option =
if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
+ then SOME (W.fromInt (Int.- (PreChar.ord ch,
+ PreChar.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
+ then SOME (W.fromInt (Int.- (PreChar.ord ch,
+ Int.- (PreChar.ord #"a", 0xa))))
+ else if #"A" <= ch andalso ch <= #"F"
+ then SOME (W.fromInt (Int.- (PreChar.ord ch,
+ Int.- (PreChar.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,
+ fun toDigR (charToDig: char -> W.word option,
cread: (char, 'a) reader)
- (s: 'a)
- : (Word.word * 'a) option =
+ (s: 'a)
+ : (W.word * 'a) option =
case cread s of
NONE => NONE
| SOME (ch, s') =>
@@ -640,87 +126,83 @@
* 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
- }
-
+ type chunk = {more: bool,
+ shift: W.word,
+ chunk: W.word}
(*
- * Given the base, the number of digits per chunk,
- * a char reader and a digit reader, return a chunk reader.
+ * Given the base 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
+ fun toChunkR (base: W.word,
+ dread: (W.word, 'a) reader)
+ : (chunk, 'a) reader =
+ let
+ fun loop {left: Int32.int,
+ shift: W.word,
+ chunk: W.word,
+ s: 'a}
+ : chunk * 'a =
+ if Int32.<= (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 = Int32.- (left, 1),
+ shift = W.* (base, shift),
+ chunk = W.+ (W.* (base, chunk), dig),
+ s = s'}
+ val digitsPerChunk =
+ Int32.div (Int32.- (Int32.fromInt W.wordSize, 2), W.log2 base)
+ fun reader (s: 'a): (chunk * 'a) option =
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
+ NONE => NONE
+ | SOME (dig, next) =>
+ SOME (loop {left = Int32.- (digitsPerChunk, 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
+ fun toUnsR (ckread: (chunk, 'a) reader): (int, 'a) reader =
+ let
+ fun loop (more: bool, acc: int, s: 'a) =
+ if more
+ then case ckread s of
+ NONE => (acc, s)
+ | SOME ({more, shift, chunk}, s') =>
+ loop (more,
+ ((Prim.addTagCoerce shift) * acc)
+ + (Prim.addTagCoerce chunk),
+ s')
+ else (acc, s)
+ fun reader (s: 'a): (int * 'a) option =
+ case ckread s of
+ NONE => NONE
+ | SOME ({more, chunk, ...}, s') =>
+ SOME (loop (more,
+ Prim.addTagCoerce 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 =
+ fun toHexR (cread: (char, 'a) reader, uread: (int, 'a) reader) s =
case cread s of
NONE => NONE
| SOME (c1, s1) =>
@@ -732,77 +214,66 @@
case uread s2 of
NONE => SOME (zero, s1)
| SOME x => SOME x
- else uread s
- else uread s
+ 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 =
+ fun toSign (cread: (char, 'a) reader, uread: (int, 'a) reader)
+ : (int, 'a) reader =
let
- fun reader (s: 'a): (bigInt * 'a) option =
+ fun reader (s: 'a): (int * '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
+ if PreChar.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 (~ abs, s''')
+ else uread s''
+ end
in
reader
end
(*
* Base-specific conversions from char readers to
- * bigInt readers.
+ * int 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)
+ fun reader (base, dig)
+ (cread: (char, 'a) reader)
+ : (int, 'a) reader =
+ let
+ val dread = toDigR (dig, cread)
+ val ckread = toChunkR (base, dread)
val uread = toUnsR ckread
val hread =
if base = 0w16 then toHexR (cread, uread) else uread
val reader = toSign (cread, hread)
- in reader
+ 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
+ fun binReader z = reader (0w2, binDig) z
+ fun octReader z = reader (0w8, octDig) z
+ fun decReader z = reader (0w10, decDig) z
+ fun hexReader z = reader (0w16, 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 =
+ fun scan radix =
case radix of
BIN => binReader
| OCT => octReader
@@ -810,11 +281,13 @@
| HEX => hexReader
end
+ val fromString = StringCvt.scanString (scan StringCvt.DEC)
+
local
- fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
+ fun isEven (n: Int.int) = Int.andb (n, 0x1) = 0
in
- fun pow (i: bigInt, j: int): bigInt =
- if j < 0 then
+ fun pow (i: int, j: Int.int): int =
+ if Int.< (j, 0) then
if i = zero then
raise Div
else
@@ -825,188 +298,26 @@
if j = 0 then one
else
let
- fun square (n: bigInt): bigInt = bigMul (n, n)
+ fun square (n: int): int = n * n
(* pow (j) returns (i ^ j) *)
- fun pow (j: int): bigInt =
- if j <= 0 then one
+ fun pow (j: Int.int): int =
+ if Int.<= (j, 0) then one
else if isEven j then evenPow j
- else bigMul (i, evenPow (j - 1))
+ else i * evenPow (Int.- (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)
+ and evenPow (j: Int.int): int =
+ square (pow (Int.~>> (j, 0w1)))
+ 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
+ val log2 =
+ mkLog2 {fromSmall = fn {smallLog2} => Int32.toInt smallLog2,
+ fromLarge = fn {numLimbsMinusOne, mostSigLimbLog2} =>
+ Int.+ (Int.* (MPLimb.wordSize, SeqIndex.toInt numLimbsMinusOne),
+ Int32.toInt mostSigLimbLog2)}
- 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
+ val isSmall = Prim.isSmall
+ val areSmall = Prim.areSmall
end
-
-structure LargeInt = IntInf
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int-inf0.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -15,14 +15,29 @@
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 negOne: int
+ structure Prim :
+ sig
+ val isSmall: int -> bool
+ val areSmall: int * int -> bool
+ val dropTag: ObjptrWord.word -> ObjptrWord.word
+ val dropTagCoerce: int -> ObjptrWord.word
+ val dropTagCoerceInt: int -> ObjptrInt.int
+ val addTag: ObjptrWord.word -> ObjptrWord.word
+ val addTagCoerce: ObjptrWord.word -> int
+ val addTagCoerceInt: ObjptrInt.int -> int
+ val zeroTag: ObjptrWord.word -> ObjptrWord.word
+ val oneTag: ObjptrWord.word -> ObjptrWord.word
+ val oneTagCoerce: ObjptrWord.word -> int
+ end
+
val abs: int -> int
val +? : int * int -> int
val + : int * int -> int
@@ -51,7 +66,8 @@
val leu: int * int -> bool
val gtu: int * int -> bool
val geu: int * int -> bool
-
+ val isNeg: int -> bool
+
val andb: int * int -> int
val << : int * Primitive.Word32.word -> int
val notb: int -> int
@@ -59,7 +75,13 @@
val ~>> : int * Primitive.Word32.word -> int
val xorb: int * int -> int
- val toString8: int -> Primitive.String8.string
+ val mkCvt: ({base: Primitive.Int32.int,
+ smallCvt: ObjptrInt.int -> Primitive.String8.string}
+ -> int -> Primitive.String8.string)
+ val mkLog2: ({fromSmall: {smallLog2: Primitive.Int32.int} -> 'a,
+ fromLarge: {mostSigLimbLog2: Primitive.Int32.int,
+ numLimbsMinusOne: SeqIndex.int} -> 'a}
+ -> int -> 'a)
(* Sign extend. *)
val fromInt8Unsafe: Primitive.Int8.int -> int
@@ -149,7 +171,6 @@
structure A = Primitive.Array
structure V = Primitive.Vector
structure S = SeqIndex
-
structure W = struct
open ObjptrWord
local
@@ -186,7 +207,6 @@
val toObjptrIntX = S.f
end
end
-
structure I = ObjptrInt
structure MPLimb = C_MPLimb
structure Sz = struct
@@ -586,13 +606,13 @@
* 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
val negBadIntInf: bigInt = fromObjptrInt (I.~ badObjptrInt)
- (* Given two ObjptrWord.word's, check if they have the same `high'/'sign' bit.
+ (* 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.toObjptrIntX (W.xorb (lhs, rhs)), 0)
@@ -707,9 +727,9 @@
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) =
+ fun smallGcd (a, b, acc) =
case (a, b) of
(0, _) => b * acc
| (_, 0) => a * acc
@@ -728,27 +748,27 @@
if 0 = a_r2
then
if 0 = b_r2
- then gcdInt (a_2, b_2, acc + acc)
- else gcdInt (a_2, b, acc)
+ then smallGcd (a_2, b_2, acc + acc)
+ else smallGcd (a_2, b, acc)
else
if 0 = b_r2
- then gcdInt (a, b_2, acc)
+ then smallGcd (a, b_2, acc)
else
if a >= b
- then gcdInt (div2 (a - b), b, acc)
- else gcdInt (a, div2 (b - a), acc)
+ then smallGcd (div2 (a - b), b, acc)
+ else smallGcd (a, div2 (b - a), acc)
end
in
fun bigGcd (lhs: bigInt, rhs: bigInt): bigInt =
if areSmall (lhs, rhs)
- then addTagCoerceInt (gcdInt (I.abs (dropTagCoerceInt lhs),
- I.abs (dropTagCoerceInt rhs),
- 1))
- else Prim.gcd (lhs, rhs,
- reserve (S.max (numLimbs lhs, numLimbs rhs), 0))
+ then addTagCoerceInt
+ (smallGcd (I.abs (dropTagCoerceInt lhs),
+ I.abs (dropTagCoerceInt rhs),
+ 1))
+ else Prim.gcd
+ (lhs, rhs, reserve (S.max (numLimbs lhs, numLimbs rhs), 0))
end
-
fun bigCompare (lhs: bigInt, rhs: bigInt): order =
if areSmall (lhs, rhs)
then I.compare (W.toObjptrIntX (Prim.toWord lhs),
@@ -790,18 +810,6 @@
fun bigMax (lhs: bigInt, rhs: bigInt): bigInt =
if bigLE (lhs, rhs) then rhs else lhs
-(*
- fun bigSign' (arg: bigInt): Int32.int =
- if isSmall arg
- then I.sign' (dropTagCoerceInt arg)
- else if bigIsNeg arg
- then ~1
- else 1
-
- fun bigSameSign (lhs: bigInt, rhs: bigInt): bool =
- bigSign' lhs = bigSign' rhs
-*)
-
local
fun bigLTU (lhs, rhs) =
case (bigCompare (lhs, 0), bigCompare (rhs, 0)) of
@@ -903,18 +911,72 @@
reserve (S.max (1, S.- (numLimbs arg, shiftSize shift)), 0))
end
- fun bigToString8 (arg: bigInt): String8.string =
- Prim.toString
- (arg, 10, Sz.+ (bytesPerArrayHeader (* Array Header *),
- Sz.+ (0w2, (* sign *)
- Sz.* (0w10, Sz.fromSeqIndex (numLimbs arg)))))
+ fun mkBigCvt {base: Int32.int,
+ smallCvt: I.int -> Primitive.String8.string}
+ (arg: bigInt)
+ : Primitive.String8.string =
+ if isSmall arg
+ then smallCvt (dropTagCoerceInt arg)
+ else let
+ val bpd = Word32.log2 (Word32.fromInt32 base)
+ val bpl = MPLimb.wordSize
+ val dpl =
+ Int32.+ (Int32.quot (bpl, bpd),
+ if Int32.mod (bpl, bpd) = 0
+ then 0 else 1)
+ in
+ Prim.toString
+ (arg, base,
+ Sz.+ (Sz.+ (bytesPerArrayHeader (* Array Header *),
+ 0w1 (* sign *)),
+ Sz.* (Sz.fromInt32 dpl,
+ Sz.fromSeqIndex (numLimbs arg))))
+ end
+ fun mkBigLog2 {fromSmall: {smallLog2: Primitive.Int32.int} -> 'a,
+ fromLarge: {numLimbsMinusOne: SeqIndex.int,
+ mostSigLimbLog2: Primitive.Int32.int} -> 'a}
+ (arg: bigInt) =
+ if bigLE (arg, 0)
+ then raise Domain
+ else if isSmall arg
+ then fromSmall {smallLog2 = W.log2 (dropTagCoerce arg)}
+ else let
+ val v = Prim.toVector arg
+ val n = V.length v
+ val w = MPLimb.log2 (V.subUnsafe (v, S.- (n, 1)))
+ in
+ fromLarge {numLimbsMinusOne = S.- (n, 2),
+ mostSigLimbLog2 = w}
+ end
+
type int = bigInt
type t = int
val maxInt = NONE
val minInt = NONE
+
+ structure Prim =
+ struct
+ val isSmall = isSmall
+ val areSmall = areSmall
+ val dropTag = dropTag
+ val dropTagCoerce = dropTagCoerce
+ val dropTagCoerceInt = dropTagCoerceInt
+ val addTag = addTag
+ val addTagCoerce = addTagCoerce
+ val addTagCoerceInt = addTagCoerceInt
+ val zeroTag = zeroTag
+ val oneTag = oneTag
+ val oneTagCoerce = oneTagCoerce
+ val numLimbs = numLimbs
+ val bytesPerArrayHeader = bytesPerArrayHeader
+ val reserve = reserve
+
+ val toString = Prim.toString
+ end
+
val abs = bigAbs
val op +? = bigAdd
val op + = bigAdd
@@ -943,6 +1005,7 @@
val leu = bigLEU
val gtu = bigGTU
val geu = bigGEU
+ val isNeg = bigIsNeg
val andb = bigAndb
val << = bigLshift
@@ -951,7 +1014,8 @@
val ~>> = bigRashift
val xorb = bigXorb
- val toString8 = bigToString8
+ val mkCvt = mkBigCvt
+ val mkLog2 = mkBigLog2
end
structure Char8 =
@@ -1046,366 +1110,3 @@
end
end
-
-(*
-(*
- * IntInf.int's either have a bottom bit of 1, in which case the top 31
- * bits are the signed integer, or else the bottom bit is 0, in which case
- * they point to an vector of Word.word's. The first word is either 0,
- * indicating that the number is positive, or 1, indicating that it is
- * negative. The rest of the vector contains the `limbs' (big digits) of
- * the absolute value of the number, from least to most significant.
- *)
-structure IntInf: INT_INF_EXTRA =
- struct
-
- (*
- * bigInt toString and fmt.
- * dpc is the maximum number of digits per `limb'.
- *)
- local
- open StringCvt
-
- fun cvt {base: smallInt,
- dpc: word,
- smallCvt: smallInt -> string}
- (arg: bigInt)
- : string =
- if isSmall arg
- then smallCvt (Word.toIntX (stripTag arg))
- else Prim.toString (arg, base,
- Word.+
- (reserve (0, 0),
- Word.+ (0w2, (* sign character *)
- Word.* (dpc,
- Word.fromInt (bigSize arg)))))
- val binCvt = cvt {base = 2, dpc = 0w32, smallCvt = Int.fmt BIN}
- val octCvt = cvt {base = 8, dpc = 0w11, smallCvt = Int.fmt OCT}
- val hexCvt = cvt {base = 16, dpc = 0w8, smallCvt = Int.fmt HEX}
- in
- val bigToString = cvt {base = 10,
- dpc = 0w10,
- smallCvt = Int.toString}
- fun bigFmt radix =
- case radix of
- BIN => binCvt
- | OCT => octCvt
- | DEC => bigToString
- | HEX => hexCvt
- end
-
- (*
- * bigInt scan and fromString.
- *)
- local
- open StringCvt
-
- (*
- * We use Word.word to store chunks of digits.
- * smallToInf converts such a word to a fixnum bigInt.
- * Thus, it can only represent values in [- 2^30, 2^30).
- *)
- fun smallToBig (arg: Word.word): bigInt =
- Prim.fromWord (addTag arg)
-
-
- (*
- * Given a char, if it is a digit in the appropriate base,
- * convert it to a word. Otherwise, return NONE.
- * Note, both a-f and A-F are accepted as hexadecimal digits.
- *)
- fun binDig (ch: char): Word.word option =
- case ch of
- #"0" => SOME 0w0
- | #"1" => SOME 0w1
- | _ => NONE
-
- local
- val op <= = Char.<=
- in
- fun octDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"7"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else NONE
-
- fun decDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else NONE
-
- fun hexDig (ch: char): Word.word option =
- if #"0" <= ch andalso ch <= #"9"
- then SOME (Word.fromInt (ord ch -? ord #"0"))
- else if #"a" <= ch andalso ch <= #"f"
- then SOME (Word.fromInt (ord ch -? (ord #"a" - 0xa)))
- else if #"A" <= ch andalso ch <= #"F"
- then SOME (Word.fromInt
- (ord ch -? (ord #"A" - 0xA)))
- else
- NONE
- end
-
- (*
- * Given a digit converter and a char reader, return a digit
- * reader.
- *)
- fun toDigR (charToDig: char -> Word.word option,
- cread: (char, 'a) reader)
- (s: 'a)
- : (Word.word * 'a) option =
- case cread s of
- NONE => NONE
- | SOME (ch, s') =>
- case charToDig ch of
- NONE => NONE
- | SOME dig => SOME (dig, s')
-
- (*
- * A chunk represents the result of processing some digits.
- * more is a bool indicating if there might be more digits.
- * shift is base raised to the number-of-digits-seen power.
- * chunk is the value of the digits seen.
- *)
- type chunk = {
- more: bool,
- shift: Word.word,
- chunk: Word.word
- }
-
- (*
- * Given the base, the number of digits per chunk,
- * a char reader and a digit reader, return a chunk reader.
- *)
- fun toChunkR (base: Word.word,
- dpc: smallInt,
- dread: (Word.word, 'a) reader)
- : (chunk, 'a) reader =
- let fun loop {left: smallInt,
- shift: Word.word,
- chunk: Word.word,
- s: 'a}
- : chunk * 'a =
- if left <= 0
- then ({more = true,
- shift = shift,
- chunk = chunk },
- s)
- else
- case dread s of
- NONE => ({more = false,
- shift = shift,
- chunk = chunk},
- s)
- | SOME (dig, s') =>
- loop {
- left = left - 1,
- shift = Word.* (base, shift),
- chunk = Word.+ (Word.* (base,
- chunk),
- dig),
- s = s'
- }
- fun reader (s: 'a): (chunk * 'a) option =
- case dread s of
- NONE => NONE
- | SOME (dig, next) =>
- SOME (loop {left = dpc - 1,
- shift = base,
- chunk = dig,
- s = next})
- in reader
- end
-
- (*
- * Given a chunk reader, return an unsigned reader.
- *)
- fun toUnsR (ckread: (chunk, 'a) reader): (bigInt, 'a) reader =
- let fun loop (more: bool, ac: bigInt, s: 'a) =
- if more
- then case ckread s of
- NONE => (ac, s)
- | SOME ({more, shift, chunk}, s') =>
- loop (more,
- bigPlus (bigMul (smallToBig shift,
- ac),
- smallToBig chunk),
- s')
- else (ac, s)
- fun reader (s: 'a): (bigInt * 'a) option =
- case ckread s of
- NONE => NONE
- | SOME ({more, chunk, ...}, s') =>
- SOME (loop (more,
- smallToBig chunk,
- s'))
- in reader
- end
-
- (*
- * Given a char reader and an unsigned reader, return an unsigned
- * reader that includes skipping the option hex '0x'.
- *)
- fun toHexR (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
- s =
- case cread s of
- NONE => NONE
- | SOME (c1, s1) =>
- if c1 = #"0" then
- case cread s1 of
- NONE => SOME (zero, s1)
- | SOME (c2, s2) =>
- if c2 = #"x" orelse c2 = #"X" then
- case uread s2 of
- NONE => SOME (zero, s1)
- | SOME x => SOME x
- else uread s
- else uread s
-
- (*
- * Given a char reader and an unsigned reader, return a signed
- * reader. This includes skipping any initial white space.
- *)
- fun toSign (cread: (char, 'a) reader, uread: (bigInt, 'a) reader)
- : (bigInt, 'a) reader =
- let
- fun reader (s: 'a): (bigInt * 'a) option =
- case cread s of
- NONE => NONE
- | SOME (ch, s') =>
- if Char.isSpace ch then reader s'
- else
- let
- val (isNeg, s'') =
- case ch of
- #"+" => (false, s')
- | #"-" => (true, s')
- | #"~" => (true, s')
- | _ => (false, s)
- in
- if isNeg then
- case uread s'' of
- NONE => NONE
- | SOME (abs, s''') =>
- SOME (bigNegate abs, s''')
- else uread s''
- end
- in
- reader
- end
-
- (*
- * Base-specific conversions from char readers to
- * bigInt readers.
- *)
- local
- fun reader (base, dpc, dig)
- (cread: (char, 'a) reader): (bigInt, 'a) reader =
- let val dread = toDigR (dig, cread)
- val ckread = toChunkR (base, dpc, dread)
- val uread = toUnsR ckread
- val hread =
- if base = 0w16 then toHexR (cread, uread) else uread
- val reader = toSign (cread, hread)
- in reader
- end
- in
- fun binReader z = reader (0w2, 29, binDig) z
- fun octReader z = reader (0w8, 9, octDig) z
- fun decReader z = reader (0w10, 9, decDig) z
- fun hexReader z = reader (0w16, 7, hexDig) z
- end
- in
-
- local fun stringReader (pos, str) =
- if pos >= String.size str
- then NONE
- else SOME (String.sub (str, pos), (pos + 1, str))
- val reader = decReader stringReader
- in
- fun bigFromString str =
- case reader (0, str) of
- NONE => NONE
- | SOME (res, _) => SOME res
- end
-
- fun bigScan radix =
- case radix of
- BIN => binReader
- | OCT => octReader
- | DEC => decReader
- | HEX => hexReader
- end
-
- local
- fun isEven (n: int) = Int.mod (Int.abs n, 2) = 0
- in
- fun pow (i: bigInt, j: int): bigInt =
- if j < 0 then
- if i = zero then
- raise Div
- else
- if i = one then one
- else if i = negOne then if isEven j then one else negOne
- else zero
- else
- if j = 0 then one
- else
- let
- fun square (n: bigInt): bigInt = bigMul (n, n)
- (* pow (j) returns (i ^ j) *)
- fun pow (j: int): bigInt =
- if j <= 0 then one
- else if isEven j then evenPow j
- else bigMul (i, evenPow (j - 1))
- (* evenPow (j) returns (i ^ j), assuming j is even *)
- and evenPow (j: int): bigInt =
- square (pow (Int.quot (j, 2)))
- in pow (j)
- end
- end
-
-
- (*
- * bigInt log2
- *)
- structure Word =
- struct
- open Word
- fun log2 (w: word): int =
- let
- fun loop (n, s, ac): word =
- if n = 0w1
- then ac
- else
- let
- val (n, ac) =
- if n >= << (0w1, s)
- then (>> (n, s), ac + s)
- else (n, ac)
- in
- loop (n, >> (s, 0w1), ac)
- end
- in
- toInt (loop (w, 0w16, 0w0))
- end
- end
-
- local
- val bitsPerLimb: Int.int = 32
- in
- fun log2 (n: bigInt): Int.int =
- if bigLE (n, 0)
- then raise Domain
- else
- case rep n of
- Big v =>
- Int.+ (Int.* (bitsPerLimb, Int.- (Vector.length v, 2)),
- Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
- | Small i => Word.log2 (Word.fromInt i)
- end
-
-
- end
-
-structure LargeInt = IntInf
-*)
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -13,6 +13,7 @@
val precision': Int.int = Primitive.Int32.toInt precision'
val precision: Int.int option = SOME precision'
+val precisionWord': Word.word = Primitive.Word32.toWord precisionWord'
val maxInt: int option = SOME maxInt'
val minInt: int option = SOME minInt'
@@ -25,6 +26,21 @@
else (1: Int.int)
fun sameSign (x, y) = sign x = sign y
+
+fun << (i, n) =
+ if Word.>= (n, precisionWord')
+ then zero
+ else I.<< (i, Primitive.Word32.fromWord n)
+fun >> (i, n) =
+ if Word.>= (n, precisionWord')
+ then zero
+ else I.>> (i, Primitive.Word32.fromWord n)
+fun ~>> (i, n) =
+ if Word.< (n, precisionWord')
+ then I.~>> (i, Primitive.Word32.fromWord n)
+ else I.~>> (i, Primitive.Word32.- (I.precisionWord', 0w1))
+fun rol (i, n) = I.rol (i, Primitive.Word32.fromWord n)
+fun ror (i, n) = I.ror (i, Primitive.Word32.fromWord n)
(* fmt constructs a string to represent the integer by building it into a
* statically allocated buffer. For the most part, this is a textbook
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-03-03 18:51:40 UTC (rev 4369)
@@ -43,6 +43,7 @@
val one: int
val precision' : Primitive.Int32.int
+ val precisionWord' : Primitive.Word32.word
val maxInt' : int
val minInt' : int
@@ -74,10 +75,12 @@
val fmt: StringCvt.radix -> int -> string
val toString: int -> string
+(*
val scan: (StringCvt.radix
-> (char, 'a) StringCvt.reader
-> (int, 'a) StringCvt.reader)
val fromString: string -> int option
+*)
end
signature INTEGER_EXTRA =
@@ -94,16 +97,12 @@
val ~? : 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
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sig 2006-03-03 18:51:40 UTC (rev 4369)
@@ -48,12 +48,18 @@
val zero: word
val wordSize: Primitive.Int32.int
+ val wordSizeWord: Primitive.Word32.word
+ val fromWord: Word.word -> word
+ val toWord: word -> Word.word
+ val toWordX: word -> Word.word
+
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
+ val log2 : word -> Primitive.Int32.int
end
signature WORD =
@@ -62,11 +68,9 @@
val wordSize: Int.int
-(*
val << : word * Word.word -> word
val >> : word * Word.word -> word
val ~>> : word * Word.word -> word
-*)
val fmt: StringCvt.radix -> word -> string
val toString: word -> string
@@ -79,7 +83,13 @@
signature WORD_EXTRA =
sig
include WORD
+ val wordSizeWord: Word.word
+ val fromWord: Word.word -> word
+ val toWord: word -> Word.word
+ val toWordX: word -> Word.word
+
val rol: word * Word.word -> word
val ror: word * Word.word -> word
+ val log2 : word -> Primitive.Int32.int
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -11,32 +11,31 @@
open W
-val wordSize = Primitive.Int32.toInt wordSize
+val wordSize: Int.int = Primitive.Int32.toInt wordSize
+val wordSizeWord: Word.word = Primitive.Word32.toWord wordSizeWord
-(*
-fun << (i, n)
- = if PW.>=(n ,wordSizeWord)
+fun << (w, n) =
+ if Word.>= (n, wordSizeWord)
then zero
- else W.<<(i, n)
-
-fun >> (i, n)
- = if PW.>=(n, wordSizeWord)
+ else W.<< (w, Primitive.Word32.fromWord n)
+fun >> (w, n) =
+ if Word.>= (n, wordSizeWord)
then zero
- else W.>>(i, n)
+ else W.>> (w, Primitive.Word32.fromWord n)
+fun ~>> (w, n) =
+ if Word.< (n, wordSizeWord)
+ then W.~>> (w, Primitive.Word32.fromWord n)
+ else W.~>> (w, Primitive.Word32.- (W.wordSizeWord, 0w1))
+fun rol (w, n) = W.rol (w, Primitive.Word32.fromWord n)
+fun ror (w, n) = W.ror (w, Primitive.Word32.fromWord n)
-fun ~>> (i, n)
- = if PW.<(n, wordSizeWord)
- then W.~>>(i, n)
- else W.~>>(i, wordSizeMinusOneWord)
-*)
-
fun fmt radix (w: word): string =
let val radix = fromInt (StringCvt.radixToInt radix)
fun loop (q, chars) =
let val chars = StringCvt.digitToChar (toInt (q mod radix)) :: chars
val q = q div radix
in if q = zero
- then String0.implode chars
+ then PreString.implode chars
else loop (q, chars)
end
in loop (w, [])
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word0.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -23,6 +23,7 @@
val rol : word * Primitive.Word32.word -> word
val ror : word * Primitive.Word32.word -> word
val ~>> : word * Primitive.Word32.word -> word
+ val log2 : word -> Primitive.Int32.int
(* Lowbits or sign extend. *)
val fromInt8: Primitive.Int8.int -> word
@@ -126,6 +127,23 @@
then w
else rorUnsafe (w, n)
end
+ fun log2 w =
+ let
+ fun loop (n, s, acc) =
+ if n = one
+ then acc
+ else let
+ val (n, acc) =
+ if n >= << (one, s)
+ then (>> (n, s), Primitive.Word32.+ (acc, s))
+ else (n, acc)
+ in
+ loop (n, Primitive.Word32.>>? (s, 0w1), acc)
+ end
+ in
+ Primitive.Word32.toInt32Unsafe
+ (loop (w, Primitive.Word32.>>? (wordSizeWord, 0w1), 0w0))
+ end
local
fun 'a make {fromIntUnsafe: 'a -> word, (* fromIntZUnsafe: 'a -> word, *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml 2006-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/word1.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -49,12 +49,15 @@
type word
val fromInt: Int.int -> word
+ val fromWord: Word.word -> 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 toWord: word -> Word.word
+ val toWordX: word -> Word.word
val toLarge: word -> LargeWord.word
val toLargeX: word -> LargeWord.word
val toLargeInt: word -> LargeInt.int
@@ -93,6 +96,17 @@
end
local
structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> word
+ val fWord8 = W.fromWord8
+ val fWord16 = W.fromWord16
+ val fWord32 = W.fromWord32
+ val fWord64 = W.fromWord64)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
LargeWord_ChooseWordN
(type 'a t = 'a -> word
val fWord8 = W.fromWord8
@@ -154,6 +168,17 @@
end
local
structure S =
+ Word_ChooseWordN
+ (type 'a t = word -> 'a
+ val fWord8 = W.toWord8
+ val fWord16 = W.toWord16
+ val fWord32 = W.toWord32
+ val fWord64 = W.toWord64)
+ in
+ val toWord = S.f
+ end
+ local
+ structure S =
LargeWord_ChooseWordN
(type 'a t = word -> 'a
val fWord8 = W.toWord8
@@ -166,6 +191,17 @@
end
local
structure S =
+ Word_ChooseWordN
+ (type 'a t = word -> 'a
+ val fWord8 = W.toWord8X
+ val fWord16 = W.toWord16X
+ val fWord32 = W.toWord32X
+ val fWord64 = W.toWord64X)
+ in
+ val toWordX = S.f
+ end
+ local
+ structure S =
LargeWord_ChooseWordN
(type 'a t = word -> 'a
val fWord8 = W.toWord8X
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml 2006-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim1.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -42,6 +42,7 @@
val name = _prim "Exn_name": exn -> String8.string;
exception Div
+ exception Domain
exception Fail8 of String8.string
exception Fail16 of String16.string
exception Fail32 of String32.string
@@ -84,6 +85,7 @@
exception Bind = Primitive.Exn.Bind
exception Div = Primitive.Exn.Div
+exception Domain = Primitive.Exn.Domain
exception Match = Primitive.Exn.Match
exception Overflow = Primitive.Exn.Overflow
exception Size = Primitive.Exn.Size
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/primitive.mlb 2006-03-03 18:51:40 UTC (rev 4369)
@@ -23,7 +23,7 @@
prim-char.sml
prim-word.sml
prim-int.sml
- local ../config/bind-for-config0.sml in ann "forceUsed" in
+ local ../config/bind-for-choose.sml in ann "forceUsed" in
../config/choose.sml
end end
local ../config/bind-for-config0.sml in ann "forceUsed" in
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/char0.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -6,9 +6,10 @@
* See the file MLton-LICENSE for details.
*)
-structure Char0 =
+structure PreChar8 =
struct
- open Char
+ structure Prim = Primitive.Char8
+ open Primitive.Char8
type char = char
type string = string
@@ -17,11 +18,11 @@
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)
+ val fInt8 = Prim.fromInt8Unsafe
+ val fInt16 = Prim.fromInt16Unsafe
+ val fInt32 = Prim.fromInt32Unsafe
+ val fInt64 = Prim.fromInt64Unsafe
+ val fIntInf = Prim.fromIntInfUnsafe)
in
val chrUnsafe = S.f
end
@@ -29,16 +30,16 @@
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)
+ val fInt8 = Prim.toInt8Unsafe
+ val fInt16 = Prim.toInt16Unsafe
+ val fInt32 = Prim.toInt32Unsafe
+ val fInt64 = Prim.toInt64Unsafe
+ val fIntInf = Prim.toIntInfUnsafe)
in
val ord = S.f
end
- val minChar:char = #"\000"
+ val minChar: char = #"\000"
val numChars: int = 256
val maxOrd: int = 255
val maxChar:char = #"\255"
@@ -64,15 +65,15 @@
NONE => raise Chr
| SOME c => c
- structure String = String0
+ structure PreString = PreString
fun oneOf s =
let
val a = Array.array (numChars, false)
- val n = String.size s
+ val n = PreString.size s
fun loop i =
if Int.>= (i, n) then ()
- else (Array.update (a, ord (String.sub (s, i)), true)
+ else (Array.update (a, ord (PreString.sub (s, i)), true)
; loop (Int.+ (i, 1)))
in loop 0
; fn c => Array.sub (a, ord c)
@@ -118,3 +119,4 @@
val toUpper = make (#"a", #"z", diff)
end
end
+structure PreChar = PreChar8
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-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string-cvt.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -31,25 +31,22 @@
open Int
- structure Char = Char0
- structure String = String0
-
local
fun pad f (c: char) i s =
let
- val n = String.size s
+ val n = PreString.size s
in
if n >= i
then s
- else f (s, String0.vector (i -? n, c))
+ else f (s, PreString.vector (i -? n, c))
end
in
- val padLeft = pad (fn (s, pad) => String.^ (pad, s))
- val padRight = pad String.^
+ val padLeft = pad (fn (s, pad) => PreString.^ (pad, s))
+ val padRight = pad PreString.^
end
fun splitl p f src =
- let fun done chars = String0.implode (rev chars)
+ let fun done chars = PreString.implode (rev chars)
fun loop (src, chars) =
case f src of
NONE => (done chars, src)
@@ -63,14 +60,14 @@
fun takel p f s = #1 (splitl p f s)
fun dropl p f s = #2 (splitl p f s)
- fun skipWS x = dropl Char.isSpace x
+ fun skipWS x = dropl PreChar.isSpace x
type cs = int
fun stringReader (s: string): (char, cs) reader =
- fn i => if i >= String.size s
+ fn i => if i >= PreString.size s
then NONE
- else SOME (String.sub (s, i), i + 1)
+ else SOME (PreString.sub (s, i), i + 1)
fun 'a scanString (f: ((char, cs) reader -> ('a, cs) reader)) (s: string)
: 'a option =
@@ -80,14 +77,14 @@
local
fun range (add: int, cmin: char, cmax: char): char -> int option =
- let val min = Char.ord cmin
- in fn c => if Char.<= (cmin, c) andalso Char.<= (c, cmax)
- then SOME (add +? Char.ord c -? min)
+ let val min = PreChar.ord cmin
+ in fn c => if PreChar.<= (cmin, c) andalso PreChar.<= (c, cmax)
+ then SOME (add +? PreChar.ord c -? min)
else NONE
end
fun 'a combine (ds: (char -> 'a option) list): char -> 'a option =
- Char.memoize
+ PreChar.memoize
(fn c =>
let
val rec loop =
@@ -99,9 +96,9 @@
in loop ds
end)
- val bin = Char.memoize (range (0, #"0", #"1"))
- val oct = Char.memoize (range (0, #"0", #"7"))
- val dec = Char.memoize (range (0, #"0", #"9"))
+ val bin = PreChar.memoize (range (0, #"0", #"1"))
+ val oct = PreChar.memoize (range (0, #"0", #"7"))
+ val dec = PreChar.memoize (range (0, #"0", #"9"))
val hex = combine [range (0, #"0", #"9"),
range (10, #"a", #"f"),
range (10, #"A", #"F")]
@@ -195,5 +192,5 @@
| SOME n => loop (n, state)
end
- fun digitToChar (n: int): char = String.sub ("0123456789ABCDEF", n)
+ fun digitToChar (n: int): char = PreString.sub ("0123456789ABCDEF", n)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string0.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string0.sml 2006-03-03 02:19:52 UTC (rev 4368)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/text/string0.sml 2006-03-03 18:51:40 UTC (rev 4369)
@@ -6,12 +6,12 @@
* See the file MLton-LICENSE for details.
*)
-structure String0 =
+structure PreString8 =
struct
open CharVector
type char = elem
type string = vector
- structure Substring0 =
+ structure PreSubstring =
struct
open CharVectorSlice
type char = elem
@@ -29,4 +29,5 @@
val implode = fromList
val explode = toList
end
-structure Substring0 = String0.Substring0
+structure PreString = PreString8
+structure PreSubstring8 = PreString.PreSubstring