Skip to content

Commit

Permalink
JavaScript: Make Int.int 54-bit
Browse files Browse the repository at this point in the history
  • Loading branch information
@minoki
minoki committed Jul 5, 2023
1 parent 94fadc3 commit 0425787
Show file tree
Hide file tree
Showing 10 changed files with 204 additions and 288 deletions.
4 changes: 2 additions & 2 deletions lib/lunarml/ml/basis/js-common/int-inf.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,8 +53,8 @@ structure IntInfImpl : sig
end = struct
type int = _Prim.IntInf.int
_equality int = fn (x, y) => _primCall "IntInf.=" (x, y);
val maxSmallInt : int = 0x7fffffff
val minSmallInt : int = ~0x80000000
val maxSmallInt : int = 0x1fffffffffffff
val minSmallInt : int = ~0x20000000000000
val maxSmallWord : int = 0xffffffff
fun LT (x, y) = _primCall "IntInf.<" (x, y)
fun LE (x, y) = _primCall "IntInf.<=" (x, y)
Expand Down
4 changes: 2 additions & 2 deletions lib/lunarml/ml/basis/js-common/int-prim.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,6 @@ _overload "Int" [int] { + = Int.+
, > = Int.>
, >= = Int.>=
, fromInt = Int.fromInt
, minInt = ~0x8000_0000
, maxInt = 0x7fff_ffff
, minInt = ~0x20_0000_0000_0000
, maxInt = 0x1f_ffff_ffff_ffff
};
312 changes: 59 additions & 253 deletions lib/lunarml/ml/basis/js-common/int.sml
View file

Large diffs are not rendered by default.

8 changes: 4 additions & 4 deletions lib/lunarml/ml/basis/js-common/mlbasis.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -129,9 +129,9 @@ structure Int : INTEGER where type int = int = struct
open Int (* +, -, *, div, mod, ~, abs, <, <=, >, >=, fromInt *)
(* toLarge, fromLarge *)
val toInt : int -> int = fn x => x
val precision : int option = SOME 32
val minInt : int option = SOME ~0x80000000
val maxInt : int option = SOME 0x7fffffff
val precision : int option = SOME 54
val minInt : int option = SOME ~0x20000000000000
val maxInt : int option = SOME 0x1fffffffffffff
fun quot (x, y) = _primCall "Int.quot" (x, y)
fun rem (x, y) = if y = 0 then
raise Div
Expand Down Expand Up @@ -944,5 +944,5 @@ structure Vector : sig
(* val collate : ('a * 'a -> order) -> 'a vector * 'a vector -> order; defined later *)
end = struct
open Vector
val maxLen = 0x7fffffff
val maxLen = 0xffffffff
end;
8 changes: 7 additions & 1 deletion lib/lunarml/mlinit-cps.js
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,7 +196,7 @@ function _String_implode(k, xs) {
}
function _Array_array(k, t) {
const n = t[0], init = t[1];
if (n < 0) {
if (n < 0 || n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
Expand All @@ -212,6 +212,9 @@ function _VectorOrArray_fromList(k, xs) {
return [false, k, [a]];
}
function _Vector_unsafeFromListRevN(n, xs) {
if (n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
let i = n - 1;
while (xs !== null) {
Expand All @@ -230,6 +233,9 @@ function _Vector_concat(k, xs) {
n += v.length;
xs0 = xs0[1];
}
if (n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
let m = 0;
while (xs !== null) {
Expand Down
89 changes: 87 additions & 2 deletions lib/lunarml/mlinit.js
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,85 @@ function _Int32_quot(x, y) {
}
return (x / y)|0;
}
const MIN_INT54 = -0x20000000000000;
const MAX_INT54 = 0x1fffffffffffff;
function _Int54_abs(x) {
if (x < 0) {
if (x === MIN_INT54) {
throw _Overflow;
}
return -x;
} else {
return x;
}
}
function _Int54_negate(x) {
if (x === MIN_INT54) {
throw _Overflow;
}
return 0 - x; // Avoid -0
}
function _Int54_add(x, y) {
const z = x + y;
if ((MIN_INT54 < z && z <= MAX_INT54) || (z === MIN_INT54 && (x & 1) === (y & 1))) {
return z;
} else {
throw _Overflow;
}
}
function _Int54_sub(x, y) {
const z = x - y;
if ((MIN_INT54 < z && z <= MAX_INT54) || (z === MIN_INT54 && (x & 1) === (y & 1))) {
return z;
} else {
throw _Overflow;
}
}
function _Int54_mul(x, y) {
const z = 0 + x * y;
if ((MIN_INT54 < z && z <= MAX_INT54) || (z === MIN_INT54 && ((x & 1) === 0 || (y & 1) === 0))) {
return z;
} else {
throw _Overflow;
}
}
function _Int54_div(x, y) {
if (y === 0) {
throw _Div;
} else if (x === MIN_INT54 && y === -1) {
throw _Overflow;
} else {
return 0 + Math.floor(x / y);
}
}
function _Int54_mod(x, y) {
if (y === 0) {
throw _Div;
} else {
const r = 0 + x % y;
if (r === 0 || x * y >= 0) {
return r;
} else {
return r + y;
}
}
}
function _Int54_quot(x, y) {
if (y === 0) {
throw _Div;
} else if (x === MIN_INT54 && y === -1) {
throw _Overflow;
} else {
return 0 + Math.trunc(x / y);
}
}
function _Int54_rem(x, y) {
if (y === 0) {
throw _Div;
} else {
return 0 + x % y;
}
}
const Math_abs = Math.abs;
const Math_imul = Math.imul;
function _encodeUtf8(s) {
Expand Down Expand Up @@ -210,7 +289,7 @@ function _String_translate(f, s) {
}
function _Array_array(t) {
const n = t[0], init = t[1];
if (n < 0) {
if (n < 0 || n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
Expand All @@ -226,6 +305,9 @@ function _VectorOrArray_fromList(xs) {
return a;
}
function _Vector_unsafeFromListRevN(n, xs) {
if (n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
let i = n - 1;
while (xs !== null) {
Expand All @@ -238,7 +320,7 @@ function _Vector_unsafeFromListRevN(n, xs) {
}
function _VectorOrArray_tabulate(t) {
const n = t[0], f = t[1];
if (n < 0) {
if (n < 0 || n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
Expand All @@ -255,6 +337,9 @@ function _Vector_concat(xs) {
n += v.length;
xs0 = xs0[1];
}
if (n > 0xffffffff) {
throw _Size;
}
const a = new Array(n);
let m = 0;
while (xs !== null) {
Expand Down
33 changes: 23 additions & 10 deletions src/codegen-js.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
structure CodeGenJs = struct
exception CodeGenError of string
(* Mapping of types:
* int -> 32-bit signed integer, as a subset of 64-bit floating-point number (excluding negative zero)
* int -> 54-bit signed integer, as a subset of 64-bit floating-point number
* word -> 32-bit unsigned integer, as a subset of 64-bit floating-point number (excluding negative zero)
* real -> number (64-bit floating-point number)
* string -> immutable Uint8Array
Expand Down Expand Up @@ -350,18 +350,31 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| Primitives.Bool_not => doUnaryExp (fn a => J.UnaryExp (J.NOT, a), PURE)
| Primitives.Int_EQUAL _ => doBinaryOp (J.EQUAL, PURE) (* Int32, Int54, IntInf *)
| Primitives.Int_PLUS Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_add"), vector [a, b]), IMPURE)
| Primitives.Int_PLUS Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_add"), vector [a, b]), IMPURE)
| Primitives.Int_MINUS Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_sub"), vector [a, b]), IMPURE)
| Primitives.Int_MINUS Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_sub"), vector [a, b]), IMPURE)
| Primitives.Int_TIMES Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_mul"), vector [a, b]), IMPURE)
| Primitives.Int_TIMES Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_mul"), vector [a, b]), IMPURE)
| Primitives.Int_div Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_div"), vector [a, b]), IMPURE)
| Primitives.Int_div Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_div"), vector [a, b]), IMPURE)
| Primitives.Int_div_unchecked Primitives.I32 => doBinaryExp (fn (a, b) => J.ToInt32Exp (J.MethodExp (J.VarExp (J.PredefinedId "Math"), "floor", vector [J.BinExp (J.DIV, a, b)])), PURE)
| Primitives.Int_div_unchecked Primitives.I54 => doBinaryExp (fn (a, b) => J.BinExp (J.PLUS, J.ConstExp (J.Numeral "0"), J.MethodExp (J.VarExp (J.PredefinedId "Math"), "floor", vector [J.BinExp (J.DIV, a, b)])), PURE)
| Primitives.Int_mod Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_mod"), vector [a, b]), IMPURE)
| Primitives.Int_mod Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_mod"), vector [a, b]), IMPURE)
| Primitives.Int_mod_unchecked Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_mod"), vector [a, b]), PURE)
| Primitives.Int_mod_unchecked Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_mod"), vector [a, b]), PURE)
| Primitives.Int_quot Primitives.I32 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int32_quot"), vector [a, b]), IMPURE)
| Primitives.Int_quot Primitives.I54 => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_Int54_quot"), vector [a, b]), IMPURE)
| Primitives.Int_quot_unchecked Primitives.I32 => doBinaryExp (fn (a, b) => J.ToInt32Exp (J.BinExp (J.DIV, a, b)), PURE)
| Primitives.Int_quot_unchecked Primitives.I54 => doBinaryExp (fn (a, b) => J.BinExp (J.PLUS, J.ConstExp (J.Numeral "0"), J.MethodExp (J.VarExp (J.PredefinedId "Math"), "trunc", vector [J.BinExp (J.DIV, a, b)])), PURE)
| Primitives.Int_rem_unchecked Primitives.I32 => doBinaryExp (fn (a, b) => J.ToInt32Exp (J.BinExp (J.MOD, a, b)), PURE)
| Primitives.Int_rem_unchecked Primitives.I54 => doBinaryExp (fn (a, b) => J.BinExp (J.PLUS, J.ConstExp (J.Numeral "0"), J.BinExp (J.MOD, a, b)), PURE)
| Primitives.Int_TILDE Primitives.I32 => doUnaryExp (fn a => J.CallExp (J.VarExp (J.PredefinedId "_Int32_negate"), vector [a]), IMPURE)
| Primitives.Int_TILDE Primitives.I54 => doUnaryExp (fn a => J.CallExp (J.VarExp (J.PredefinedId "_Int54_negate"), vector [a]), IMPURE)
| Primitives.Int_TILDE_unchecked Primitives.I32 => doUnaryExp (fn a => J.ToInt32Exp (J.UnaryExp (J.NEGATE, a)), PURE)
| Primitives.Int_TILDE_unchecked Primitives.I54 => doUnaryExp (fn a => J.BinExp (J.MINUS, J.ConstExp (J.Numeral "0"), a), PURE)
| Primitives.Int_abs Primitives.I32 => doUnaryExp (fn a => J.CallExp (J.VarExp (J.PredefinedId "_Int32_abs"), vector [a]), IMPURE)
| Primitives.Int_abs Primitives.I54 => doUnaryExp (fn a => J.CallExp (J.VarExp (J.PredefinedId "_Int54_abs"), vector [a]), IMPURE)
| Primitives.Int_LT _ => doBinaryOp (J.LT, PURE) (* Int32, Int54, IntInf *)
| Primitives.Int_GT _ => doBinaryOp (J.GT, PURE) (* Int32, Int54, IntInf *)
| Primitives.Int_LE _ => doBinaryOp (J.LE, PURE) (* Int32, Int54, IntInf *)
Expand Down Expand Up @@ -405,15 +418,15 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| Primitives.String_EQUAL => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_EQUAL"), vector [a, b]), PURE)
| Primitives.String_LT => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_LT"), vector [a, b]), PURE)
| Primitives.String_HAT => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_append"), vector [a, b]), PURE)
| Primitives.String_size Primitives.I32 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE) (* should be I54 *)
| Primitives.String_size Primitives.I54 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE)
| Primitives.String_str => doUnaryExp (fn a => J.MethodExp (J.VarExp (J.PredefinedId "Uint8Array"), "of", vector [a]), PURE)
| Primitives.String16_EQUAL => doBinaryOp (J.EQUAL, PURE)
| Primitives.String16_LT => doBinaryOp (J.LT, PURE)
| Primitives.String16_GT => doBinaryOp (J.GT, PURE)
| Primitives.String16_LE => doBinaryOp (J.LE, PURE)
| Primitives.String16_GE => doBinaryOp (J.GE, PURE)
| Primitives.String16_HAT => doBinaryOp (J.PLUS, PURE)
| Primitives.String16_size Primitives.I32 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE) (* should be I54 *)
| Primitives.String16_size Primitives.I54 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE)
| Primitives.String16_str => doUnaryExp (fn a => J.MethodExp (J.VarExp (J.PredefinedId "String"), "fromCharCode", vector [a]), PURE)
| Primitives.Int_PLUS Primitives.INT_INF => doBinaryOp (J.PLUS, PURE)
| Primitives.Int_MINUS Primitives.INT_INF => doBinaryOp (J.MINUS, PURE)
Expand All @@ -425,16 +438,16 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| Primitives.IntInf_notb => doUnaryExp (fn a => J.UnaryExp (J.BITNOT, a), PURE)
| Primitives.Int_quot_unchecked Primitives.INT_INF => doBinaryOp (J.DIV, PURE)
| Primitives.Int_rem_unchecked Primitives.INT_INF => doBinaryOp (J.MOD, PURE)
| Primitives.Vector_length Primitives.I32 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE) (* should be I54 *)
| Primitives.Vector_unsafeFromListRevN Primitives.I32 => doBinaryExp (fn (n, xs) => J.CallExp (J.VarExp (J.PredefinedId "_Vector_unsafeFromListRevN"), vector [n, xs]), PURE) (* should be I54 *)
| Primitives.Vector_length Primitives.I54 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE)
| Primitives.Vector_unsafeFromListRevN Primitives.I54 => doBinaryExp (fn (n, xs) => J.CallExp (J.VarExp (J.PredefinedId "_Vector_unsafeFromListRevN"), vector [n, xs]), PURE)
| Primitives.Array_EQUAL => doBinaryOp (J.EQUAL, PURE)
| Primitives.Array_length Primitives.I32 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE) (* should be I54 *)
| Primitives.Array_length Primitives.I54 => doUnaryExp (fn a => J.IndexExp (a, J.ConstExp (J.asciiStringAsWide "length")), PURE)
| Primitives.Unsafe_cast => doUnaryExp (fn a => a, PURE)
| Primitives.Unsafe_Vector_sub Primitives.I32 => doBinaryExp (fn (vec, i) => J.IndexExp (vec, i), PURE) (* should be I54 *)
| Primitives.Unsafe_Array_sub Primitives.I32 => doBinaryExp (fn (arr, i) => J.IndexExp (arr, i), DISCARDABLE) (* should be I54 *)
| Primitives.Unsafe_Array_update Primitives.I32 => doTernary (fn (arr, i, v) =>
| Primitives.Unsafe_Vector_sub Primitives.I54 => doBinaryExp (fn (vec, i) => J.IndexExp (vec, i), PURE)
| Primitives.Unsafe_Array_sub Primitives.I54 => doBinaryExp (fn (arr, i) => J.IndexExp (arr, i), DISCARDABLE)
| Primitives.Unsafe_Array_update Primitives.I54 => doTernary (fn (arr, i, v) =>
action (result, J.AssignStat (J.IndexExp (arr, i), v))
) (* should be I54 *)
)
| Primitives.Exception_instanceof => doBinaryExp (fn (e, tag) => J.BinExp (J.INSTANCEOF, e, tag), PURE)
| Primitives.JavaScript_sub => doBinaryExp (fn (a, b) => J.IndexExp (a, b), IMPURE)
| Primitives.JavaScript_set => doTernary (fn (a, b, c) =>
Expand Down
12 changes: 6 additions & 6 deletions src/fsyntax.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -653,8 +653,8 @@ fun cookIntegerConstant (ctx : Context, env : Env, span, value : IntInf.int, ty)
)
end
else if T.eqTyName (tycon, Typing.primTyName_int32) then
let val lower = ~0x80000000 <= value
val upper = value <= 0x7fffffff
let val lower = TargetInfo.minInt32 <= value
val upper = value <= TargetInfo.maxInt32
in if lower andalso upper then
F.IntConstExp (value, toFTy (ctx, env, ty))
else
Expand All @@ -663,8 +663,8 @@ fun cookIntegerConstant (ctx : Context, env : Env, span, value : IntInf.int, ty)
)
end
else if T.eqTyName (tycon, Typing.primTyName_int54) then
let val lower = ~0x20000000000000 <= value
val upper = value <= 0x1fffffffffffff
let val lower = TargetInfo.minInt54 <= value
val upper = value <= TargetInfo.maxInt54
in if lower andalso upper then
F.IntConstExp (value, toFTy (ctx, env, ty))
else
Expand All @@ -673,8 +673,8 @@ fun cookIntegerConstant (ctx : Context, env : Env, span, value : IntInf.int, ty)
)
end
else if T.eqTyName (tycon, Typing.primTyName_int64) then
let val lower = ~0x8000000000000000 <= value
val upper = value <= 0x7fffffffffffffff
let val lower = TargetInfo.minInt64 <= value
val upper = value <= TargetInfo.maxInt54
in if lower andalso upper then
F.IntConstExp (value, toFTy (ctx, env, ty))
else
Expand Down
16 changes: 8 additions & 8 deletions src/main.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -65,22 +65,22 @@ fun getTargetInfo (opts : options) : TargetInfo.target_info
BACKEND_LUA _ => { defaultInt = Primitives.INT
, defaultWord = Primitives.WORD
, datatypeTag = TargetInfo.STRING8
, minInt = SOME ~0x8000000000000000
, maxInt = SOME 0x7fffffffffffffff
, minInt = SOME TargetInfo.minInt64
, maxInt = SOME TargetInfo.maxInt64
, wordSize = 64
}
| BACKEND_LUAJIT => { defaultInt = Primitives.I32 (* TODO: Use I54? *)
| BACKEND_LUAJIT => { defaultInt = Primitives.I54
, defaultWord = Primitives.W32
, datatypeTag = TargetInfo.STRING8
, minInt = SOME ~0x80000000
, maxInt = SOME 0x7fffffff
, minInt = SOME TargetInfo.minInt32
, maxInt = SOME TargetInfo.maxInt32
, wordSize = 32
}
| BACKEND_JS _ => { defaultInt = Primitives.I32 (* TODO: Use I54? *)
| BACKEND_JS _ => { defaultInt = Primitives.I54
, defaultWord = Primitives.W32
, datatypeTag = TargetInfo.STRING16
, minInt = SOME ~0x80000000
, maxInt = SOME 0x7fffffff
, minInt = SOME TargetInfo.minInt54
, maxInt = SOME TargetInfo.maxInt54
, wordSize = 32
}
)
Expand Down
Loading

0 comments on commit 0425787

Please sign in to comment.