Skip to content

Commit

Permalink
Word64 and Int64 support (#42)
Browse files Browse the repository at this point in the history 
* first commit

* some js-fixes

* more work towards 64 bits words and ints

* more coverage

* initial work on Word64 structure support

* initial work on Int64 structure support

* finalize Word64/63 and Int64/63 support
  • Loading branch information
@melsman
melsman authored Apr 30, 2020
1 parent 1164495 commit 6f763d9
Show file tree
Hide file tree
Showing 102 changed files with 6,512 additions and 2,381 deletions.
16 changes: 15 additions & 1 deletion basis/INT_INF_REP.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
signature INT_INF_REP =
sig
type intinf

val fromInt : int -> intinf
val toInt : intinf -> int

Expand All @@ -17,6 +17,12 @@ signature INT_INF_REP =
val fromInt32 : int32 -> intinf
val toInt32 : intinf -> int32

val fromInt63 : int63 -> intinf
val toInt63 : intinf -> int63

val fromInt64 : int64 -> intinf
val toInt64 : intinf -> int64

val fromWord : word -> intinf
val fromWordX : word -> intinf
val toWord : intinf -> word
Expand All @@ -33,6 +39,14 @@ signature INT_INF_REP =
val fromWord32X : word32 -> intinf
val toWord32 : intinf -> word32

val fromWord63 : word63 -> intinf
val fromWord63X : word63 -> intinf
val toWord63 : intinf -> word63

val fromWord64 : word64 -> intinf
val fromWord64X : word64 -> intinf
val toWord64 : intinf -> word64

(* for overloading *)
val + : intinf * intinf -> intinf
val - : intinf * intinf -> intinf
Expand Down
58 changes: 39 additions & 19 deletions basis/Initial.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,17 +5,16 @@

structure Initial =
struct
infix - + *
infix - + * < =

type int0 = int
type int0 = int
type word0 = word (* used by WORD signature *)

exception Fail of string
val _ = prim("sml_setFailNumber", (Fail "hat" : exn, 1 : int)) : unit;

(* Time structure *)
val timebase : int = prim("get_time_base", 0)
(* val timebase = ~1073741820 - 4 13/04/1999, Niels*)

(* Date structure *)
local fun localoffset_ () : real = prim("sml_localoffset", ())
Expand All @@ -34,7 +33,7 @@ structure Initial =
fun getrutime_ () : tusage = prim("sml_getrutime", ())
in val initial_realtime = getrealtime_ ()
val initial_rutime = getrutime_ ()
end
end

(* Real structure *)
local
Expand All @@ -50,21 +49,42 @@ structure Initial =
fun sqrt (r : real) : real = prim ("sqrtFloat", r)
fun ln' (r : real) : real = prim ("lnFloat", r)
in
val ln10 = ln' 10.0
val ln10 = ln' 10.0
val NaN = sqrt ~1.0
end

(* Int structure. Integers are untagged (or tagged if GC is enabled),
* and there is a limit to the size of immediate integers that the Kit
* accepts. We should change the lexer such that it does not convert a
* string representation of an integer constant into an internal
* integer, as this makes the the kit dependent on the precision of
(* Int structure. Integers are untagged (or tagged if GC is enabled),
* and there is a limit to the size of immediate integers that the Kit
* accepts. We should change the lexer such that it does not convert a
* string representation of an integer constant into an internal
* integer, as this makes the the kit dependent on the precision of
* the compiler (SML/NJ) that we use to compile the Kit. *)

type int0 = int

local fun pow2 n : int63 = if n < 1 then 1 else 2 * pow2(n-1)
in val maxInt63 : int63 = pow2 61 + (pow2 61 - 1)
val minInt63 : int63 = ~maxInt63 - 1
end

local fun pow2 n : int64 = if n < 1 then 1 else 2 * pow2(n-1)
in val maxInt64 : int64 = pow2 62 + (pow2 62 - 1)
val minInt64 : int64 = ~maxInt64 - 1
end

fun op = (x: ''a, y: ''a): bool = prim ("=", (x, y))
fun fromI63 (i:int63) : int = prim("__int63_to_int", i)
fun fromI64 (i:int64) : int = prim("__int64_to_int", i)

val precisionInt0 : int = prim("precision", 0)
val (minInt0:int,maxInt0:int) =
if precisionInt0 = 63 then (fromI63 minInt63, fromI63 maxInt63)
else (fromI64 minInt64, fromI64 maxInt64)

(*
val maxInt0 : int = prim("max_fixed_int", 0)
val minInt0 : int = prim("min_fixed_int", 0)
val precisionInt0 : int = prim("precision", 0)
*)

(* TextIO *)
val stdIn_stream : int = prim ("stdInStream", 0)
Expand All @@ -75,7 +95,7 @@ structure Initial =
(* FileSys *)
structure FileSys =
struct
val filesys_fail : exn = Fail "FileSys"
val filesys_fail : exn = Fail "FileSys"
end

(* Process *)
Expand All @@ -86,7 +106,7 @@ structure Initial =
val clearnerAtExit = (ref []) : (unit -> unit) list ref
val addedclearner = ref false
exception ClosedStream

(* Posix *)

structure TextIO =
Expand All @@ -101,7 +121,7 @@ structure Initial =
fun getNS s = prim("@sml_findsignal", s : string) : int
fun getT i = prim("@sml_getTty", i : int) : word
fun getTi i = prim("@sml_getTty", i : int) : int
structure Tty =
structure Tty =
struct
structure V =
struct
Expand Down Expand Up @@ -169,7 +189,7 @@ structure Initial =
structure Speed =
struct
val b0 = getT 48
val b50 = getT 49
val b50 = getT 49
val b75 = getT 50
val b110 = getT 51
val b134 = getT 52
Expand Down Expand Up @@ -261,7 +281,7 @@ structure Initial =
val ttou = getNS "SIGTTOU"
end

structure Process =
structure Process =
struct
val untraced = 0wx1
val nohang = 0wx2
Expand All @@ -272,7 +292,7 @@ structure Initial =
structure Posix_File_Sys =
struct
val (stdin,stdout,stderr) = prim ("sml_getStdNumbers", ()) : (int * int * int)
structure O =
structure O =
struct
val append = 0wx1
val excl = 0wx2
Expand All @@ -285,7 +305,7 @@ structure Initial =
val rdonly = 0wx100
val wronly = 0wx200
val rdwr = 0wx400

val all = 0wx3F (* [append,excl,noctty,nonblock,sync,trunc] *)
end

Expand All @@ -309,7 +329,7 @@ structure Initial =
val all = 0wx3FFF
end
end



end
62 changes: 25 additions & 37 deletions basis/Int.sml
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@

structure Int : INTEGER =
structure Int : INTEGER =
struct (*Depends on StringCvt and Char*)

(* Primitives *)
fun quot(x:int,y:int) : int = if y = 0 then raise Div
else prim ("__quot_int", (x, y))
fun rem(x:int,y:int) : int = if y = 0 then raise Div
else prim ("__rem_int", (x, y))
fun quot (x:int,y:int) : int = if y = 0 then raise Div
else prim ("__quot_int", (x, y))
fun rem (x:int,y:int) : int = if y = 0 then raise Div
else prim ("__rem_int", (x, y))

fun not true = false
| not false = true
Expand All @@ -23,10 +23,10 @@ structure Int : INTEGER =
val maxInt = SOME Initial.maxInt0
val minInt = SOME Initial.minInt0

val ~ : int -> int = ~
val op * : (int * int) -> int = op *
val op div : (int * int) -> int = op div
val op mod : (int * int) -> int = op mod
val ~ : int -> int = ~
val op * : (int * int) -> int = op *
val op div : (int * int) -> int = op div
val op mod : (int * int) -> int = op mod
val op + : (int * int) -> int = op +
val op - : (int * int) -> int = op -
fun compare (x, y: int) = if x<y then LESS else if x>y then GREATER else EQUAL
Expand All @@ -44,22 +44,21 @@ structure Int : INTEGER =
else (Char.ord c - 55) mod 32
fun prhex i = if i < 10 then Char.chr(i + 48) else Char.chr(i + 55)
fun skipWSget getc source = getc (dropl Char.isSpace getc source)

fun conv radix i =
if SOME i = minInt then (* Be careful not to Overflow *)
let fun tag s1 s2 = if precision = SOME 31 then s1 else s2
let fun tag s1 s2 = if precision = SOME 63 then s1 else s2
in case radix
of 2 => tag "~1000000000000000000000000000000" "~10000000000000000000000000000000"
| 8 => tag "~10000000000" "~20000000000"
| 10 => tag "~1073741824" "~2147483648"
| 16 => tag "~40000000" "~80000000"
| _ => raise Fail "conv"
of 2 => tag "~100000000000000000000000000000000000000000000000000000000000000" "~1000000000000000000000000000000000000000000000000000000000000000"
| 8 => tag "~400000000000000000000" "~1000000000000000000000"
| 10 => tag "~4611686018427387904" "~9223372036854775808"
| 16 => tag "~4000000000000000" "~8000000000000000"
| _ => raise Fail "Int.conv"
end
else
let fun h 0 res = res
| h n res = h (n div radix) (prhex (n mod radix) :: res)
fun tostr n = h (n div radix) [prhex (n mod radix)]
in implode (if i < 0 then #"~" :: tostr (~i) else tostr i)
in implode (if i < 0 then #"~" :: tostr (~i) else tostr i)
end
in
fun scan radix getc source =
Expand All @@ -69,17 +68,6 @@ structure Int : INTEGER =
| OCT => (fn c => (#"0" <= c andalso c <= #"7"), 8)
| DEC => (Char.isDigit, 10)
| HEX => (Char.isHexDigit, 16)
(*
fun dig1 sgn NONE = NONE
| dig1 sgn (SOME (c, rest)) =
let fun digr res src =
case getc src
of NONE => SOME (sgn * res, src)
| SOME (c, rest) => if isDigit c then digr (factor * res + hexval c) rest
else SOME (sgn * res, src)
in if isDigit c then digr (hexval c) rest else NONE
end
*)
fun dig1 sgn NONE = NONE
| dig1 sgn (SOME (c, rest)) =
let fun digr (res:int) next_val src =
Expand All @@ -90,10 +78,10 @@ structure Int : INTEGER =
val next_val =
if sgn = 1 then fn (factor, res, hv) => factor * res + hv
else fn (factor, res, hv) => factor * res - hv
in if isDigit c then digr (sgn * hexval c) next_val rest else NONE
in if isDigit c then digr (sgn * hexval c) next_val rest else NONE
end
fun getdigs sgn after0 inp =
case dig1 sgn inp
case dig1 sgn inp
of NONE => SOME(0, after0)
| res => res
fun hexopt sgn NONE = NONE
Expand All @@ -110,25 +98,25 @@ structure Int : INTEGER =
| sign (SOME (#"-", rest)) = hexopt ~1 (getc rest)
| sign (SOME (#"+", rest)) = hexopt 1 (getc rest)
| sign inp = hexopt 1 inp
in sign (skipWSget getc source)
in sign (skipWSget getc source)
end

fun fmt BIN = conv 2
| fmt OCT = conv 8
| fmt DEC = conv 10
| fmt HEX = conv 16

(* It should hold that: toString = fmt DEC = conv 10 *)
fun toString (i: int): string = fmt DEC i

fun fromString s = scanString (scan DEC) s
end (*local*)

val op > : int * int -> bool = op >
val op >= : int * int -> bool = op >=
val op < : int * int -> bool = op <
val op <= : int * int -> bool = op <=

end; (*structure Int*)

structure Position = Int
end (*structure Int*)

structure Position = Int
Loading

0 comments on commit 6f763d9

Please sign in to comment.