diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index 140f7cf5542..6f9ddd6633a 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -97,7 +97,7 @@ module Const = struct | Bool of bool | Word32 of int32 | Word64 of int64 - | Float64 of Value.Float.t + | Float64 of Numerics.Float.t | Blob of string (* Constant known values. @@ -1593,6 +1593,8 @@ module TaggedSmallWord = struct let bitwidth_mask_of_type = function | Type.Word8 -> 0b111l | Type.Word16 -> 0b1111l + | Type.Nat8 -> 0b111l + | Type.Nat16 -> 0b1111l | p -> todo "bitwidth_mask_of_type" (Arrange_type.prim p) 0l let const_of_type ty n = Int32.(shift_left n (to_int (shift_of_type ty))) @@ -1603,7 +1605,7 @@ module TaggedSmallWord = struct (* Makes sure that we only shift/rotate the maximum number of bits available in the word. *) let clamp_shift_amount = function - | Type.Word32 -> G.nop + | Type.(Nat32|Word32) -> G.nop | ty -> compile_bitand_const (bitwidth_mask_of_type ty) let shift_leftWordNtoI32 = compile_shl_const @@ -2508,7 +2510,7 @@ module Prim = struct compile_shrS_const b ^^ prim_word32toInt env let prim_intToWord32 env = BigNum.truncate_to_word32 env - let prim_shiftToWordN env b = + let prim_intToWordNShifted env b = prim_intToWord32 env ^^ TaggedSmallWord.shift_leftWordNtoI32 b end (* Prim *) @@ -2850,7 +2852,7 @@ module Blob = struct E.call_import env "rts" "blob_iter_done" let iter_next env = E.call_import env "rts" "blob_iter_next" ^^ - TaggedSmallWord.msb_adjust Type.Word8 + TaggedSmallWord.msb_adjust Type.Nat8 let dyn_alloc_scratch env = alloc env ^^ payload_ptr_unskewed @@ -5972,28 +5974,29 @@ end (* AllocHow *) (* The actual compiler code that looks at the AST *) +(* wraps a bigint in range [0…2^64-1] into range [-2^63…2^63-1] *) let nat64_to_int64 n = let open Big_int in - let twoRaised63 = power_int_positive_int 2 63 in - let q, r = quomod_big_int (Value.Nat64.to_big_int n) twoRaised63 in - if sign_big_int q = 0 then r else sub_big_int r twoRaised63 + if ge_big_int n (power_int_positive_int 2 63) + then sub_big_int n (power_int_positive_int 2 64) + else n let const_lit_of_lit env : Ir.lit -> Const.lit = function | BoolLit b -> Const.Bool b | IntLit n - | NatLit n -> Const.BigInt n - | Word8Lit n -> Const.Vanilla (Value.Word8.to_bits n) (* already Msb-aligned *) - | Word16Lit n -> Const.Vanilla (Value.Word16.to_bits n) - | Word32Lit n -> Const.Word32 n - | Word64Lit n -> Const.Word64 n - | Int8Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Int8 (Value.Int_8.to_int n)) - | Nat8Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Nat8 (Value.Nat8.to_int n)) - | Int16Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Int16 (Value.Int_16.to_int n)) - | Nat16Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Nat16 (Value.Nat16.to_int n)) - | Int32Lit n -> Const.Word32 (Int32.of_int (Value.Int_32.to_int n)) - | Nat32Lit n -> Const.Word32 (Int32.of_int (Value.Nat32.to_int n)) - | Int64Lit n -> Const.Word64 (Big_int.int64_of_big_int (Value.Int_64.to_big_int n)) - | Nat64Lit n -> Const.Word64 (Big_int.int64_of_big_int (nat64_to_int64 n)) + | NatLit n -> Const.BigInt (Numerics.Nat.to_big_int n) + | Int8Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Int8 (Numerics.Int_8.to_int n)) + | Nat8Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Nat8 (Numerics.Nat8.to_int n)) + | Word8Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Word8 (Numerics.Word8.to_int n)) + | Int16Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Int16 (Numerics.Int_16.to_int n)) + | Nat16Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Nat16 (Numerics.Nat16.to_int n)) + | Word16Lit n -> Const.Vanilla (TaggedSmallWord.vanilla_lit Type.Word16 (Numerics.Word16.to_int n)) + | Int32Lit n -> Const.Word32 (Int32.of_int (Numerics.Int_32.to_int n)) + | Nat32Lit n -> Const.Word32 (Int32.of_int (Numerics.Nat32.to_int n)) + | Word32Lit n -> Const.Word32 (Int32.of_int (Numerics.Word32.to_int n)) + | Int64Lit n -> Const.Word64 (Big_int.int64_of_big_int (Numerics.Int_64.to_big_int n)) + | Nat64Lit n -> Const.Word64 (Big_int.int64_of_big_int (nat64_to_int64 (Numerics.Nat64.to_big_int n))) + | Word64Lit n -> Const.Word64 (Big_int.int64_of_big_int (nat64_to_int64 (Numerics.Word64.to_big_int n))) | CharLit c -> Const.Vanilla Int32.(shift_left (of_int c) 8) | NullLit -> Const.Vanilla (Opt.null_vanilla_lit env) | TextLit t @@ -6010,10 +6013,6 @@ let compile_lit_as env sr_out lit = let sr_in, code = compile_lit env lit in code ^^ StackRep.adjust env sr_in sr_out -let prim_of_typ ty = match Type.normalize ty with - | Type.Prim ty -> ty - | _ -> assert false - (* helper, traps with message *) let then_arithmetic_overflow env = E.then_trap_with env "arithmetic overflow" @@ -6788,42 +6787,47 @@ and compile_exp (env : E.t) ae exp = G.i Return (* Numeric conversions *) - | NumConvPrim (t1, t2), [e] -> begin + | NumConvWrapPrim (t1, t2), [e] -> begin let open Type in match t1, t2 with - | (Nat|Int), (Word8|Word16) -> + | (Nat|Int), (Nat8|Nat16|Int8|Int16|Word8|Word16) -> SR.Vanilla, compile_exp_vanilla env ae e ^^ - Prim.prim_shiftToWordN env (TaggedSmallWord.shift_of_type t2) + Prim.prim_intToWordNShifted env (TaggedSmallWord.shift_of_type t2) - | (Nat|Int), Word32 -> + | (Nat|Int), (Nat32|Int32|Word32) -> SR.UnboxedWord32, compile_exp_vanilla env ae e ^^ Prim.prim_intToWord32 env - | (Nat|Int), Word64 -> + | (Nat|Int), (Nat64|Int64|Word64) -> SR.UnboxedWord64, compile_exp_vanilla env ae e ^^ BigNum.truncate_to_word64 env - | Nat64, Word64 - | Int64, Word64 - | Word64, Nat64 - | Word64, Int64 - | Nat32, Word32 - | Int32, Word32 - | Word32, Nat32 - | Word32, Int32 - | Nat16, Word16 - | Int16, Word16 - | Word16, Nat16 - | Word16, Int16 - | Nat8, Word8 - | Int8, Word8 - | Word8, Nat8 - | Word8, Int8 -> + | Nat64, Word64 | Word64, Nat64 + | Nat32, Word32 | Word32, Nat32 + | Nat16, Word16 | Word16, Nat16 + | Nat8, Word8 | Word8, Nat8 + | Word64, Int64 | Int64, Word64 + | Word32, Int32 | Int32, Word32 + | Word16, Int16 | Int16, Word16 + | Word8, Int8 | Int8, Word8 + -> compile_exp env ae e + | Char, (Nat32|Word32) -> + SR.UnboxedWord32, + compile_exp_vanilla env ae e ^^ + TaggedSmallWord.untag_codepoint + + | _ -> SR.Unreachable, todo_trap env "compile_exp u" (Arrange_ir.exp exp) + end + + | NumConvTrapPrim (t1, t2), [e] -> begin + let open Type in + match t1, t2 with + | Int, Int64 -> SR.UnboxedWord64, compile_exp_vanilla env ae e ^^ @@ -6834,10 +6838,8 @@ and compile_exp (env : E.t) ae exp = get_n ^^ BigNum.truncate_to_word64 env) - | Int, (Int8|Int16|Int32) -> - let ty = exp.note.Note.typ in - StackRep.of_type ty, - let pty = prim_of_typ ty in + | Int, (Int8|Int16|Int32 as pty) -> + StackRep.of_type (Prim pty), compile_exp_vanilla env ae e ^^ Func.share_code1 env (prim_fun_name pty "Int->") ("n", I32Type) [I32Type] (fun env get_n -> get_n ^^ @@ -6857,10 +6859,8 @@ and compile_exp (env : E.t) ae exp = get_n ^^ BigNum.truncate_to_word64 env) - | Nat, (Nat8|Nat16|Nat32) -> - let ty = exp.note.Note.typ in - StackRep.of_type ty, - let pty = prim_of_typ ty in + | Nat, (Nat8|Nat16|Nat32 as pty) -> + StackRep.of_type (Prim pty), compile_exp_vanilla env ae e ^^ Func.share_code1 env (prim_fun_name pty "Nat->") ("n", I32Type) [I32Type] (fun env get_n -> get_n ^^ @@ -6870,11 +6870,6 @@ and compile_exp (env : E.t) ae exp = BigNum.truncate_to_word32 env ^^ TaggedSmallWord.msb_adjust pty) - | Char, Word32 -> - SR.UnboxedWord32, - compile_exp_vanilla env ae e ^^ - TaggedSmallWord.untag_codepoint - | (Nat8|Word8|Nat16|Word16), Nat -> SR.Vanilla, compile_exp_vanilla env ae e ^^ @@ -7124,12 +7119,12 @@ and compile_exp (env : E.t) ae exp = SR.Vanilla, compile_exp_vanilla env ae e ^^ G.i (Unary (Wasm.Values.I32 I32Op.Popcnt)) ^^ - TaggedSmallWord.msb_adjust Type.Word8 + TaggedSmallWord.msb_adjust Type.Nat8 | OtherPrim "popcnt16", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ G.i (Unary (Wasm.Values.I32 I32Op.Popcnt)) ^^ - TaggedSmallWord.msb_adjust Type.Word16 + TaggedSmallWord.msb_adjust Type.Nat16 | OtherPrim "popcnt32", [e] -> SR.UnboxedWord32, compile_exp_as env ae SR.UnboxedWord32 e ^^ @@ -7138,12 +7133,12 @@ and compile_exp (env : E.t) ae exp = SR.UnboxedWord64, compile_exp_as env ae SR.UnboxedWord64 e ^^ G.i (Unary (Wasm.Values.I64 I64Op.Popcnt)) - | OtherPrim "clz8", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.clz_kernel Type.Word8 - | OtherPrim "clz16", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.clz_kernel Type.Word16 + | OtherPrim "clz8", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.clz_kernel Type.Nat8 + | OtherPrim "clz16", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.clz_kernel Type.Nat16 | OtherPrim "clz32", [e] -> SR.UnboxedWord32, compile_exp_as env ae SR.UnboxedWord32 e ^^ G.i (Unary (Wasm.Values.I32 I32Op.Clz)) | OtherPrim "clz64", [e] -> SR.UnboxedWord64, compile_exp_as env ae SR.UnboxedWord64 e ^^ G.i (Unary (Wasm.Values.I64 I64Op.Clz)) - | OtherPrim "ctz8", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.ctz_kernel Type.Word8 - | OtherPrim "ctz16", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.ctz_kernel Type.Word16 + | OtherPrim "ctz8", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.ctz_kernel Type.Nat8 + | OtherPrim "ctz16", [e] -> SR.Vanilla, compile_exp_vanilla env ae e ^^ TaggedSmallWord.ctz_kernel Type.Nat16 | OtherPrim "ctz32", [e] -> SR.UnboxedWord32, compile_exp_as env ae SR.UnboxedWord32 e ^^ G.i (Unary (Wasm.Values.I32 I32Op.Ctz)) | OtherPrim "ctz64", [e] -> SR.UnboxedWord64, compile_exp_as env ae SR.UnboxedWord64 e ^^ G.i (Unary (Wasm.Values.I64 I64Op.Ctz)) @@ -7182,11 +7177,11 @@ and compile_exp (env : E.t) ae exp = const_sr SR.Vanilla (Arr.tabulate env) | OtherPrim "btst8", [_;_] -> (* TODO: btstN returns Bool, not a small value *) - const_sr SR.Vanilla (TaggedSmallWord.btst_kernel env Type.Word8) + const_sr SR.Vanilla (TaggedSmallWord.btst_kernel env Type.Nat8) | OtherPrim "btst16", [_;_] -> - const_sr SR.Vanilla (TaggedSmallWord.btst_kernel env Type.Word16) + const_sr SR.Vanilla (TaggedSmallWord.btst_kernel env Type.Nat16) | OtherPrim "btst32", [_;_] -> - const_sr SR.UnboxedWord32 (TaggedSmallWord.btst_kernel env Type.Word32) + const_sr SR.UnboxedWord32 (TaggedSmallWord.btst_kernel env Type.Nat32) | OtherPrim "btst64", [_;_] -> const_sr SR.UnboxedWord64 ( let (set_b, get_b) = new_local64 env "b" in @@ -7389,7 +7384,7 @@ and compile_exp (env : E.t) ae exp = compile_exp_as env ae SR.Vanilla exp_k ^^ set_k ^^ compile_exp_as env ae SR.Vanilla exp_r ^^ set_r ^^ - FuncDec.ic_call env Type.[Prim Word32] ts + FuncDec.ic_call env Type.[Prim Nat32] ts ( Dfinity.get_self_reference env ^^ Dfinity.actor_public_field env (Dfinity.async_method_name)) (get_closure_idx ^^ BoxedSmallWord.box env) diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml index 69116a9ae17..55b3902e761 100644 --- a/src/ir_def/arrange_ir.ml +++ b/src/ir_def/arrange_ir.ml @@ -70,7 +70,8 @@ and prim = function | ShowPrim t -> "ShowPrim" $$ [typ t] | SerializePrim t -> "SerializePrim" $$ List.map typ t | DeserializePrim t -> "DeserializePrim" $$ List.map typ t - | NumConvPrim (t1, t2) -> "NumConvPrim" $$ [prim_ty t1; prim_ty t2] + | NumConvWrapPrim (t1, t2) -> "NumConvWrapPrim" $$ [prim_ty t1; prim_ty t2] + | NumConvTrapPrim (t1, t2) -> "NumConvTrapPrim" $$ [prim_ty t1; prim_ty t2] | CastPrim (t1, t2) -> "CastPrim" $$ [typ t1; typ t2] | ActorOfIdBlob t -> "ActorOfIdBlob" $$ [typ t] | BlobOfIcUrl -> Atom "BlobOfIcUrl" @@ -110,21 +111,21 @@ and lit (l:lit) = match l with | NullLit -> Atom "NullLit" | BoolLit true -> "BoolLit" $$ [ Atom "true" ] | BoolLit false -> "BoolLit" $$ [ Atom "false" ] - | NatLit n -> "NatLit" $$ [ Atom (Value.Nat.to_pretty_string n) ] - | Nat8Lit w -> "Nat8Lit" $$ [ Atom (Value.Nat8.to_pretty_string w) ] - | Nat16Lit w -> "Nat16Lit" $$ [ Atom (Value.Nat16.to_pretty_string w) ] - | Nat32Lit w -> "Nat32Lit" $$ [ Atom (Value.Nat32.to_pretty_string w) ] - | Nat64Lit w -> "Nat64Lit" $$ [ Atom (Value.Nat64.to_pretty_string w) ] - | IntLit i -> "IntLit" $$ [ Atom (Value.Int.to_pretty_string i) ] - | Int8Lit w -> "Int8Lit" $$ [ Atom (Value.Int_8.to_pretty_string w) ] - | Int16Lit w -> "Int16Lit" $$ [ Atom (Value.Int_16.to_pretty_string w) ] - | Int32Lit w -> "Int32Lit" $$ [ Atom (Value.Int_32.to_pretty_string w) ] - | Int64Lit w -> "Int64Lit" $$ [ Atom (Value.Int_64.to_pretty_string w) ] - | Word8Lit w -> "Word8Lit" $$ [ Atom (Value.Word8.to_pretty_string w) ] - | Word16Lit w -> "Word16Lit" $$ [ Atom (Value.Word16.to_pretty_string w) ] - | Word32Lit w -> "Word32Lit" $$ [ Atom (Value.Word32.to_pretty_string w) ] - | Word64Lit w -> "Word64Lit" $$ [ Atom (Value.Word64.to_pretty_string w) ] - | FloatLit f -> "FloatLit" $$ [ Atom (Value.Float.to_pretty_string f) ] + | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] + | Nat8Lit w -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string w) ] + | Nat16Lit w -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string w) ] + | Nat32Lit w -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string w) ] + | Nat64Lit w -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string w) ] + | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] + | Int8Lit w -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string w) ] + | Int16Lit w -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string w) ] + | Int32Lit w -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string w) ] + | Int64Lit w -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string w) ] + | Word8Lit w -> "Word8Lit" $$ [ Atom (Numerics.Word8.to_pretty_string w) ] + | Word16Lit w -> "Word16Lit" $$ [ Atom (Numerics.Word16.to_pretty_string w) ] + | Word32Lit w -> "Word32Lit" $$ [ Atom (Numerics.Word32.to_pretty_string w) ] + | Word64Lit w -> "Word64Lit" $$ [ Atom (Numerics.Word64.to_pretty_string w) ] + | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] | TextLit t -> "TextLit" $$ [ Atom t ] | BlobLit b -> "BlobLit" $$ [ Atom (Printf.sprintf "%S" b) ] (* hex might be nicer *) diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml index ad246c45686..d0450c36283 100644 --- a/src/ir_def/check_ir.ml +++ b/src/ir_def/check_ir.ml @@ -554,8 +554,12 @@ let rec check_exp env (exp:Ir.exp) : unit = check (store_typ t1) "Invalid type argument to ICStableWrite"; typ exp1 <: t1; T.unit <: t - | NumConvPrim (p1, p2), [e] -> - (* we could check if this conversion is supported *) + | NumConvWrapPrim (p1, p2), [e] -> + (* we should check if this conversion is supported *) + typ e <: T.Prim p1; + T.Prim p2 <: t + | NumConvTrapPrim (p1, p2), [e] -> + (* we should check if this conversion is supported *) typ e <: T.Prim p1; T.Prim p2 <: t | CastPrim (t1, t2), [e] -> diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml index 4bdde08b32f..ec91abfee9b 100644 --- a/src/ir_def/ir.ml +++ b/src/ir_def/ir.ml @@ -8,21 +8,21 @@ type id = string type lit = | NullLit | BoolLit of bool - | NatLit of Value.Nat.t - | Nat8Lit of Value.Nat8.t - | Nat16Lit of Value.Nat16.t - | Nat32Lit of Value.Nat32.t - | Nat64Lit of Value.Nat64.t - | IntLit of Value.Int.t - | Int8Lit of Value.Int_8.t - | Int16Lit of Value.Int_16.t - | Int32Lit of Value.Int_32.t - | Int64Lit of Value.Int_64.t - | Word8Lit of Value.Word8.t - | Word16Lit of Value.Word16.t - | Word32Lit of Value.Word32.t - | Word64Lit of Value.Word64.t - | FloatLit of Value.Float.t + | NatLit of Numerics.Nat.t + | Nat8Lit of Numerics.Nat8.t + | Nat16Lit of Numerics.Nat16.t + | Nat32Lit of Numerics.Nat32.t + | Nat64Lit of Numerics.Nat64.t + | IntLit of Numerics.Int.t + | Int8Lit of Numerics.Int_8.t + | Int16Lit of Numerics.Int_16.t + | Int32Lit of Numerics.Int_32.t + | Int64Lit of Numerics.Int_64.t + | Word8Lit of Numerics.Word8.t + | Word16Lit of Numerics.Word16.t + | Word32Lit of Numerics.Word32.t + | Word64Lit of Numerics.Word64.t + | FloatLit of Numerics.Float.t | CharLit of Value.unicode | TextLit of string | BlobLit of string @@ -122,7 +122,8 @@ and prim = | ShowPrim of Type.typ (* debug_show *) | SerializePrim of Type.typ list (* Candid serialization prim *) | DeserializePrim of Type.typ list (* Candid deserialization prim *) - | NumConvPrim of Type.prim * Type.prim + | NumConvTrapPrim of Type.prim * Type.prim + | NumConvWrapPrim of Type.prim * Type.prim | CastPrim of Type.typ * Type.typ (* representationally a noop *) | ActorOfIdBlob of Type.typ | BlobOfIcUrl (* traps on syntax or checksum failure *) @@ -162,24 +163,24 @@ let string_of_lit = function | BoolLit false -> "false" | BoolLit true -> "true" | IntLit n - | NatLit n -> Value.Int.to_pretty_string n - | Int8Lit n -> Value.Int_8.to_pretty_string n - | Int16Lit n -> Value.Int_16.to_pretty_string n - | Int32Lit n -> Value.Int_32.to_pretty_string n - | Int64Lit n -> Value.Int_64.to_pretty_string n - | Nat8Lit n -> Value.Nat8.to_pretty_string n - | Nat16Lit n -> Value.Nat16.to_pretty_string n - | Nat32Lit n -> Value.Nat32.to_pretty_string n - | Nat64Lit n -> Value.Nat64.to_pretty_string n - | Word8Lit n -> Value.Word8.to_pretty_string n - | Word16Lit n -> Value.Word16.to_pretty_string n - | Word32Lit n -> Value.Word32.to_pretty_string n - | Word64Lit n -> Value.Word64.to_pretty_string n + | NatLit n -> Numerics.Int.to_pretty_string n + | Int8Lit n -> Numerics.Int_8.to_pretty_string n + | Int16Lit n -> Numerics.Int_16.to_pretty_string n + | Int32Lit n -> Numerics.Int_32.to_pretty_string n + | Int64Lit n -> Numerics.Int_64.to_pretty_string n + | Nat8Lit n -> Numerics.Nat8.to_pretty_string n + | Nat16Lit n -> Numerics.Nat16.to_pretty_string n + | Nat32Lit n -> Numerics.Nat32.to_pretty_string n + | Nat64Lit n -> Numerics.Nat64.to_pretty_string n + | Word8Lit n -> Numerics.Word8.to_pretty_string n + | Word16Lit n -> Numerics.Word16.to_pretty_string n + | Word32Lit n -> Numerics.Word32.to_pretty_string n + | Word64Lit n -> Numerics.Word64.to_pretty_string n | CharLit c -> string_of_int c | NullLit -> "null" | TextLit t -> t | BlobLit b -> Printf.sprintf "%s" b - | FloatLit f -> Value.Float.to_pretty_string f + | FloatLit f -> Numerics.Float.to_pretty_string f (* Flavor *) diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml index 293f8022f4e..47c5e069ca9 100644 --- a/src/ir_interpreter/interpret_ir.ml +++ b/src/ir_interpreter/interpret_ir.ml @@ -356,7 +356,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) = | Const -> vs in k (V.Array (Array.of_list vs')) | IdxPrim, [v1; v2] -> - k (try (V.as_array v1).(V.Int.to_int (V.as_int v2)) + k (try (V.as_array v1).(Numerics.Int.to_int (V.as_int v2)) with Invalid_argument s -> trap exp.at "%s" s) | BreakPrim id, [v1] -> find id env.labs v1 | RetPrim, [v1] -> Option.get env.rets v1 @@ -415,9 +415,12 @@ and interpret_exp_mut env exp (k : V.value V.cont) = end | IcUrlOfBlob, [v1] -> k (V.Text (Ic.Url.encode_principal (V.as_blob v1))) - | NumConvPrim (t1, t2), vs -> + | NumConvTrapPrim (t1, t2), vs -> let arg = match vs with [v] -> v | _ -> V.Tup vs in - k (try Prim.num_conv_prim t1 t2 arg with Invalid_argument s -> trap exp.at "%s" s) + k (try Prim.num_conv_trap_prim t1 t2 arg with Invalid_argument s -> trap exp.at "%s" s) + | NumConvWrapPrim (t1, t2), vs -> + let arg = match vs with [v] -> v | _ -> V.Tup vs in + k (try Prim.num_conv_wrap_prim t1 t2 arg with Invalid_argument s -> trap exp.at "%s" s) | ICReplyPrim ts, [v1] -> assert (not env.flavor.has_async_typ); let reply = Option.get env.replies in @@ -448,9 +451,9 @@ and interpret_exp_mut env exp (k : V.value V.cont) = | SelfRef _, [] -> k (V.Text env.self) | SystemTimePrim, [] -> - k (V.Nat64 (Value.Nat64.of_int 42)) + k (V.Nat64 (Numerics.Nat64.of_int 42)) | SystemCyclesRefundedPrim, [] -> (* faking it *) - k (V.Nat64 (Value.Nat64.of_int 0)) + k (V.Nat64 (Numerics.Nat64.of_int 0)) | _ -> trap exp.at "Unknown prim or wrong number of arguments (%d given):\n %s" (List.length es) (Wasm.Sexpr.to_string 80 (Arrange_ir.prim p)) @@ -567,7 +570,7 @@ and interpret_lexp env lexp (k : (V.value ref) V.cont) = interpret_exp env exp1 (fun v1 -> interpret_exp env exp2 (fun v2 -> k (V.as_mut - (try (V.as_array v1).(V.Int.to_int (V.as_int v2)) + (try (V.as_array v1).(Numerics.Int.to_int (V.as_int v2)) with Invalid_argument s -> trap lexp.at "%s" s)) ) ) @@ -684,16 +687,16 @@ and match_lit lit v : bool = match lit, v with | NullLit, V.Null -> true | BoolLit b, V.Bool b' -> b = b' - | NatLit n, V.Int n' -> V.Int.eq n n' - | Nat8Lit n, V.Nat8 n' -> V.Nat8.eq n n' - | Nat16Lit n, V.Nat16 n' -> V.Nat16.eq n n' - | Nat32Lit n, V.Nat32 n' -> V.Nat32.eq n n' - | Nat64Lit n, V.Nat64 n' -> V.Nat64.eq n n' - | IntLit i, V.Int i' -> V.Int.eq i i' - | Int8Lit i, V.Int8 i' -> V.Int_8.eq i i' - | Int16Lit i, V.Int16 i' -> V.Int_16.eq i i' - | Int32Lit i, V.Int32 i' -> V.Int_32.eq i i' - | Int64Lit i, V.Int64 i' -> V.Int_64.eq i i' + | NatLit n, V.Int n' -> Numerics.Int.eq n n' + | Nat8Lit n, V.Nat8 n' -> Numerics.Nat8.eq n n' + | Nat16Lit n, V.Nat16 n' -> Numerics.Nat16.eq n n' + | Nat32Lit n, V.Nat32 n' -> Numerics.Nat32.eq n n' + | Nat64Lit n, V.Nat64 n' -> Numerics.Nat64.eq n n' + | IntLit i, V.Int i' -> Numerics.Int.eq i i' + | Int8Lit i, V.Int8 i' -> Numerics.Int_8.eq i i' + | Int16Lit i, V.Int16 i' -> Numerics.Int_16.eq i i' + | Int32Lit i, V.Int32 i' -> Numerics.Int_32.eq i i' + | Int64Lit i, V.Int64 i' -> Numerics.Int_64.eq i i' | Word8Lit w, V.Word8 w' -> w = w' | Word16Lit w, V.Word16 w' -> w = w' | Word32Lit w, V.Word32 w' -> w = w' diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml index 03662ad3a0a..e81dd9cfa0f 100644 --- a/src/ir_passes/async.ml +++ b/src/ir_passes/async.ml @@ -211,7 +211,8 @@ let transform mode prog = | RelPrim (ot, op) -> RelPrim (t_typ ot, op) | ArrayPrim (m, t) -> ArrayPrim (m, t_typ t) | ShowPrim ot -> ShowPrim (t_typ ot) - | NumConvPrim (t1,t2) -> NumConvPrim (t1,t2) + | NumConvWrapPrim (t1,t2) -> NumConvWrapPrim (t1,t2) + | NumConvTrapPrim (t1,t2) -> NumConvTrapPrim (t1,t2) | CastPrim (t1,t2) -> CastPrim (t_typ t1,t_typ t2) | ActorOfIdBlob t -> ActorOfIdBlob (t_typ t) | ICReplyPrim ts -> ICReplyPrim (List.map t_typ ts) diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml index b86cc21db88..148a95cbe4d 100644 --- a/src/lowering/desugar.ml +++ b/src/lowering/desugar.ml @@ -23,11 +23,11 @@ let id_of_full_path (fp : string) : string = let apply_sign op l = Syntax.(match op, l with | PosOp, l -> l - | NegOp, (NatLit n | IntLit n) -> IntLit (Value.Int.sub Value.Int.zero n) - | NegOp, Int8Lit n -> Int8Lit (Value.Int_8.sub Value.Int_8.zero n) - | NegOp, Int16Lit n -> Int16Lit (Value.Int_16.sub Value.Int_16.zero n) - | NegOp, Int32Lit n -> Int32Lit (Value.Int_32.sub Value.Int_32.zero n) - | NegOp, Int64Lit n -> Int64Lit (Value.Int_64.sub Value.Int_64.zero n) + | NegOp, (NatLit n | IntLit n) -> IntLit (Numerics.Int.sub Numerics.Int.zero n) + | NegOp, Int8Lit n -> Int8Lit (Numerics.Int_8.sub Numerics.Int_8.zero n) + | NegOp, Int16Lit n -> Int16Lit (Numerics.Int_16.sub Numerics.Int_16.zero n) + | NegOp, Int32Lit n -> Int32Lit (Numerics.Int_32.sub Numerics.Int_32.zero n) + | NegOp, Int64Lit n -> Int64Lit (Numerics.Int_64.sub Numerics.Int_64.zero n) | _, _ -> raise (Invalid_argument "Invalid signed pattern") ) @@ -116,10 +116,19 @@ and exp' at note = function | S.CallE ({it=S.AnnotE ({it=S.PrimE p;_}, _);note;_}, _, e) when Lib.String.chop_prefix "num_conv" p <> None -> begin match String.split_on_char '_' p with - | ["num";"conv";s1;s2] -> + | ["num"; "conv"; s1; s2] -> let p1 = Type.prim s1 in let p2 = Type.prim s2 in - I.PrimE (I.NumConvPrim (p1, p2), [exp e]) + I.PrimE (I.NumConvTrapPrim (p1, p2), [exp e]) + | _ -> assert false + end + | S.CallE ({it=S.AnnotE ({it=S.PrimE p;_}, _);note;_}, _, e) + when Lib.String.chop_prefix "num_wrap" p <> None -> + begin match String.split_on_char '_' p with + | ["num"; "wrap"; s1; s2] -> + let p1 = Type.prim s1 in + let p2 = Type.prim s2 in + I.PrimE (I.NumConvWrapPrim (p1, p2), [exp e]) | _ -> assert false end | S.CallE ({it=S.AnnotE ({it=S.PrimE "cast";_}, _);note;_}, _, e) -> diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml index 3d119424bf8..e5a9d4a6b45 100644 --- a/src/mo_def/arrange.ml +++ b/src/mo_def/arrange.ml @@ -87,21 +87,21 @@ and lit (l:lit) = match l with | NullLit -> Atom "NullLit" | BoolLit true -> "BoolLit" $$ [ Atom "true" ] | BoolLit false -> "BoolLit" $$ [ Atom "false" ] - | NatLit n -> "NatLit" $$ [ Atom (Value.Nat.to_pretty_string n) ] - | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Value.Nat8.to_pretty_string n) ] - | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Value.Nat16.to_pretty_string n) ] - | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Value.Nat32.to_pretty_string n) ] - | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Value.Nat64.to_pretty_string n) ] - | IntLit i -> "IntLit" $$ [ Atom (Value.Int.to_pretty_string i) ] - | Int8Lit i -> "Int8Lit" $$ [ Atom (Value.Int_8.to_pretty_string i) ] - | Int16Lit i -> "Int16Lit" $$ [ Atom (Value.Int_16.to_pretty_string i) ] - | Int32Lit i -> "Int32Lit" $$ [ Atom (Value.Int_32.to_pretty_string i) ] - | Int64Lit i -> "Int64Lit" $$ [ Atom (Value.Int_64.to_pretty_string i) ] - | Word8Lit w -> "Word8Lit" $$ [ Atom (Value.Word8.to_pretty_string w) ] - | Word16Lit w -> "Word16Lit" $$ [ Atom (Value.Word16.to_pretty_string w) ] - | Word32Lit w -> "Word32Lit" $$ [ Atom (Value.Word32.to_pretty_string w) ] - | Word64Lit w -> "Word64Lit" $$ [ Atom (Value.Word64.to_pretty_string w) ] - | FloatLit f -> "FloatLit" $$ [ Atom (Value.Float.to_pretty_string f) ] + | NatLit n -> "NatLit" $$ [ Atom (Numerics.Nat.to_pretty_string n) ] + | Nat8Lit n -> "Nat8Lit" $$ [ Atom (Numerics.Nat8.to_pretty_string n) ] + | Nat16Lit n -> "Nat16Lit" $$ [ Atom (Numerics.Nat16.to_pretty_string n) ] + | Nat32Lit n -> "Nat32Lit" $$ [ Atom (Numerics.Nat32.to_pretty_string n) ] + | Nat64Lit n -> "Nat64Lit" $$ [ Atom (Numerics.Nat64.to_pretty_string n) ] + | IntLit i -> "IntLit" $$ [ Atom (Numerics.Int.to_pretty_string i) ] + | Int8Lit i -> "Int8Lit" $$ [ Atom (Numerics.Int_8.to_pretty_string i) ] + | Int16Lit i -> "Int16Lit" $$ [ Atom (Numerics.Int_16.to_pretty_string i) ] + | Int32Lit i -> "Int32Lit" $$ [ Atom (Numerics.Int_32.to_pretty_string i) ] + | Int64Lit i -> "Int64Lit" $$ [ Atom (Numerics.Int_64.to_pretty_string i) ] + | Word8Lit w -> "Word8Lit" $$ [ Atom (Numerics.Word8.to_pretty_string w) ] + | Word16Lit w -> "Word16Lit" $$ [ Atom (Numerics.Word16.to_pretty_string w) ] + | Word32Lit w -> "Word32Lit" $$ [ Atom (Numerics.Word32.to_pretty_string w) ] + | Word64Lit w -> "Word64Lit" $$ [ Atom (Numerics.Word64.to_pretty_string w) ] + | FloatLit f -> "FloatLit" $$ [ Atom (Numerics.Float.to_pretty_string f) ] | CharLit c -> "CharLit" $$ [ Atom (string_of_int c) ] | TextLit t -> "TextLit" $$ [ Atom t ] | BlobLit b -> "BlobLit" $$ [ Atom b ] diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml index 9a4b0f5f9dd..c940f8a93b4 100644 --- a/src/mo_def/syntax.ml +++ b/src/mo_def/syntax.ml @@ -70,21 +70,21 @@ and typ_item = id option * typ type lit = | NullLit | BoolLit of bool - | NatLit of Value.Nat.t - | Nat8Lit of Value.Nat8.t - | Nat16Lit of Value.Nat16.t - | Nat32Lit of Value.Nat32.t - | Nat64Lit of Value.Nat64.t - | IntLit of Value.Int.t - | Int8Lit of Value.Int_8.t - | Int16Lit of Value.Int_16.t - | Int32Lit of Value.Int_32.t - | Int64Lit of Value.Int_64.t - | Word8Lit of Value.Word8.t - | Word16Lit of Value.Word16.t - | Word32Lit of Value.Word32.t - | Word64Lit of Value.Word64.t - | FloatLit of Value.Float.t + | NatLit of Numerics.Nat.t + | Nat8Lit of Numerics.Nat8.t + | Nat16Lit of Numerics.Nat16.t + | Nat32Lit of Numerics.Nat32.t + | Nat64Lit of Numerics.Nat64.t + | IntLit of Numerics.Int.t + | Int8Lit of Numerics.Int_8.t + | Int16Lit of Numerics.Int_16.t + | Int32Lit of Numerics.Int_32.t + | Int64Lit of Numerics.Int_64.t + | Word8Lit of Numerics.Word8.t + | Word16Lit of Numerics.Word16.t + | Word32Lit of Numerics.Word32.t + | Word64Lit of Numerics.Word64.t + | FloatLit of Numerics.Float.t | CharLit of Value.unicode | TextLit of string | BlobLit of string @@ -249,24 +249,24 @@ let string_of_lit = function | BoolLit false -> "false" | BoolLit true -> "true" | IntLit n - | NatLit n -> Value.Int.to_pretty_string n - | Int8Lit n -> Value.Int_8.to_pretty_string n - | Int16Lit n -> Value.Int_16.to_pretty_string n - | Int32Lit n -> Value.Int_32.to_pretty_string n - | Int64Lit n -> Value.Int_64.to_pretty_string n - | Nat8Lit n -> Value.Nat8.to_pretty_string n - | Nat16Lit n -> Value.Nat16.to_pretty_string n - | Nat32Lit n -> Value.Nat32.to_pretty_string n - | Nat64Lit n -> Value.Nat64.to_pretty_string n - | Word8Lit n -> Value.Word8.to_pretty_string n - | Word16Lit n -> Value.Word16.to_pretty_string n - | Word32Lit n -> Value.Word32.to_pretty_string n - | Word64Lit n -> Value.Word64.to_pretty_string n + | NatLit n -> Numerics.Int.to_pretty_string n + | Int8Lit n -> Numerics.Int_8.to_pretty_string n + | Int16Lit n -> Numerics.Int_16.to_pretty_string n + | Int32Lit n -> Numerics.Int_32.to_pretty_string n + | Int64Lit n -> Numerics.Int_64.to_pretty_string n + | Nat8Lit n -> Numerics.Nat8.to_pretty_string n + | Nat16Lit n -> Numerics.Nat16.to_pretty_string n + | Nat32Lit n -> Numerics.Nat32.to_pretty_string n + | Nat64Lit n -> Numerics.Nat64.to_pretty_string n + | Word8Lit n -> Numerics.Word8.to_pretty_string n + | Word16Lit n -> Numerics.Word16.to_pretty_string n + | Word32Lit n -> Numerics.Word32.to_pretty_string n + | Word64Lit n -> Numerics.Word64.to_pretty_string n | CharLit c -> string_of_int c | NullLit -> "null" | TextLit t -> t | BlobLit b -> b - | FloatLit f -> Value.Float.to_pretty_string f + | FloatLit f -> Numerics.Float.to_pretty_string f | PreLit _ -> assert false diff --git a/src/mo_frontend/coverage.ml b/src/mo_frontend/coverage.ml index 527133ef047..9e651b5a662 100644 --- a/src/mo_frontend/coverage.ml +++ b/src/mo_frontend/coverage.ml @@ -54,14 +54,14 @@ let make_sets () = let max_expand = 2 -let pick_nat (type t) (module Num : V.NumType with type t = t) to_val vs = +let pick_nat (type t) (module Num : Numerics.NumType with type t = t) to_val vs = let x = ref Num.zero in while ValSet.mem (to_val !x) vs do x := Num.add (Num.of_int 1) !x done; Val (to_val !x) -let pick_int (type t) (module Num : V.NumType with type t = t) to_val vs = +let pick_int (type t) (module Num : Numerics.NumType with type t = t) to_val vs = let x = ref Num.zero in while ValSet.mem (to_val !x) vs do x := Num.neg !x; @@ -69,10 +69,10 @@ let pick_int (type t) (module Num : V.NumType with type t = t) to_val vs = done; Val (to_val !x) -let pick_word (type t) (module Word : V.WordType with type t = t) to_val vs = - let x = ref Word.zero in +let pick_word (type t) (module Num : Numerics.NumType with type t = t) to_val vs = + let x = ref Num.zero in while ValSet.mem (to_val !x) vs do - x := Word.add (Word.of_int_u 1) !x + x := Num.add (Num.of_int 1) !x done; Val (to_val !x) @@ -86,20 +86,20 @@ let pick_char vs = let pick_val vs = function | T.Null -> assert false | T.Bool -> Val (V.Bool (ValSet.mem (V.Bool false) vs)) - | T.Nat -> pick_nat (module V.Nat) (fun x -> V.Int x) vs - | T.Nat8 -> pick_nat (module V.Nat8) (fun x -> V.Nat8 x) vs - | T.Nat16 -> pick_nat (module V.Nat16) (fun x -> V.Nat16 x) vs - | T.Nat32 -> pick_nat (module V.Nat32) (fun x -> V.Nat32 x) vs - | T.Nat64 -> pick_nat (module V.Nat64) (fun x -> V.Nat64 x) vs - | T.Int -> pick_int (module V.Int) (fun x -> V.Int x) vs - | T.Int8 -> pick_int (module V.Int_8) (fun x -> V.Int8 x) vs - | T.Int16 -> pick_int (module V.Int_16) (fun x -> V.Int16 x) vs - | T.Int32 -> pick_int (module V.Int_32) (fun x -> V.Int32 x) vs - | T.Int64 -> pick_int (module V.Int_64) (fun x -> V.Int64 x) vs - | T.Word8 -> pick_word (module V.Word8) (fun x -> V.Word8 x) vs - | T.Word16 -> pick_word (module V.Word16) (fun x -> V.Word16 x) vs - | T.Word32 -> pick_word (module V.Word32) (fun x -> V.Word32 x) vs - | T.Word64 -> pick_word (module V.Word64) (fun x -> V.Word64 x) vs + | T.Nat -> pick_nat (module Numerics.Nat) (fun x -> V.Int x) vs + | T.Nat8 -> pick_nat (module Numerics.Nat8) (fun x -> V.Nat8 x) vs + | T.Nat16 -> pick_nat (module Numerics.Nat16) (fun x -> V.Nat16 x) vs + | T.Nat32 -> pick_nat (module Numerics.Nat32) (fun x -> V.Nat32 x) vs + | T.Nat64 -> pick_nat (module Numerics.Nat64) (fun x -> V.Nat64 x) vs + | T.Int -> pick_int (module Numerics.Int) (fun x -> V.Int x) vs + | T.Int8 -> pick_int (module Numerics.Int_8) (fun x -> V.Int8 x) vs + | T.Int16 -> pick_int (module Numerics.Int_16) (fun x -> V.Int16 x) vs + | T.Int32 -> pick_int (module Numerics.Int_32) (fun x -> V.Int32 x) vs + | T.Int64 -> pick_int (module Numerics.Int_64) (fun x -> V.Int64 x) vs + | T.Word8 -> pick_word (module Numerics.Word8) (fun x -> V.Word8 x) vs + | T.Word16 -> pick_word (module Numerics.Word16) (fun x -> V.Word16 x) vs + | T.Word32 -> pick_word (module Numerics.Word32) (fun x -> V.Word32 x) vs + | T.Word64 -> pick_word (module Numerics.Word64) (fun x -> V.Word64 x) vs | T.Char -> pick_char vs | T.Text | T.Blob diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml index 71df26814c5..ef87fef3496 100644 --- a/src/mo_frontend/typing.ml +++ b/src/mo_frontend/typing.ml @@ -595,25 +595,25 @@ and check_inst_bounds env tbs inst at = (* Literals *) let check_lit_val env t of_string at s = - try of_string s with _ -> + try of_string s with Invalid_argument _ -> error env at "M0048" "literal out of range for type %s" (T.string_of_typ (T.Prim t)) -let check_nat env = check_lit_val env T.Nat Value.Nat.of_string -let check_nat8 env = check_lit_val env T.Nat8 Value.Nat8.of_string -let check_nat16 env = check_lit_val env T.Nat16 Value.Nat16.of_string -let check_nat32 env = check_lit_val env T.Nat32 Value.Nat32.of_string -let check_nat64 env = check_lit_val env T.Nat64 Value.Nat64.of_string -let check_int env = check_lit_val env T.Int Value.Int.of_string -let check_int8 env = check_lit_val env T.Int8 Value.Int_8.of_string -let check_int16 env = check_lit_val env T.Int16 Value.Int_16.of_string -let check_int32 env = check_lit_val env T.Int32 Value.Int_32.of_string -let check_int64 env = check_lit_val env T.Int64 Value.Int_64.of_string -let check_word8 env = check_lit_val env T.Word8 Value.Word8.of_string -let check_word16 env = check_lit_val env T.Word16 Value.Word16.of_string -let check_word32 env = check_lit_val env T.Word32 Value.Word32.of_string -let check_word64 env = check_lit_val env T.Word64 Value.Word64.of_string -let check_float env = check_lit_val env T.Float Value.Float.of_string +let check_nat env = check_lit_val env T.Nat Numerics.Nat.of_string +let check_nat8 env = check_lit_val env T.Nat8 Numerics.Nat8.of_string +let check_nat16 env = check_lit_val env T.Nat16 Numerics.Nat16.of_string +let check_nat32 env = check_lit_val env T.Nat32 Numerics.Nat32.of_string +let check_nat64 env = check_lit_val env T.Nat64 Numerics.Nat64.of_string +let check_int env = check_lit_val env T.Int Numerics.Int.of_string +let check_int8 env = check_lit_val env T.Int8 Numerics.Int_8.of_string +let check_int16 env = check_lit_val env T.Int16 Numerics.Int_16.of_string +let check_int32 env = check_lit_val env T.Int32 Numerics.Int_32.of_string +let check_int64 env = check_lit_val env T.Int64 Numerics.Int_64.of_string +let check_word8 env = check_lit_val env T.Word8 Numerics.Word8.of_string +let check_word16 env = check_lit_val env T.Word16 Numerics.Word16.of_string +let check_word32 env = check_lit_val env T.Word32 Numerics.Word32.of_string +let check_word64 env = check_lit_val env T.Word64 Numerics.Word64.of_string +let check_float env = check_lit_val env T.Float Numerics.Float.of_string let check_text env at s = (try ignore (Wasm.Utf8.decode s) diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml index 09aabdc7f85..fc691906a53 100644 --- a/src/mo_interpreter/interpret.ml +++ b/src/mo_interpreter/interpret.ml @@ -248,8 +248,8 @@ let interpret_lit env lit : V.value = let array_get a at = V.local_func 1 1 (fun c v k -> let n = V.as_int v in - if V.Nat.lt n (V.Nat.of_int (Array.length a)) - then k (a.(V.Nat.to_int n)) + if Numerics.Nat.lt n (Numerics.Nat.of_int (Array.length a)) + then k (a.(Numerics.Nat.to_int n)) else trap at "array index out of bounds" ) @@ -257,15 +257,15 @@ let array_put a at = V.local_func 2 0 (fun c v k -> let v1, v2 = V.as_pair v in let n = V.as_int v1 in - if V.Nat.lt n (V.Nat.of_int (Array.length a)) - then k (a.(V.Nat.to_int n) <- v2; V.Tup []) + if Numerics.Nat.lt n (Numerics.Nat.of_int (Array.length a)) + then k (a.(Numerics.Nat.to_int n) <- v2; V.Tup []) else trap at "array index out of bounds" ) let array_size a at = V.local_func 0 1 (fun c v k -> V.as_unit v; - k (V.Int (V.Nat.of_int (Array.length a))) + k (V.Int (Numerics.Nat.of_int (Array.length a))) ) let array_keys a at = @@ -276,7 +276,7 @@ let array_keys a at = V.local_func 0 1 (fun c v k' -> if !i = Array.length a then k' V.Null - else let v = V.Opt (V.Int (V.Nat.of_int !i)) in incr i; k' v + else let v = V.Opt (V.Int (Numerics.Nat.of_int !i)) in incr i; k' v ) in k (V.Obj (V.Env.singleton "next" next)) ) @@ -302,7 +302,7 @@ let blob_bytes t at = V.local_func 0 1 (fun c v k' -> if !i = String.length t then k' V.Null - else let v = V.Opt V.(Word8 (Word8.of_int_u (Char.code (String.get t !i)))) in incr i; k' v + else let v = V.Opt V.(Word8 (Numerics.Word8.of_int (Char.code (String.get t !i)))) in incr i; k' v ) in k (V.Obj (V.Env.singleton "next" next)) ) @@ -310,7 +310,7 @@ let blob_bytes t at = let blob_size t at = V.local_func 0 1 (fun c v k -> V.as_unit v; - k (V.Int (V.Nat.of_int (String.length t))) + k (V.Int (Numerics.Nat.of_int (String.length t))) ) let text_chars t at = @@ -330,7 +330,7 @@ let text_chars t at = let text_len t at = V.local_func 0 1 (fun c v k -> V.as_unit v; - k (V.Int (V.Nat.of_int (List.length (Wasm.Utf8.decode t)))) + k (V.Int (Numerics.Nat.of_int (List.length (Wasm.Utf8.decode t)))) ) (* Expressions *) @@ -488,7 +488,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) = | IdxE (exp1, exp2) -> interpret_exp env exp1 (fun v1 -> interpret_exp env exp2 (fun v2 -> - k (try (V.as_array v1).(V.Int.to_int (V.as_int v2)) + k (try (V.as_array v1).(Numerics.Int.to_int (V.as_int v2)) with Invalid_argument s -> trap exp.at "%s" s) ) ) @@ -729,16 +729,16 @@ and match_lit lit v : bool = match !lit, v with | NullLit, V.Null -> true | BoolLit b, V.Bool b' -> b = b' - | NatLit n, V.Int n' -> V.Int.eq n n' - | Nat8Lit n, V.Nat8 n' -> V.Nat8.eq n n' - | Nat16Lit n, V.Nat16 n' -> V.Nat16.eq n n' - | Nat32Lit n, V.Nat32 n' -> V.Nat32.eq n n' - | Nat64Lit n, V.Nat64 n' -> V.Nat64.eq n n' - | IntLit i, V.Int i' -> V.Int.eq i i' - | Int8Lit i, V.Int8 i' -> V.Int_8.eq i i' - | Int16Lit i, V.Int16 i' -> V.Int_16.eq i i' - | Int32Lit i, V.Int32 i' -> V.Int_32.eq i i' - | Int64Lit i, V.Int64 i' -> V.Int_64.eq i i' + | NatLit n, V.Int n' -> Numerics.Int.eq n n' + | Nat8Lit n, V.Nat8 n' -> Numerics.Nat8.eq n n' + | Nat16Lit n, V.Nat16 n' -> Numerics.Nat16.eq n n' + | Nat32Lit n, V.Nat32 n' -> Numerics.Nat32.eq n n' + | Nat64Lit n, V.Nat64 n' -> Numerics.Nat64.eq n n' + | IntLit i, V.Int i' -> Numerics.Int.eq i i' + | Int8Lit i, V.Int8 i' -> Numerics.Int_8.eq i i' + | Int16Lit i, V.Int16 i' -> Numerics.Int_16.eq i i' + | Int32Lit i, V.Int32 i' -> Numerics.Int_32.eq i i' + | Int64Lit i, V.Int64 i' -> Numerics.Int_64.eq i i' | Word8Lit w, V.Word8 w' -> w = w' | Word16Lit w, V.Word16 w' -> w = w' | Word32Lit w, V.Word32 w' -> w = w' diff --git a/src/mo_values/numerics.ml b/src/mo_values/numerics.ml new file mode 100644 index 00000000000..082317ef332 --- /dev/null +++ b/src/mo_values/numerics.ml @@ -0,0 +1,418 @@ +(* +This module contains all the numeric stuff, culminating +in the NatN and Int_N modules, to be used by value.ml +*) + +let rec add_digits buf s i j k = + if i < j then begin + if k = 0 then Buffer.add_char buf '_'; + Buffer.add_char buf s.[i]; + add_digits buf s (i + 1) j ((k + 2) mod 3) + end + +let is_digit c = '0' <= c && c <= '9' +let isnt_digit c = not (is_digit c) + +let group_num s = + let len = String.length s in + let mant = Lib.Option.get (Lib.String.find_from_opt is_digit s 0) len in + let point = Lib.Option.get (Lib.String.find_from_opt isnt_digit s mant) len in + let frac = Lib.Option.get (Lib.String.find_from_opt is_digit s point) len in + let exp = Lib.Option.get (Lib.String.find_from_opt isnt_digit s frac) len in + let buf = Buffer.create (len*4/3) in + Buffer.add_substring buf s 0 mant; + add_digits buf s mant point ((point - mant) mod 3 + 3); + Buffer.add_substring buf s point (frac - point); + add_digits buf s frac exp 3; + Buffer.add_substring buf s exp (len - exp); + Buffer.contents buf + +(* a mild extension over Was.Int.RepType *) +module type WordRepType = +sig + include Wasm.Int.RepType + val of_big_int : Big_int.big_int -> t (* wrapping *) + val to_big_int : t -> Big_int.big_int +end + +module Int64Rep : WordRepType = +struct + include Int64 + let bitwidth = 64 + let to_hex_string = Printf.sprintf "%Lx" + + let of_big_int i = + let open Big_int in + let i = mod_big_int i (power_int_positive_int 2 64) in + if lt_big_int i (power_int_positive_int 2 63) + then int64_of_big_int i + else int64_of_big_int (sub_big_int i (power_int_positive_int 2 64)) + + let to_big_int i = + let open Big_int in + if i < 0L + then add_big_int (big_int_of_int64 i) (power_int_positive_int 2 64) + else big_int_of_int64 i +end + + +(* Represent n-bit words using k-bit words by shifting left/right by k-n bits *) +module SubRep (Rep : WordRepType) (Width : sig val bitwidth : int end) : WordRepType = +struct + let _ = assert (Width.bitwidth < Rep.bitwidth) + + type t = Rep.t + + let bitwidth = Width.bitwidth + let bitdiff = Rep.bitwidth - Width.bitwidth + let inj r = Rep.shift_left r bitdiff + let proj i = Rep.shift_right_logical i bitdiff + + let zero = inj Rep.zero + let one = inj Rep.one + let minus_one = inj Rep.minus_one + let max_int = inj (Rep.shift_right_logical Rep.max_int bitdiff) + let min_int = inj (Rep.shift_right_logical Rep.min_int bitdiff) + let neg i = inj (Rep.neg (proj i)) + let add i j = inj (Rep.add (proj i) (proj j)) + let sub i j = inj (Rep.sub (proj i) (proj j)) + let mul i j = inj (Rep.mul (proj i) (proj j)) + let div i j = inj (Rep.div (proj i) (proj j)) + let rem i j = inj (Rep.rem (proj i) (proj j)) + let logand = Rep.logand + let logor = Rep.logor + let lognot i = inj (Rep.lognot (proj i)) + let logxor i j = inj (Rep.logxor (proj i) (proj j)) + let shift_left i j = Rep.shift_left i j + let shift_right i j = let res = Rep.shift_right i j in inj (proj res) + let shift_right_logical i j = let res = Rep.shift_right_logical i j in inj (proj res) + let of_int i = inj (Rep.of_int i) + let to_int i = Rep.to_int (proj i) + let to_string i = group_num (Rep.to_string (proj i)) + let to_hex_string i = group_num (Rep.to_hex_string (proj i)) + let of_big_int i = inj (Rep.of_big_int i) + let to_big_int i = Rep.to_big_int (proj i) +end + +module Int8Rep = SubRep (Int64Rep) (struct let bitwidth = 8 end) +module Int16Rep = SubRep (Int64Rep) (struct let bitwidth = 16 end) +module Int32Rep = SubRep (Int64Rep) (struct let bitwidth = 32 end) + +(* +This WordType is used only internally in this module, to implement the bit-wise +or wrapping operations on NatN and IntN (see module Ranged) +*) + +module type WordType = +sig + include Wasm.Int.S + val neg : t -> t + val not : t -> t + val pow : t -> t -> t + + val bitwidth : int + val of_big_int : Big_int.big_int -> t (* wrapping *) + val to_big_int : t -> Big_int.big_int (* returns natural numbers *) +end + +module MakeWord (Rep : WordRepType) : WordType = +struct + module WasmInt = Wasm.Int.Make (Rep) + include WasmInt + let neg w = sub zero w + let not w = xor w (of_int_s (-1)) + let one = of_int_u 1 + let rec pow x y = + if y = zero then + one + else if and_ y one = zero then + pow (mul x x) (shr_u y one) + else + mul x (pow x (sub y one)) + + let bitwidth = Rep.bitwidth + let of_big_int = Rep.of_big_int + let to_big_int = Rep.to_big_int +end + +module Word8Rep = MakeWord (Int8Rep) +module Word16Rep = MakeWord (Int16Rep) +module Word32Rep = MakeWord (Int32Rep) +module Word64Rep = MakeWord (Int64Rep) + +module type FloatType = +sig + include Wasm.Float.S + val rem : t -> t -> t + val pow : t -> t -> t + val to_pretty_string : t -> string +end + +module MakeFloat(WasmFloat : Wasm.Float.S) = +struct + include WasmFloat + let rem x y = of_float (Float.rem (to_float x) (to_float y)) + let pow x y = of_float (to_float x ** to_float y) + let to_pretty_string w = group_num (WasmFloat.to_string w) + let to_string = to_pretty_string +end + +module Float = MakeFloat(Wasm.F64) + + +module type NumType = +sig + type t + val signed : bool + val zero : t + val abs : t -> t + val neg : t -> t + val add : t -> t -> t + val sub : t -> t -> t + val mul : t -> t -> t + val div : t -> t -> t + val rem : t -> t -> t + val pow : t -> t -> t + val eq : t -> t -> bool + val ne : t -> t -> bool + val lt : t -> t -> bool + val gt : t -> t -> bool + val le : t -> t -> bool + val ge : t -> t -> bool + val compare : t -> t -> int + val to_int : t -> int + val of_int : int -> t + val to_big_int : t -> Big_int.big_int + val of_big_int : Big_int.big_int -> t + val of_string : string -> t + val to_string : t -> string + val to_pretty_string : t -> string +end + +module Int : NumType with type t = Big_int.big_int = +struct + open Big_int + type t = big_int + let signed = true + let zero = zero_big_int + let sub = sub_big_int + let abs = abs_big_int + let neg = minus_big_int + let add = add_big_int + let mul = mult_big_int + let div a b = + let q, m = quomod_big_int a b in + if sign_big_int m * sign_big_int a >= 0 then q + else if sign_big_int q = 1 then pred_big_int q else succ_big_int q + let rem a b = + let q, m = quomod_big_int a b in + let sign_m = sign_big_int m in + if sign_m * sign_big_int a >= 0 then m + else + let abs_b = abs_big_int b in + if sign_m = 1 then sub_big_int m abs_b else add_big_int m abs_b + let eq = eq_big_int + let ne x y = not (eq x y) + let lt = lt_big_int + let gt = gt_big_int + let le = le_big_int + let ge = ge_big_int + let compare = compare_big_int + let to_int = int_of_big_int + let of_int = big_int_of_int + let of_big_int i = i + let to_big_int i = i + let to_pretty_string i = group_num (string_of_big_int i) + let to_string = to_pretty_string + let of_string s = + big_int_of_string (String.concat "" (String.split_on_char '_' s)) + + let max_int = big_int_of_int max_int + + let pow x y = + if gt y max_int + then raise (Invalid_argument "Int.pow") + else power_big_int_positive_int x (int_of_big_int y) +end + +module Nat : NumType with type t = Big_int.big_int = +struct + include Int + let signed = false + let of_big_int i = + if ge i zero then i else raise (Invalid_argument "Nat.of_big_int") + let sub x y = + let z = Int.sub x y in + if ge z zero then z else raise (Invalid_argument "Nat.sub") +end + +(* Extension of NumType with wrapping and bit-wise operations *) +module type BitNumType = +sig + include NumType + + val not : t -> t + val popcnt : t -> t + val clz : t -> t + val ctz : t -> t + + val and_ : t -> t -> t + val or_ : t -> t -> t + val xor : t -> t -> t + val shl : t -> t -> t + val shr : t -> t -> t + val shr_s : t -> t -> t (* deprecated, remove with +>> *) + val rotl : t -> t -> t + val rotr : t -> t -> t + + val wrapping_of_big_int : Big_int.big_int -> t + + val wrapping_neg : t -> t + val wrapping_add : t -> t -> t + val wrapping_sub : t -> t -> t + val wrapping_mul : t -> t -> t + val wrapping_pow : t -> t -> t +end + +module Ranged + (Rep : NumType) + (WordRep : WordType) + : BitNumType = +struct + let to_word i = WordRep.of_big_int (Rep.to_big_int i) + let from_word i = + let n = WordRep.to_big_int i in + let n' = + let open Big_int in + if Rep.signed && le_big_int (power_int_positive_int 2 (WordRep.bitwidth - 1)) n + then sub_big_int n (power_int_positive_int 2 (WordRep.bitwidth)) + else n + in + Rep.of_big_int n' + + let check i = + if Rep.eq (from_word (to_word i)) i + then i + else raise (Invalid_argument "value out of bounds") + + include Rep + (* bounds-checking operations *) + let neg a = let res = Rep.neg a in check res + let abs a = let res = Rep.abs a in check res + let add a b = let res = Rep.add a b in check res + let sub a b = let res = Rep.sub a b in check res + let mul a b = let res = Rep.mul a b in check res + let div a b = let res = Rep.div a b in check res + let pow a b = let res = Rep.pow a b in check res + let of_int i = let res = Rep.of_int i in check res + let of_big_int i = let res = Rep.of_big_int i in check res + let of_string s = let res = Rep.of_string s in check res + + let on_word op a = from_word (op (to_word a)) + let on_words op a b = from_word (op (to_word a) (to_word b)) + + (* bit-wise operations *) + let not = on_word WordRep.not + let popcnt = on_word WordRep.popcnt + let clz = on_word WordRep.clz + let ctz = on_word WordRep.ctz + + let and_ = on_words WordRep.and_ + let or_ = on_words WordRep.or_ + let xor = on_words WordRep.xor + let shl = on_words WordRep.shl + let shr = on_words (if Rep.signed then WordRep.shr_s else WordRep.shr_u) + let shr_s = on_words WordRep.shr_s + let rotl = on_words WordRep.rotl + let rotr = on_words WordRep.rotr + + + (* wrapping operations *) + let wrapping_of_big_int i = from_word (WordRep.of_big_int i) + + let wrapping_neg = on_word WordRep.neg + let wrapping_add = on_words WordRep.add + let wrapping_sub = on_words WordRep.sub + let wrapping_mul = on_words WordRep.mul + let wrapping_pow a b = + if Rep.ge b Rep.zero + then on_words WordRep.pow a b + else raise (Invalid_argument "negative exponent") +end + +(* A variant of Ranged, with always uses wrapping behaviour + and has a wider accepted range for literals. + Only used for the deprecated word types. +*) +module Wrapping (WordRep : WordType) : BitNumType = +struct + include WordRep + + let of_big_int i = + let open Big_int in + if lt_big_int i (power_int_positive_int 2 WordRep.bitwidth) && + ge_big_int i (minus_big_int (power_int_positive_int 2 (WordRep.bitwidth - 1))) + then WordRep.of_big_int i + else raise (Invalid_argument "value out of bounds") + + let signed = false + + let abs i = i + + let div = WordRep.div_u + let rem = WordRep.rem_u + + let lt = WordRep.lt_u + let le = WordRep.le_u + let gt = WordRep.gt_u + let ge = WordRep.ge_u + let compare w1 w2 = Big_int.compare_big_int (to_big_int w1) (to_big_int w2) + + let of_int = WordRep.of_int_u + let to_int w = Big_int.int_of_big_int (WordRep.to_big_int w) + + let of_string s = + of_big_int (Big_int.big_int_of_string (String.concat "" (String.split_on_char '_' s))) + + let base = of_int_u 16 + let digs = + [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; + "8"; "9"; "A"; "B"; "C"; "D"; "E"; "F"|] + let to_pretty_string = + let rec to_pretty_string' w i s = + if w = zero then s else + let dig = digs.(to_int (WordRep.rem_u w base)) in + let s' = dig ^ (if i = 4 then "_" else "") ^ s in + to_pretty_string' (WordRep.div_u w base) (i mod 4 + 1) s' + in + fun w -> if w = zero then "0" else to_pretty_string' w 0 "" + let to_string = to_pretty_string + + + (* bit-wise operations *) + let shr = WordRep.shr_u + + + (* wrapping operations *) + let wrapping_of_big_int i = WordRep.of_big_int i + + let wrapping_neg = WordRep.neg + let wrapping_add = WordRep.add + let wrapping_sub = WordRep.sub + let wrapping_mul = WordRep.mul + let wrapping_pow a b = WordRep.pow a b +end +module Nat8 = Ranged (Nat) (Word8Rep) +module Nat16 = Ranged (Nat) (Word16Rep) +module Nat32 = Ranged (Nat) (Word32Rep) +module Nat64 = Ranged (Nat) (Word64Rep) + +module Int_8 = Ranged (Int) (Word8Rep) +module Int_16 = Ranged (Int) (Word16Rep) +module Int_32 = Ranged (Int) (Word32Rep) +module Int_64 = Ranged (Int) (Word64Rep) + +module Word8 = Wrapping (Word8Rep) +module Word16 = Wrapping (Word16Rep) +module Word32 = Wrapping (Word32Rep) +module Word64 = Wrapping (Word64Rep) diff --git a/src/mo_values/numerics.mli b/src/mo_values/numerics.mli new file mode 100644 index 00000000000..634c94a4bf3 --- /dev/null +++ b/src/mo_values/numerics.mli @@ -0,0 +1,84 @@ +(* Numeric Representations *) + +module type NumType = +sig + type t + val signed : bool + val zero : t + val abs : t -> t + val neg : t -> t + val add : t -> t -> t + val sub : t -> t -> t + val mul : t -> t -> t + val div : t -> t -> t + val rem : t -> t -> t + val pow : t -> t -> t + val eq : t -> t -> bool + val ne : t -> t -> bool + val lt : t -> t -> bool + val gt : t -> t -> bool + val le : t -> t -> bool + val ge : t -> t -> bool + val compare : t -> t -> int + val to_int : t -> int + val of_int : int -> t + val to_big_int : t -> Big_int.big_int + val of_big_int : Big_int.big_int -> t + val of_string : string -> t + val to_string : t -> string + val to_pretty_string : t -> string +end + +(* Extension of NumType with wrapping and bit-wise operations *) +module type BitNumType = +sig + include NumType + + + val not : t -> t + val popcnt : t -> t + val clz : t -> t + val ctz : t -> t + + val and_ : t -> t -> t + val or_ : t -> t -> t + val xor : t -> t -> t + val shl : t -> t -> t + val shr : t -> t -> t + val shr_s : t -> t -> t (* deprecated, remove with +>> *) + val rotl : t -> t -> t + val rotr : t -> t -> t + + val wrapping_of_big_int : Big_int.big_int -> t + + val wrapping_neg : t -> t + val wrapping_add : t -> t -> t + val wrapping_sub : t -> t -> t + val wrapping_mul : t -> t -> t + val wrapping_pow : t -> t -> t +end + +module type FloatType = +sig + include Wasm.Float.S + val rem : t -> t -> t + val pow : t -> t -> t + val to_pretty_string : t -> string +end + +module Float : FloatType with type bits = int64 and type t = Wasm.F64.t + +module Int : NumType +module Nat : NumType with type t = Int.t +module Int_8 : BitNumType +module Int_16 : BitNumType +module Int_32 : BitNumType +module Int_64 : BitNumType +module Nat8 : BitNumType +module Nat16 : BitNumType +module Nat32 : BitNumType +module Nat64 : BitNumType +module Word8 : BitNumType +module Word16 : BitNumType +module Word32 : BitNumType +module Word64 : BitNumType diff --git a/src/mo_values/operator.ml b/src/mo_values/operator.ml index 22462f0c046..8be09cc69bf 100644 --- a/src/mo_values/operator.ml +++ b/src/mo_values/operator.ml @@ -1,4 +1,5 @@ open Value +open Numerics module T = Mo_types.Type @@ -39,35 +40,43 @@ let impossible _ = raise (Invalid_argument "operator called for None") (* Unary operators *) -let word_unop (fword8, fword16, fword32, fword64) = function +(* bit-wise unops *) +let bit_unop (fword8, fword16, fword32, fword64) = function | T.Word8 -> fun v -> Word8 (fword8 (as_word8 v)) | T.Word16 -> fun v -> Word16 (fword16 (as_word16 v)) | T.Word32 -> fun v -> Word32 (fword32 (as_word32 v)) | T.Word64 -> fun v -> Word64 (fword64 (as_word64 v)) | _ -> raise (Invalid_argument "unop") -let num_unop fint (fint8, fint16, fint32, fint64) wordops ffloat = function +(* types that support sign operations (+, -) *) +let sign_unop fint (fint8, fint16, fint32, fint64, fword8, fword16, fword32, fword64) ffloat = function | T.Int -> fun v -> Int (fint (as_int v)) | T.Int8 -> fun v -> Int8 (fint8 (as_int8 v)) | T.Int16 -> fun v -> Int16 (fint16 (as_int16 v)) | T.Int32 -> fun v -> Int32 (fint32 (as_int32 v)) | T.Int64 -> fun v -> Int64 (fint64 (as_int64 v)) + | T.Word8 -> fun v -> Word8 (fword8 (as_word8 v)) + | T.Word16 -> fun v -> Word16 (fword16 (as_word16 v)) + | T.Word32 -> fun v -> Word32 (fword32 (as_word32 v)) + | T.Word64 -> fun v -> Word64 (fword64 (as_word64 v)) | T.Float -> fun v -> Float (ffloat (as_float v)) - | t -> word_unop wordops t + | _ -> raise (Invalid_argument "unop") let unop op t = match t with | T.Prim p -> (match op with - | PosOp -> let id v = v in num_unop id (id, id, id, id) (id, id, id, id) id p + | PosOp -> Fun.(sign_unop id (id, id, id, id, id, id, id, id) id p) | NegOp -> - num_unop + sign_unop Int.neg - (Int_8.neg, Int_16.neg, Int_32.neg, Int_64.neg) - (Word8.neg, Word16.neg, Word32.neg, Word64.neg) + (Int_8.neg, Int_16.neg, Int_32.neg, Int_64.neg, + Word8.neg, Word16.neg, Word32.neg, Word64.neg) Float.neg p - | NotOp -> word_unop (Word8.not, Word16.not, Word32.not, Word64.not) p + | NotOp -> bit_unop + (Word8.not, Word16.not, Word32.not, Word64.not) + p ) | T.Non -> impossible | _ -> raise (Invalid_argument "unop") @@ -86,36 +95,38 @@ let word_binop (fword8, fword16, fword32, fword64) = function | T.Word64 -> fun v1 v2 -> Word64 (fword64 (as_word64 v1) (as_word64 v2)) | _ -> raise (Invalid_argument "binop") -let num_binop fnat (fnat8, fnat16, fnat32, fnat64) fint (fint8, fint16, fint32, fint64) fwords ffloat = function - | T.Nat -> fun v1 v2 -> Int (fnat (as_int v1) (as_int v2)) +let fixed_binop (fnat8, fnat16, fnat32, fnat64, fint8, fint16, fint32, fint64) fwords = function | T.Nat8 -> fun v1 v2 -> Nat8 (fnat8 (as_nat8 v1) (as_nat8 v2)) | T.Nat16 -> fun v1 v2 -> Nat16 (fnat16 (as_nat16 v1) (as_nat16 v2)) | T.Nat32 -> fun v1 v2 -> Nat32 (fnat32 (as_nat32 v1) (as_nat32 v2)) | T.Nat64 -> fun v1 v2 -> Nat64 (fnat64 (as_nat64 v1) (as_nat64 v2)) - | T.Int -> fun v1 v2 -> Int (fint (as_int v1) (as_int v2)) | T.Int8 -> fun v1 v2 -> Int8 (fint8 (as_int8 v1) (as_int8 v2)) | T.Int16 -> fun v1 v2 -> Int16 (fint16 (as_int16 v1) (as_int16 v2)) | T.Int32 -> fun v1 v2 -> Int32 (fint32 (as_int32 v1) (as_int32 v2)) | T.Int64 -> fun v1 v2 -> Int64 (fint64 (as_int64 v1) (as_int64 v2)) - | T.Float -> fun v1 v2 -> Float (ffloat (as_float v1) (as_float v2)) | t -> word_binop fwords t +let num_binop fnat fint ffixed fwords ffloat = function + | T.Nat -> fun v1 v2 -> Int (fnat (as_int v1) (as_int v2)) + | T.Int -> fun v1 v2 -> Int (fint (as_int v1) (as_int v2)) + | T.Float -> fun v1 v2 -> Float (ffloat (as_float v1) (as_float v2)) + | t -> fixed_binop ffixed fwords t + let binop op t = match t with | T.Prim p -> (match op with - | AddOp -> num_binop Nat.add (Nat8.add, Nat16.add, Nat32.add, Nat64.add) Int.add (Int_8.add, Int_16.add, Int_32.add, Int_64.add) (Word8.add, Word16.add, Word32.add, Word64.add) Float.add p - | SubOp -> num_binop Nat.sub (Nat8.sub, Nat16.sub, Nat32.sub, Nat64.sub) Int.sub (Int_8.sub, Int_16.sub, Int_32.sub, Int_64.sub) (Word8.sub, Word16.sub, Word32.sub, Word64.sub) Float.sub p - | MulOp -> num_binop Nat.mul (Nat8.mul, Nat16.mul, Nat32.mul, Nat64.mul) Int.mul (Int_8.mul, Int_16.mul, Int_32.mul, Int_64.mul) (Word8.mul, Word16.mul, Word32.mul, Word64.mul) Float.mul p - | DivOp -> num_binop Nat.div (Nat8.div, Nat16.div, Nat32.div, Nat64.div) Int.div (Int_8.div, Int_16.div, Int_32.div, Int_64.div) (Word8.div_u, Word16.div_u, Word32.div_u, Word64.div_u) Float.div p - | ModOp -> num_binop Nat.rem (Nat8.rem, Nat16.rem, Nat32.rem, Nat64.rem) - Int.rem (Int_8.rem, Int_16.rem, Int_32.rem, Int_64.rem) (Word8.rem_u, Word16.rem_u, Word32.rem_u, Word64.rem_u) Float.rem p (* TBR *) - | PowOp -> num_binop Nat.pow (Nat8.pow, Nat16.pow, Nat32.pow, Nat64.pow) Int.pow (Int_8.pow, Int_16.pow, Int_32.pow, Int_64.pow) (Word8.pow, Word16.pow, Word32.pow, Word64.pow) Float.pow p (* TBR *) + | AddOp -> num_binop Nat.add Int.add (Nat8.add, Nat16.add, Nat32.add, Nat64.add, Int_8.add, Int_16.add, Int_32.add, Int_64.add) (Word8.add, Word16.add, Word32.add, Word64.add) Float.add p + | SubOp -> num_binop Nat.sub Int.sub (Nat8.sub, Nat16.sub, Nat32.sub, Nat64.sub, Int_8.sub, Int_16.sub, Int_32.sub, Int_64.sub) (Word8.sub, Word16.sub, Word32.sub, Word64.sub) Float.sub p + | MulOp -> num_binop Nat.mul Int.mul (Nat8.mul, Nat16.mul, Nat32.mul, Nat64.mul, Int_8.mul, Int_16.mul, Int_32.mul, Int_64.mul) (Word8.mul, Word16.mul, Word32.mul, Word64.mul) Float.mul p + | DivOp -> num_binop Nat.div Int.div (Nat8.div, Nat16.div, Nat32.div, Nat64.div, Int_8.div, Int_16.div, Int_32.div, Int_64.div) (Word8.div, Word16.div, Word32.div, Word64.div) Float.div p + | ModOp -> num_binop Nat.rem Int.rem (Nat8.rem, Nat16.rem, Nat32.rem, Nat64.rem, Int_8.rem, Int_16.rem, Int_32.rem, Int_64.rem) (Word8.rem, Word16.rem, Word32.rem, Word64.rem) Float.rem p + | PowOp -> num_binop Nat.pow Int.pow (Nat8.pow, Nat16.pow, Nat32.pow, Nat64.pow, Int_8.pow, Int_16.pow, Int_32.pow, Int_64.pow) (Word8.pow, Word16.pow, Word32.pow, Word64.pow) Float.pow p | AndOp -> word_binop (Word8.and_, Word16.and_, Word32.and_, Word64.and_) p | OrOp -> word_binop (Word8.or_, Word16.or_, Word32.or_, Word64.or_) p | XorOp -> word_binop (Word8.xor, Word16.xor, Word32.xor, Word64.xor) p | ShLOp -> word_binop (Word8.shl, Word16.shl, Word32.shl, Word64.shl) p - | UShROp -> word_binop (Word8.shr_u, Word16.shr_u, Word32.shr_u, Word64.shr_u) p + | UShROp -> word_binop (Word8.shr, Word16.shr, Word32.shr, Word64.shr) p | SShROp -> word_binop (Word8.shr_s, Word16.shr_s, Word32.shr_s, Word64.shr_s) p | RotLOp -> word_binop (Word8.rotl, Word16.rotl, Word32.rotl, Word64.rotl) p | RotROp -> word_binop (Word8.rotr, Word16.rotr, Word32.rotr, Word64.rotr) p @@ -127,14 +138,7 @@ let binop op t = (* Relational operators *) -let word_relop (fword8, fword16, fword32, fword64) = function - | T.Word8 -> fun v1 v2 -> Bool (fword8 (as_word8 v1) (as_word8 v2)) - | T.Word16 -> fun v1 v2 -> Bool (fword16 (as_word16 v1) (as_word16 v2)) - | T.Word32 -> fun v1 v2 -> Bool (fword32 (as_word32 v1) (as_word32 v2)) - | T.Word64 -> fun v1 v2 -> Bool (fword64 (as_word64 v1) (as_word64 v2)) - | _ -> raise (Invalid_argument "relop") - -let num_relop fnat (fnat8, fnat16, fnat32, fnat64) fint (fint8, fint16, fint32, fint64) fwords ffloat = function +let num_relop fnat fint (fnat8, fnat16, fnat32, fnat64, fint8, fint16, fint32, fint64, fword8, fword16, fword32, fword64) ffloat = function | T.Nat -> fun v1 v2 -> Bool (fnat (as_int v1) (as_int v2)) | T.Nat8 -> fun v1 v2 -> Bool (fnat8 (as_nat8 v1) (as_nat8 v2)) | T.Nat16 -> fun v1 v2 -> Bool (fnat16 (as_nat16 v1) (as_nat16 v2)) @@ -145,22 +149,26 @@ let num_relop fnat (fnat8, fnat16, fnat32, fnat64) fint (fint8, fint16, fint32, | T.Int16 -> fun v1 v2 -> Bool (fint16 (as_int16 v1) (as_int16 v2)) | T.Int32 -> fun v1 v2 -> Bool (fint32 (as_int32 v1) (as_int32 v2)) | T.Int64 -> fun v1 v2 -> Bool (fint64 (as_int64 v1) (as_int64 v2)) + | T.Word8 -> fun v1 v2 -> Bool (fword8 (as_word8 v1) (as_word8 v2)) + | T.Word16 -> fun v1 v2 -> Bool (fword16 (as_word16 v1) (as_word16 v2)) + | T.Word32 -> fun v1 v2 -> Bool (fword32 (as_word32 v1) (as_word32 v2)) + | T.Word64 -> fun v1 v2 -> Bool (fword64 (as_word64 v1) (as_word64 v2)) | T.Float -> fun v1 v2 -> Bool (ffloat (as_float v1) (as_float v2)) - | t -> word_relop fwords t + | _ -> raise (Invalid_argument "relop") -let ord_relop fnat fnats fint fints fwords ffloat fchar ftext fblob = function +let ord_relop fnat fint fwords ffloat fchar ftext fblob = function | T.Char -> fun v1 v2 -> Bool (fchar (as_char v1) (as_char v2)) | T.Text -> fun v1 v2 -> Bool (ftext (as_text v1) (as_text v2)) | T.Blob | T.Principal -> fun v1 v2 -> Bool (ftext (as_blob v1) (as_blob v2)) - | t -> num_relop fnat fnats fint fints fwords ffloat t + | t -> num_relop fnat fint fwords ffloat t -let eq_relop fnat fnats fint fints fwords ffloat fchar ftext fblob fnull fbool = function +let eq_relop fnat fint fwords ffloat fchar ftext fblob fnull fbool = function | T.Null -> fun v1 v2 -> Bool (fnull (as_null v1) (as_null v2)) | T.Bool -> fun v1 v2 -> Bool (fbool (as_bool v1) (as_bool v2)) - | t -> ord_relop fnat fnats fint fints fwords ffloat fchar ftext fblob t + | t -> ord_relop fnat fint fwords ffloat fchar ftext fblob t let eq_prim = - eq_relop Nat.eq (Nat8.eq, Nat16.eq, Nat32.eq, Nat64.eq) Int.eq (Int_8.eq, Int_16.eq, Int_32.eq, Int_64.eq) (Word8.eq, Word16.eq, Word32.eq, Word64.eq) Float.eq (=) (=) (=) (=) (=) + eq_relop Nat.eq Int.eq (Nat8.eq, Nat16.eq, Nat32.eq, Nat64.eq, Int_8.eq, Int_16.eq, Int_32.eq, Int_64.eq, Word8.eq, Word16.eq, Word32.eq, Word64.eq) Float.eq (=) (=) (=) (=) (=) (* Follows the structure of `shared` in mo_type/type.ml *) let structural_equality t = @@ -239,11 +247,11 @@ let relop op t = | T.Prim p -> (match op with | EqOp -> eq_prim p - | NeqOp -> eq_relop Nat.ne (Nat8.ne, Nat16.ne, Nat32.ne, Nat64.ne) Int.ne (Int_8.ne, Int_16.ne, Int_32.ne, Int_64.ne) (Word8.ne, Word16.ne, Word32.ne, Word64.ne) Float.ne (<>) (<>) (<>) (<>) (<>) p - | LtOp -> ord_relop Nat.lt (Nat8.lt, Nat16.lt, Nat32.lt, Nat64.lt) Int.lt (Int_8.lt, Int_16.lt, Int_32.lt, Int_64.lt) (Word8.lt_u, Word16.lt_u, Word32.lt_u, Word64.lt_u) Float.lt (<) (<) (<) p - | GtOp -> ord_relop Nat.gt (Nat8.gt, Nat16.gt, Nat32.gt, Nat64.gt) Int.gt (Int_8.gt, Int_16.gt, Int_32.gt, Int_64.gt) (Word8.gt_u, Word16.gt_u, Word32.gt_u, Word64.gt_u) Float.gt (>) (>) (>) p - | LeOp -> ord_relop Nat.le (Nat8.le, Nat16.le, Nat32.le, Nat64.le) Int.le (Int_8.le, Int_16.le, Int_32.le, Int_64.le) (Word8.le_u, Word16.le_u, Word32.le_u, Word64.le_u) Float.le (<=) (<=) (<=) p - | GeOp -> ord_relop Nat.ge (Nat8.ge, Nat16.ge, Nat32.ge, Nat64.ge) Int.ge (Int_8.ge, Int_16.ge, Int_32.ge, Int_64.ge) (Word8.ge_u, Word16.ge_u, Word32.ge_u, Word64.ge_u) Float.ge (>=) (>=) (>=) p + | NeqOp -> eq_relop Nat.ne Int.ne (Nat8.ne, Nat16.ne, Nat32.ne, Nat64.ne, Int_8.ne, Int_16.ne, Int_32.ne, Int_64.ne, Word8.ne, Word16.ne, Word32.ne, Word64.ne) Float.ne (<>) (<>) (<>) (<>) (<>) p + | LtOp -> eq_relop Nat.lt Int.lt (Nat8.lt, Nat16.lt, Nat32.lt, Nat64.lt, Int_8.lt, Int_16.lt, Int_32.lt, Int_64.lt, Word8.lt, Word16.lt, Word32.lt, Word64.lt) Float.lt (<) (<) (<) (<) (<) p + | GtOp -> eq_relop Nat.gt Int.gt (Nat8.gt, Nat16.gt, Nat32.gt, Nat64.gt, Int_8.gt, Int_16.gt, Int_32.gt, Int_64.gt, Word8.gt, Word16.gt, Word32.gt, Word64.gt) Float.gt (>) (>) (>) (>) (>) p + | LeOp -> eq_relop Nat.le Int.le (Nat8.le, Nat16.le, Nat32.le, Nat64.le, Int_8.le, Int_16.le, Int_32.le, Int_64.le, Word8.le, Word16.le, Word32.le, Word64.le) Float.le (<=) (<=) (<=) (<=) (<=) p + | GeOp -> eq_relop Nat.ge Int.ge (Nat8.ge, Nat16.ge, Nat32.ge, Nat64.ge, Int_8.ge, Int_16.ge, Int_32.ge, Int_64.ge, Word8.ge, Word16.ge, Word32.ge, Word64.ge) Float.ge (>=) (>=) (>=) (>=) (>=) p ) | T.Non -> impossible | t when op = EqOp && T.shared t -> diff --git a/src/mo_values/prim.ml b/src/mo_values/prim.ml index b0ed1362ceb..a7a44575557 100644 --- a/src/mo_values/prim.ml +++ b/src/mo_values/prim.ml @@ -2,200 +2,83 @@ open Mo_types open Value +open Numerics -module Conv = struct - open Big_int - let int_of_word32_u w = Int32.to_int w land 0xffff_ffff +let as_big_int = function + | Type.Nat -> fun v -> Nat.to_big_int (as_int v) + | Type.Int -> fun v -> Int.to_big_int (as_int v) + | Type.Nat8 -> fun v -> Nat8.to_big_int (as_nat8 v) + | Type.Nat16 -> fun v -> Nat16.to_big_int (as_nat16 v) + | Type.Nat32 -> fun v -> Nat32.to_big_int (as_nat32 v) + | Type.Nat64 -> fun v -> Nat64.to_big_int (as_nat64 v) + | Type.Int8 -> fun v -> Int_8.to_big_int (as_int8 v) + | Type.Int16 -> fun v -> Int_16.to_big_int (as_int16 v) + | Type.Int32 -> fun v -> Int_32.to_big_int (as_int32 v) + | Type.Int64 -> fun v -> Int_64.to_big_int (as_int64 v) + | Type.Word8 -> fun v -> Word8.to_big_int (as_word8 v) + | Type.Word16 -> fun v -> Word16.to_big_int (as_word16 v) + | Type.Word32 -> fun v -> Word32.to_big_int (as_word32 v) + | Type.Word64 -> fun v -> Word64.to_big_int (as_word64 v) + | Type.Char -> fun v -> Big_int.big_int_of_int (as_char v) + | t -> raise (Invalid_argument ("Value.as_big_int: " ^ Type.string_of_typ (Type.Prim t))) - let twoRaised62 = power_int_positive_int 2 62 - let twoRaised63 = power_int_positive_int 2 63 - let twoRaised64 = power_int_positive_int 2 64 - let word_twoRaised63 = Word64.(pow 2L 63L) +let of_big_int_trap = function + | Type.Nat -> fun i -> Int (Nat.of_big_int i) + | Type.Int -> fun i -> Int (Int.of_big_int i) + | Type.Nat8 -> fun i -> Nat8 (Nat8.of_big_int i) + | Type.Nat16 -> fun i -> Nat16 (Nat16.of_big_int i) + | Type.Nat32 -> fun i -> Nat32 (Nat32.of_big_int i) + | Type.Nat64 -> fun i -> Nat64 (Nat64.of_big_int i) + | Type.Int8 -> fun i -> Int8 (Int_8.of_big_int i) + | Type.Int16 -> fun i -> Int16 (Int_16.of_big_int i) + | Type.Int32 -> fun i -> Int32 (Int_32.of_big_int i) + | Type.Int64 -> fun i -> Int64 (Int_64.of_big_int i) + | Type.Char -> fun i -> + let i = Big_int.int_of_big_int i in + if i < 0xD800 || i >= 0xE000 && i < 0x110000 then Char i else raise (Invalid_argument "character value out of bounds") + | t -> raise (Invalid_argument ("Value.of_big_int_trap: " ^ Type.string_of_typ (Type.Prim t))) - let word64_of_big_int_u i = - assert (sign_big_int i > -1); - let wrapped = mod_big_int i twoRaised64 in - match int64_of_big_int_opt wrapped with - | Some n -> n - | _ -> Word64.add (int64_of_big_int (sub_big_int wrapped twoRaised63)) word_twoRaised63 +let of_big_int_wrap = function + | Type.Nat8 -> fun i -> Nat8 (Nat8.wrapping_of_big_int i) + | Type.Nat16 -> fun i -> Nat16 (Nat16.wrapping_of_big_int i) + | Type.Nat32 -> fun i -> Nat32 (Nat32.wrapping_of_big_int i) + | Type.Nat64 -> fun i -> Nat64 (Nat64.wrapping_of_big_int i) + | Type.Int8 -> fun i -> Int8 (Int_8.wrapping_of_big_int i) + | Type.Int16 -> fun i -> Int16 (Int_16.wrapping_of_big_int i) + | Type.Int32 -> fun i -> Int32 (Int_32.wrapping_of_big_int i) + | Type.Int64 -> fun i -> Int64 (Int_64.wrapping_of_big_int i) + | Type.Word8 -> fun i -> Word8 (Word8.wrapping_of_big_int i) + | Type.Word16 -> fun i -> Word16 (Word16.wrapping_of_big_int i) + | Type.Word32 -> fun i -> Word32 (Word32.wrapping_of_big_int i) + | Type.Word64 -> fun i -> Word64 (Word64.wrapping_of_big_int i) + | t -> raise (Invalid_argument ("Value.of_big_int_wrap: " ^ Type.string_of_typ (Type.Prim t))) - let word64_of_big_int_s i = - let wrapped = mod_big_int i twoRaised64 in - match int64_of_big_int_opt wrapped with - | Some n -> n - | _ -> Word64.sub (int64_of_big_int (sub_big_int wrapped twoRaised63)) word_twoRaised63 +(* +Wrapping numeric conversions are all specified uniformly by going through bigint +*) - let big_int_of_word64_u w = - let i = big_int_of_int64 w in - if sign_big_int i > -1 then i - else add_big_int i twoRaised64 - - let wrapped_int_of_big_int i = - match int_of_big_int_opt i with - | Some n -> n - | _ -> int_of_big_int (mod_big_int i twoRaised62) - - (* for q in {0, -1} return i + q * offs *) - let to_signed i q offs = if Big_int.sign_big_int q = 0 then i else i - offs - let to_signed_big_int i q offs = Big_int.(if sign_big_int q = 0 then i else sub_big_int i offs) -end (* Conv *) - -let range_violation () = raise (Invalid_argument "numeric overflow") - -let num_conv_prim t1 t2 = +(* Trapping conversions (the num_conv_t1_t2 prim used in prelude/prelude.ml) *) +let num_conv_trap_prim t1 t2 = let module T = Type in match (t1, t2) with - | T.Nat8, T.Word8 -> fun v -> - let i = Nat8.to_int (as_nat8 v) - in Word8 (Word8.of_int_u i) - | T.Nat, T.Word8 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word8 (Word8.of_int_u i) - | T.Nat, T.Nat8 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 8) in - let i = Big_int.int_of_big_int r - in Big_int.(if eq_big_int q zero_big_int then Nat8 (Nat8.of_int i) else range_violation ()) - | T.Int8, T.Word8 -> fun v -> - let i = Int_8.to_int (as_int8 v) - in Word8 (Word8.of_int_s i) - | T.Int, T.Word8 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word8 (Word8.of_int_s i) - | T.Int, T.Int8 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 7) in - let i = Big_int.int_of_big_int r in - Big_int. - (if eq_big_int q zero_big_int || eq_big_int q (pred_big_int zero_big_int) - then Int8(Int_8.of_int (Conv.to_signed i q 0x80)) else range_violation ()) - | T.Nat16, T.Word16 -> fun v -> - let i = Nat16.to_int (as_nat16 v) - in Word16 (Word16.of_int_u i) - | T.Nat, T.Word16 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word16 (Word16.of_int_u i) - | T.Nat, T.Nat16 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 16) in - let i = Big_int.int_of_big_int r - in Big_int.(if eq_big_int q zero_big_int then Nat16 (Nat16.of_int i) else range_violation ()) - | T.Int16, T.Word16 -> fun v -> - let i = Int_16.to_int (as_int16 v) - in Word16 (Word16.of_int_s i) - | T.Int, T.Word16 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word16 (Word16.of_int_s i) - | T.Int, T.Int16 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 15) in - let i = Big_int.int_of_big_int r in - Big_int. - (if eq_big_int q zero_big_int || eq_big_int q (pred_big_int zero_big_int) - then Int16(Int_16.of_int (Conv.to_signed i q 0x8000)) else range_violation ()) - | T.Nat32, T.Word32 -> fun v -> - let i = Nat32.to_int (as_nat32 v) - in Word32 (Word32.of_int_u i) - | T.Nat, T.Word32 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word32 (Word32.of_int_u i) - | T.Nat, T.Nat32 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 32) in - let i = Big_int.int_of_big_int r - in Big_int.(if eq_big_int q zero_big_int then Nat32 (Nat32.of_int i) else range_violation ()) - | T.Int32, T.Word32 -> fun v -> - let i = Int_32.to_int (as_int32 v) - in Word32 (Word32.of_int_s i) - | T.Int, T.Word32 -> fun v -> - let i = Conv.wrapped_int_of_big_int (as_int v) - in Word32 (Word32.of_int_s i) - | T.Int, T.Int32 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) (Big_int.power_int_positive_int 2 31) in - let i = Big_int.int_of_big_int r in - Big_int. - (if eq_big_int q zero_big_int || eq_big_int q (pred_big_int zero_big_int) - then Int32 (Int_32.of_int (Conv.to_signed i q 0x80000000)) else range_violation ()) + | T.Nat, (T.Nat8|T.Nat16|T.Nat32|T.Nat64) + | T.Int, (T.Int8|T.Int16|T.Int32|T.Int64) + | (T.Nat8|T.Nat16|T.Nat32|T.Nat64), T.Nat + | (T.Int8|T.Int16|T.Int32|T.Int64), T.Int + | (T.Word8|T.Word16|T.Word32|T.Word64), T.Nat + | T.Word32, T.Char + -> fun v -> of_big_int_trap t2 (as_big_int t1 v) - | T.Nat64, T.Word64 -> fun v -> - let q, r = Big_int.quomod_big_int (Nat64.to_big_int (as_nat64 v)) Conv.twoRaised63 in - let i = Conv.(to_signed_big_int r q twoRaised63) in - Word64 (Big_int.int64_of_big_int i) - | T.Nat, T.Word64 -> fun v -> Word64 (Conv.word64_of_big_int_u (as_int v)) - | T.Nat, T.Nat64 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) Conv.twoRaised64 in - Big_int. - (if eq_big_int q zero_big_int - then Nat64 (Nat64.of_big_int r) - else range_violation ()) - | T.Int64, T.Word64 -> fun v -> Word64 (Big_int.int64_of_big_int (Int_64.to_big_int (as_int64 v))) - | T.Int, T.Word64 -> fun v -> Word64 (Conv.word64_of_big_int_s (as_int v)) - | T.Int, T.Int64 -> fun v -> - let q, r = Big_int.quomod_big_int (as_int v) Conv.twoRaised63 in - Big_int. - (if eq_big_int q zero_big_int || eq_big_int q (pred_big_int zero_big_int) - then Int64 (Int_64.of_big_int Conv.(to_signed_big_int r q twoRaised63)) - else range_violation ()) - - | T.Word8, T.Nat -> fun v -> - let i = Int32.to_int (Int32.shift_right_logical (Word8.to_bits (as_word8 v)) 24) - in Int (Big_int.big_int_of_int i) - | T.Word8, T.Nat8 -> fun v -> - let i = Int32.to_int (Int32.shift_right_logical (Word8.to_bits (as_word8 v)) 24) - in Nat8 (Nat8.of_int i) - | T.Int8, T.Int -> fun v -> Int (Int.of_int (Int_8.to_int (as_int8 v))) - | T.Nat8, T.Nat -> fun v -> Int (Nat.of_int (Nat8.to_int (as_nat8 v))) - | T.Word8, T.Int -> fun v -> - let i = Int32.to_int (Int32.shift_right (Word8.to_bits (as_word8 v)) 24) - in Int (Big_int.big_int_of_int i) - | T.Word8, T.Int8 -> fun v -> - let i = Int32.to_int (Int32.shift_right (Word8.to_bits (as_word8 v)) 24) - in Int8 (Int_8.of_int i) - | T.Word16, T.Nat -> fun v -> - let i = Int32.to_int (Int32.shift_right_logical (Word16.to_bits (as_word16 v)) 16) - in Int (Big_int.big_int_of_int i) - | T.Word16, T.Nat16 -> fun v -> - let i = Int32.to_int (Int32.shift_right_logical (Word16.to_bits (as_word16 v)) 16) - in Nat16 (Nat16.of_int i) - | T.Int16, T.Int -> fun v -> Int (Int.of_int (Int_16.to_int (as_int16 v))) - | T.Nat16, T.Nat -> fun v -> Int (Nat.of_int (Nat16.to_int (as_nat16 v))) - | T.Word16, T.Int -> fun v -> - let i = Int32.to_int (Int32.shift_right (Word16.to_bits (as_word16 v)) 16) - in Int (Big_int.big_int_of_int i) - | T.Word16, T.Int16 -> fun v -> - let i = Int32.to_int (Int32.shift_right (Word16.to_bits (as_word16 v)) 16) - in Int16 (Int_16.of_int i) - | T.Int32, T.Int -> fun v -> Int (Int.of_int (Int_32.to_int (as_int32 v))) - | T.Nat32, T.Nat -> fun v -> Int (Nat.of_int (Nat32.to_int (as_nat32 v))) - | T.Word32, T.Nat -> fun v -> - let i = Conv.int_of_word32_u (as_word32 v) - in Int (Big_int.big_int_of_int i) - | T.Word32, T.Int -> fun v -> Int (Big_int.big_int_of_int32 (as_word32 v)) - | T.Word32, T.Int32 -> fun v -> - let i = Big_int.(int_of_big_int (big_int_of_int32 (as_word32 v))) in - Int32 (Int_32.of_int i) - | T.Word32, T.Nat32 -> fun v -> - let i = Big_int.(int_of_big_int (big_int_of_int32 (as_word32 v))) in - let i' = if i < 0 then i + 0x100000000 else i in - Nat32 (Nat32.of_int i') - - | T.Int64, T.Int -> fun v -> Int (Int_64.to_big_int (as_int64 v)) - | T.Nat64, T.Nat -> fun v -> Int (Nat64.to_big_int (as_nat64 v)) - | T.Word64, T.Nat -> fun v -> - let i = Conv.big_int_of_word64_u (as_word64 v) - in Int i - | T.Word64, T.Nat64 -> fun v -> - let i = Conv.big_int_of_word64_u (as_word64 v) - in Nat64 (Nat64.of_big_int i) - | T.Word64, T.Int -> fun v -> Int (Big_int.big_int_of_int64 (as_word64 v)) - | T.Word64, T.Int64 -> fun v -> - let i = Big_int.big_int_of_int64 (as_word64 v) - in Int64 (Int_64.of_big_int i) - - | T.Char, T.Word32 -> fun v -> - let i = as_char v - in Word32 (Word32.of_int_u i) - | T.Word32, T.Char -> fun v -> - let i = Conv.int_of_word32_u (as_word32 v) - in if i < 0xD800 || i >= 0xE000 && i < 0x110000 then Char i else raise (Invalid_argument "character value out of bounds") | T.Float, T.Int64 -> fun v -> Int64 (Int_64.of_big_int (Big_int.big_int_of_int64 (Wasm.I64_convert.trunc_f64_s (as_float v)))) | T.Int64, T.Float -> fun v -> Float (Wasm.F64_convert.convert_i64_s (Big_int.int64_of_big_int (Int_64.to_big_int (as_int64 v)))) - | t1, t2 -> raise (Invalid_argument ("Value.num_conv_prim: " ^ T.string_of_typ (T.Prim t1) ^ T.string_of_typ (T.Prim t2) )) + | t1, t2 -> raise (Invalid_argument ("Value.num_conv_trap_prim: " ^ T.string_of_typ (T.Prim t1) ^ T.string_of_typ (T.Prim t2) )) + +(* +It is the responsibility of prelude/prelude.ml to define num_wrap_t1_t2 only +for suitable types t1 and t2 +*) +let num_conv_wrap_prim t1 t2 = + fun v -> of_big_int_wrap t2 (as_big_int t1 v) let prim = let via_float f v = Float.(Float (of_float (f (to_float (as_float v))))) in @@ -279,10 +162,10 @@ let prim = fun _ v k -> let w, a = as_pair v in k (match w with - | Word8 y -> Word8 Word8. (and_ y (shl (of_int_u 1) (as_word8 a))) - | Word16 y -> Word16 Word16.(and_ y (shl (of_int_u 1) (as_word16 a))) - | Word32 y -> Word32 Word32.(and_ y (shl 1l (as_word32 a))) - | Word64 y -> Word64 Word64.(and_ y (shl 1L (as_word64 a))) + | Word8 y -> Word8 Word8. (and_ y (shl (of_int 1) (as_word8 a))) + | Word16 y -> Word16 Word16.(and_ y (shl (of_int 1) (as_word16 a))) + | Word32 y -> Word32 Word32.(and_ y (shl (of_int 1) (as_word32 a))) + | Word64 y -> Word64 Word64.(and_ y (shl (of_int 1) (as_word64 a))) | _ -> failwith "btst") | "conv_Char_Text" -> fun _ v k -> let str = match as_char v with @@ -294,17 +177,20 @@ let prim = | "rts_heap_size" -> fun _ v k -> as_unit v; k (Int (Int.of_int 0)) | "rts_total_allocation" -> fun _ v k -> as_unit v; k (Int (Int.of_int 0)) | "rts_outstanding_callbacks" -> fun _ v k -> as_unit v; k (Int (Int.of_int 0)) - | "time" -> fun _ v k -> as_unit v; k (Value.Nat64 (Value.Nat64.of_int 42)) - | "idlHash" -> fun _ v k -> let s = as_text v in k (Word32 (Lib.Uint32.to_int32 (Idllib.IdlHash.idl_hash s))) + | "time" -> fun _ v k -> as_unit v; k (Value.Nat64 (Numerics.Nat64.of_int 42)) + | "idlHash" -> fun _ v k -> + let s = as_text v in + k (Word32 (Word32.wrapping_of_big_int (Big_int.big_int_of_int32 (Lib.Uint32.to_int32 (Idllib.IdlHash.idl_hash s))))) | "crc32Hash" -> fun _ v k -> let s = as_blob v in - k (Word32 Optint.(to_int32 (Checkseum.Crc32.digest_string s 0 (String.length s) zero))) + let i = Optint.(to_int32 (Checkseum.Crc32.digest_string s 0 (String.length s) zero)) in + k (Word32 (Word32.wrapping_of_big_int (Big_int.big_int_of_int32 i))) | "array_len" -> fun _ v k -> k (Int (Int.of_int (Array.length (Value.as_array v)))) | "blob_size" -> fun _ v k -> k (Int (Nat.of_int (String.length (Value.as_blob v)))) | "blob_iter" -> fun _ v k -> let s = String.to_seq (Value.as_blob v) in - let valuation b = Word8 (Word8.of_int_u (Char.code b)) in + let valuation b = Word8 (Word8.of_int (Char.code b)) in k (Iter (ref (Seq.map valuation s))) | "blob_iter_done" | "text_iter_done" -> fun _ v k -> let i = Value.as_iter v in @@ -340,12 +226,22 @@ let prim = | _ -> assert false ) | "cast" -> fun _ v k -> k v + | p when Lib.String.chop_prefix "num_conv" p <> None -> begin match String.split_on_char '_' p with | [_;_;s1;s2] -> let p1 = Type.prim s1 in let p2 = Type.prim s2 in - fun env v k -> k (num_conv_prim p1 p2 v) + fun env v k -> k (num_conv_trap_prim p1 p2 v) + | _ -> assert false + end + + | p when Lib.String.chop_prefix "num_wrap" p <> None -> + begin match String.split_on_char '_' p with + | [_;_;s1;s2] -> + let p1 = Type.prim s1 in + let p2 = Type.prim s2 in + fun env v k -> k (num_conv_wrap_prim p1 p2 v) | _ -> assert false end diff --git a/src/mo_values/prim.mli b/src/mo_values/prim.mli index a5d4630e09a..76cbb16aae4 100644 --- a/src/mo_values/prim.mli +++ b/src/mo_values/prim.mli @@ -1,3 +1,4 @@ open Mo_types val prim : string -> Value.func -val num_conv_prim : Type.prim -> Type.prim -> Value.value -> Value.value +val num_conv_trap_prim : Type.prim -> Type.prim -> Value.value -> Value.value +val num_conv_wrap_prim : Type.prim -> Type.prim -> Value.value -> Value.value diff --git a/src/mo_values/show.ml b/src/mo_values/show.ml index c37c736a4a6..11a20182bea 100644 --- a/src/mo_values/show.ml +++ b/src/mo_values/show.ml @@ -38,21 +38,21 @@ let rec show_val t v = let t = T.normalize t in match t, v with | T.(Prim Bool), Value.Bool b -> if b then "true" else "false" - | T.(Prim Nat), Value.Int i -> Value.Int.to_string i - | T.(Prim Nat8), Value.Nat8 i -> Value.Nat8.to_string i - | T.(Prim Nat16), Value.Nat16 i -> Value.Nat16.to_string i - | T.(Prim Nat32), Value.Nat32 i -> Value.Nat32.to_string i - | T.(Prim Nat64), Value.Nat64 i -> Value.Nat64.to_string i - | T.(Prim Int), Value.Int i -> Value.Int.(sign (gt i zero) (to_string i)) - | T.(Prim Int8), Value.Int8 i -> Value.Int_8.(sign (gt i zero) (to_string i)) - | T.(Prim Int16), Value.Int16 i -> Value.Int_16.(sign (gt i zero) (to_string i)) - | T.(Prim Int32), Value.Int32 i -> Value.Int_32.(sign (gt i zero) (to_string i)) - | T.(Prim Int64), Value.Int64 i -> Value.Int_64.(sign (gt i zero) (to_string i)) - | T.(Prim Word8), Value.Word8 i -> "0x" ^ Value.Word8.to_string i - | T.(Prim Word16), Value.Word16 i -> "0x" ^ Value.Word16.to_string i - | T.(Prim Word32), Value.Word32 i -> "0x" ^ Value.Word32.to_string i - | T.(Prim Word64), Value.Word64 i -> "0x" ^ Value.Word64.to_string i - | T.(Prim Float), Value.Float i -> Value.Float.to_string i + | T.(Prim Nat), Value.Int i -> Numerics.Int.to_string i + | T.(Prim Nat8), Value.Nat8 i -> Numerics.Nat8.to_string i + | T.(Prim Nat16), Value.Nat16 i -> Numerics.Nat16.to_string i + | T.(Prim Nat32), Value.Nat32 i -> Numerics.Nat32.to_string i + | T.(Prim Nat64), Value.Nat64 i -> Numerics.Nat64.to_string i + | T.(Prim Int), Value.Int i -> Numerics.Int.(sign (gt i zero) (to_string i)) + | T.(Prim Int8), Value.Int8 i -> Numerics.Int_8.(sign (gt i zero) (to_string i)) + | T.(Prim Int16), Value.Int16 i -> Numerics.Int_16.(sign (gt i zero) (to_string i)) + | T.(Prim Int32), Value.Int32 i -> Numerics.Int_32.(sign (gt i zero) (to_string i)) + | T.(Prim Int64), Value.Int64 i -> Numerics.Int_64.(sign (gt i zero) (to_string i)) + | T.(Prim Word8), Value.Word8 i -> "0x" ^ Numerics.Word8.to_string i + | T.(Prim Word16), Value.Word16 i -> "0x" ^ Numerics.Word16.to_string i + | T.(Prim Word32), Value.Word32 i -> "0x" ^ Numerics.Word32.to_string i + | T.(Prim Word64), Value.Word64 i -> "0x" ^ Numerics.Word64.to_string i + | T.(Prim Float), Value.Float i -> Numerics.Float.to_string i | T.(Prim Text), Value.Text s -> "\"" ^ s ^ "\"" | T.(Prim Blob), Value.Blob s -> "\"" ^ Value.Blob.escape s ^ "\"" | T.(Prim Char), Value.Char c -> "\'" ^ Wasm.Utf8.encode [c] ^ "\'" diff --git a/src/mo_values/value.ml b/src/mo_values/value.ml index a032cfbf6a1..643ea8b36a5 100644 --- a/src/mo_values/value.ml +++ b/src/mo_values/value.ml @@ -1,263 +1,10 @@ open Printf - +open Numerics (* Environments *) module Env = Env.Make(String) - -(* Numeric Representations *) - -let rec add_digits buf s i j k = - if i < j then begin - if k = 0 then Buffer.add_char buf '_'; - Buffer.add_char buf s.[i]; - add_digits buf s (i + 1) j ((k + 2) mod 3) - end - -let is_digit c = '0' <= c && c <= '9' -let isnt_digit c = not (is_digit c) - -let group_num s = - let len = String.length s in - let mant = Lib.Option.get (Lib.String.find_from_opt is_digit s 0) len in - let point = Lib.Option.get (Lib.String.find_from_opt isnt_digit s mant) len in - let frac = Lib.Option.get (Lib.String.find_from_opt is_digit s point) len in - let exp = Lib.Option.get (Lib.String.find_from_opt isnt_digit s frac) len in - let buf = Buffer.create (len*4/3) in - Buffer.add_substring buf s 0 mant; - add_digits buf s mant point ((point - mant) mod 3 + 3); - Buffer.add_substring buf s point (frac - point); - add_digits buf s frac exp 3; - Buffer.add_substring buf s exp (len - exp); - Buffer.contents buf - -(* Represent n-bit integers using k-bit (n<=k) integers by shifting left/right by k-n bits *) -module SubRep (Rep : Wasm.Int.RepType) (Width : sig val bitwidth : int end) : - Wasm.Int.RepType with type t = Rep.t = -struct - let _ = assert (Width.bitwidth < Rep.bitwidth) - - type t = Rep.t - - let bitwidth = Width.bitwidth - let bitdiff = Rep.bitwidth - Width.bitwidth - let inj r = Rep.shift_left r bitdiff - let proj i = Rep.shift_right i bitdiff - - let zero = inj Rep.zero - let one = inj Rep.one - let minus_one = inj Rep.minus_one - let max_int = inj (Rep.shift_right_logical Rep.max_int bitdiff) - let min_int = inj (Rep.shift_right_logical Rep.min_int bitdiff) - let neg i = inj (Rep.neg (proj i)) - let add i j = inj (Rep.add (proj i) (proj j)) - let sub i j = inj (Rep.sub (proj i) (proj j)) - let mul i j = inj (Rep.mul (proj i) (proj j)) - let div i j = inj (Rep.div (proj i) (proj j)) - let rem i j = inj (Rep.rem (proj i) (proj j)) - let logand = Rep.logand - let logor = Rep.logor - let lognot i = inj (Rep.lognot (proj i)) - let logxor i j = inj (Rep.logxor (proj i) (proj j)) - let shift_left i j = Rep.shift_left i j - let shift_right i j = let res = Rep.shift_right i j in inj (proj res) - let shift_right_logical i j = let res = Rep.shift_right_logical i j in inj (proj res) - let of_int i = inj (Rep.of_int i) - let to_int i = Rep.to_int (proj i) - let to_string i = group_num (Rep.to_string (proj i)) - let to_hex_string i = group_num (Rep.to_hex_string (proj i)) -end - -module type WordType = -sig - include Wasm.Int.S - val neg : t -> t - val not : t -> t - val pow : t -> t -> t - val to_string : t -> string - val to_pretty_string : t -> string -end - -module MakeWord - (WasmInt : Wasm.Int.S) (ToInt : sig val to_int : WasmInt.t -> int end) = -struct - include WasmInt - let neg w = sub zero w - let not w = xor w (of_int_s (-1)) - let one = of_int_u 1 - let rec pow x y = - if y = zero then - one - else if and_ y one = zero then - pow (mul x x) (shr_u y one) - else - mul x (pow x (sub y one)) - - let base = of_int_u 16 - let digs = - [|"0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; - "8"; "9"; "A"; "B"; "C"; "D"; "E"; "F"|] - let rec to_pretty_string w = if w = zero then "0" else to_pretty_string' w 0 "" - and to_pretty_string' w i s = - if w = zero then s else - let dig = digs.(ToInt.to_int (WasmInt.rem_u w base)) in - let s' = dig ^ (if i = 4 then "_" else "") ^ s in - to_pretty_string' (WasmInt.div_u w base) (i mod 4 + 1) s' - let to_string = to_pretty_string -end - -module Int32Rep = struct include Int32 let bitwidth = 32 let to_hex_string = Printf.sprintf "%lx" end -module Int16Rep = SubRep (Int32Rep) (struct let bitwidth = 16 end) -module Int8Rep = SubRep (Int32Rep) (struct let bitwidth = 8 end) - -module Word8 = MakeWord (Wasm.Int.Make (Int8Rep)) (Int8Rep) -module Word16 = MakeWord (Wasm.Int.Make (Int16Rep)) (Int16Rep) -module Word32 = MakeWord (Wasm.I32) (Int32) -module Word64 = MakeWord (Wasm.I64) (Int64) - -module type FloatType = -sig - include Wasm.Float.S - val rem : t -> t -> t - val pow : t -> t -> t - val to_pretty_string : t -> string -end - -module MakeFloat(WasmFloat : Wasm.Float.S) = -struct - include WasmFloat - let rem x y = of_float (Float.rem (to_float x) (to_float y)) - let pow x y = of_float (to_float x ** to_float y) - let to_pretty_string w = group_num (WasmFloat.to_string w) - let to_string = to_pretty_string -end - -module Float = MakeFloat(Wasm.F64) - - -module type NumType = -sig - type t - val zero : t - val abs : t -> t - val neg : t -> t - val add : t -> t -> t - val sub : t -> t -> t - val mul : t -> t -> t - val div : t -> t -> t - val rem : t -> t -> t - val pow : t -> t -> t - val eq : t -> t -> bool - val ne : t -> t -> bool - val lt : t -> t -> bool - val gt : t -> t -> bool - val le : t -> t -> bool - val ge : t -> t -> bool - val compare : t -> t -> int - val to_int : t -> int - val of_int : int -> t - val to_big_int : t -> Big_int.big_int - val of_big_int : Big_int.big_int -> t - val of_string : string -> t - val to_string : t -> string - val to_pretty_string : t -> string -end - -module Int : NumType with type t = Big_int.big_int = -struct - open Big_int - type t = big_int - let zero = zero_big_int - let sub = sub_big_int - let abs = abs_big_int - let neg = minus_big_int - let add = add_big_int - let mul = mult_big_int - let div a b = - let q, m = quomod_big_int a b in - if sign_big_int m * sign_big_int a >= 0 then q - else if sign_big_int q = 1 then pred_big_int q else succ_big_int q - let rem a b = - let q, m = quomod_big_int a b in - let sign_m = sign_big_int m in - if sign_m * sign_big_int a >= 0 then m - else - let abs_b = abs_big_int b in - if sign_m = 1 then sub_big_int m abs_b else add_big_int m abs_b - let eq = eq_big_int - let ne x y = not (eq x y) - let lt = lt_big_int - let gt = gt_big_int - let le = le_big_int - let ge = ge_big_int - let compare = compare_big_int - let to_int = int_of_big_int - let of_int = big_int_of_int - let of_big_int i = i - let to_big_int i = i - let to_pretty_string i = group_num (string_of_big_int i) - let to_string = to_pretty_string - let of_string s = - big_int_of_string (String.concat "" (String.split_on_char '_' s)) - - let max_int = big_int_of_int max_int - - let pow x y = - if gt y max_int - then raise (Invalid_argument "Int.pow") - else power_big_int_positive_int x (int_of_big_int y) -end - -module Nat : NumType with type t = Big_int.big_int = -struct - include Int - let sub x y = - let z = Int.sub x y in - if ge z zero then z else raise (Invalid_argument "Nat.sub") -end - -module Ranged (Rep : NumType) (Range : sig val is_range : Rep.t -> bool end) : NumType = -struct - let check i = - if Range.is_range i then i - else raise (Invalid_argument "value out of bounds") - - include Rep - let neg a = let res = Rep.neg a in check res - let abs a = let res = Rep.abs a in check res - let add a b = let res = Rep.add a b in check res - let sub a b = let res = Rep.sub a b in check res - let mul a b = let res = Rep.mul a b in check res - let div a b = let res = Rep.div a b in check res - let pow a b = let res = Rep.pow a b in check res - let of_int i = let res = Rep.of_int i in check res - let of_big_int i = let res = Rep.of_big_int i in check res - let of_string s = let res = Rep.of_string s in check res -end - -module NatRange (Limit : sig val upper : Big_int.big_int end) = -struct - open Big_int - let is_range n = ge_big_int n zero_big_int && lt_big_int n Limit.upper -end - -module Nat8 = Ranged (Nat) (NatRange (struct let upper = Big_int.big_int_of_int 0x100 end)) -module Nat16 = Ranged (Nat) (NatRange (struct let upper = Big_int.big_int_of_int 0x1_0000 end)) -module Nat32 = Ranged (Nat) (NatRange (struct let upper = Big_int.big_int_of_int 0x1_0000_0000 end)) -module Nat64 = Ranged (Nat) (NatRange (struct let upper = Big_int.power_int_positive_int 2 64 end)) - -module IntRange (Limit : sig val upper : Big_int.big_int end) = -struct - open Big_int - let is_range n = ge_big_int n (minus_big_int Limit.upper) && lt_big_int n Limit.upper -end - -module Int_8 = Ranged (Int) (IntRange (struct let upper = Big_int.big_int_of_int 0x80 end)) -module Int_16 = Ranged (Int) (IntRange (struct let upper = Big_int.big_int_of_int 0x8000 end)) -module Int_32 = Ranged (Int) (IntRange (struct let upper = Big_int.big_int_of_int 0x8000_0000 end)) -module Int_64 = Ranged (Int) (IntRange (struct let upper = Big_int.power_int_positive_int 2 63 end)) - (* Blobs *) module Blob = struct diff --git a/src/mo_values/value.mli b/src/mo_values/value.mli index 4b316ec1ce1..71f8ebe0535 100644 --- a/src/mo_values/value.mli +++ b/src/mo_values/value.mli @@ -1,69 +1,5 @@ open Mo_types - -(* Numeric Representations *) - -module type WordType = -sig - include Wasm.Int.S - val neg : t -> t - val not : t -> t - val pow : t -> t -> t - val to_string : t -> string - val to_pretty_string : t -> string -end - -module type NumType = -sig - type t - val zero : t - val abs : t -> t - val neg : t -> t - val add : t -> t -> t - val sub : t -> t -> t - val mul : t -> t -> t - val div : t -> t -> t - val rem : t -> t -> t - val pow : t -> t -> t - val eq : t -> t -> bool - val ne : t -> t -> bool - val lt : t -> t -> bool - val gt : t -> t -> bool - val le : t -> t -> bool - val ge : t -> t -> bool - val compare : t -> t -> int - val to_int : t -> int - val of_int : int -> t - val to_big_int : t -> Big_int.big_int - val of_big_int : Big_int.big_int -> t - val of_string : string -> t - val to_string : t -> string - val to_pretty_string : t -> string -end - -module type FloatType = -sig - include Wasm.Float.S - val rem : t -> t -> t - val pow : t -> t -> t - val to_pretty_string : t -> string -end - -module Word8 : WordType with type bits = int32 -module Word16 : WordType with type bits = int32 -module Word32 : WordType with type bits = int32 and type t = Wasm.I32.t -module Word64 : WordType with type bits = int64 and type t = Wasm.I64.t -module Float : FloatType with type bits = int64 and type t = Wasm.F64.t - -module Nat : NumType with type t = Big_int.big_int -module Int : NumType with type t = Big_int.big_int -module Int_8 : NumType -module Int_16 : NumType -module Int_32 : NumType -module Int_64 : NumType -module Nat8 : NumType -module Nat16 : NumType -module Nat32 : NumType -module Nat64 : NumType +open Numerics module Blob : sig val escape : string -> string diff --git a/src/prelude/prelude.ml b/src/prelude/prelude.ml index aebbbaf4665..4902e15dc45 100644 --- a/src/prelude/prelude.ml +++ b/src/prelude/prelude.ml @@ -158,7 +158,7 @@ func @left_pad(pad : Nat, char : Text, t : Text) : Text { func @digits_dec(x : Nat) : Text = (prim "conv_Char_Text" : Char -> Text) ( (prim "num_conv_Word32_Char" : Word32 -> Char) ( - (prim "num_conv_Nat_Word32" : Nat -> Word32) ( + (prim "num_wrap_Int_Word32" : Int -> Word32) ( x + 0x30 ) ) @@ -176,7 +176,7 @@ func @text_of_Int(x : Int) : Text { func @digits_hex(x : Nat) : Text = (prim "conv_Char_Text" : Char -> Text) ( (prim "num_conv_Word32_Char" : Word32 -> Char) ( - (prim "num_conv_Nat_Word32" : Nat -> Word32) ( + (prim "num_wrap_Int_Word32" : Int -> Word32) ( x + (if (x < 10) 0x30 else 55) ) ) @@ -472,7 +472,7 @@ func rts_callback_table_size() : Nat { (prim "rts_callback_table_size" : () -> N func hashBlob(b : Blob) : Word32 { (prim "crc32Hash" : Blob -> Word32) b }; -// Conversions +// Total conversions (fixed to big) let int64ToInt = @int64ToInt; let int32ToInt = @int32ToInt; @@ -487,42 +487,67 @@ let word32ToNat = @word32ToNat; let word16ToNat = @word16ToNat; let word8ToNat = @word8ToNat; +// Trapping conversions (big to fixed) + func intToInt64(n : Int) : Int64 = (prim "num_conv_Int_Int64" : Int -> Int64) n; -func int64ToWord64(n : Int64) : Word64 = (prim "num_conv_Int64_Word64" : Int64 -> Word64) n; -func word64ToInt64(n : Word64) : Int64 = (prim "num_conv_Word64_Int64" : Word64 -> Int64) n; func intToInt32(n : Int) : Int32 = (prim "num_conv_Int_Int32" : Int -> Int32) n; -func int32ToWord32(n : Int32) : Word32 = (prim "num_conv_Int32_Word32" : Int32 -> Word32) n; -func word32ToInt32(n : Word32) : Int32 = (prim "num_conv_Word32_Int32" : Word32 -> Int32) n; func intToInt16(n : Int) : Int16 = (prim "num_conv_Int_Int16" : Int -> Int16) n; -func int16ToWord16(n : Int16) : Word16 = (prim "num_conv_Int16_Word16" : Int16 -> Word16) n; -func word16ToInt16(n : Word16) : Int16 = (prim "num_conv_Word16_Int16" : Word16 -> Int16) n; func intToInt8(n : Int) : Int8 = (prim "num_conv_Int_Int8" : Int -> Int8) n; -func int8ToWord8(n : Int8) : Word8 = (prim "num_conv_Int8_Word8" : Int8 -> Word8) n; -func word8ToInt8(n : Word8) : Int8 = (prim "num_conv_Word8_Int8" : Word8 -> Int8) n; func natToNat64(n : Nat) : Nat64 = (prim "num_conv_Nat_Nat64" : Nat -> Nat64) n; -func nat64ToWord64(n : Nat64) : Word64 = (prim "num_conv_Nat64_Word64" : Nat64 -> Word64) n; -func word64ToNat64(n : Word64) : Nat64 = (prim "num_conv_Word64_Nat64" : Word64 -> Nat64) n; func natToNat32(n : Nat) : Nat32 = (prim "num_conv_Nat_Nat32" : Nat -> Nat32) n; -func nat32ToWord32(n : Nat32) : Word32 = (prim "num_conv_Nat32_Word32" : Nat32 -> Word32) n; -func word32ToNat32(n : Word32) : Nat32 = (prim "num_conv_Word32_Nat32" : Word32 -> Nat32) n; func natToNat16(n : Nat) : Nat16 = (prim "num_conv_Nat_Nat16" : Nat -> Nat16) n; -func nat16ToWord16(n : Nat16) : Word16 = (prim "num_conv_Nat16_Word16" : Nat16 -> Word16) n; -func word16ToNat16(n : Word16) : Nat16 = (prim "num_conv_Word16_Nat16" : Word16 -> Nat16) n; func natToNat8(n : Nat) : Nat8 = (prim "num_conv_Nat_Nat8" : Nat -> Nat8) n; -func nat8ToWord8(n : Nat8) : Word8 = (prim "num_conv_Nat8_Word8" : Nat8 -> Word8) n; -func word8ToNat8(n : Word8) : Nat8 = (prim "num_conv_Word8_Nat8" : Word8 -> Nat8) n; - -func natToWord8(n : Nat) : Word8 = (prim "num_conv_Nat_Word8" : Nat -> Word8) n; -func intToWord8(n : Int) : Word8 = (prim "num_conv_Int_Word8" : Int -> Word8) n; -func natToWord16(n : Nat) : Word16 = (prim "num_conv_Nat_Word16" : Nat -> Word16) n; -func intToWord16(n : Int) : Word16 = (prim "num_conv_Int_Word16" : Int -> Word16) n; -func natToWord32(n : Nat) : Word32 = (prim "num_conv_Nat_Word32" : Nat -> Word32) n; -func intToWord32(n : Int) : Word32 = (prim "num_conv_Int_Word32" : Int -> Word32) n; -func natToWord64(n : Nat) : Word64 = (prim "num_conv_Nat_Word64" : Nat -> Word64) n; -func intToWord64(n : Int) : Word64 = (prim "num_conv_Int_Word64" : Int -> Word64) n; - -func charToWord32(c : Char) : Word32 = (prim "num_conv_Char_Word32" : Char -> Word32) c; + +// Wrapping conversions (big to fixed, big to word, and within fixed) + +func intToInt64Wrap(n : Int) : Int64 = (prim "num_wrap_Int_Int64" : Int -> Int64) n; +func intToInt32Wrap(n : Int) : Int32 = (prim "num_wrap_Int_Int32" : Int -> Int32) n; +func intToInt16Wrap(n : Int) : Int16 = (prim "num_wrap_Int_Int16" : Int -> Int16) n; +func intToInt8Wrap(n : Int) : Int8 = (prim "num_wrap_Int_Int8" : Int -> Int8) n; + +func natToNat64Wrap(n : Nat) : Nat64 = (prim "num_wrap_Nat_Nat64" : Nat -> Nat64) n; +func natToNat32Wrap(n : Nat) : Nat32 = (prim "num_wrap_Nat_Nat32" : Nat -> Nat32) n; +func natToNat16Wrap(n : Nat) : Nat16 = (prim "num_wrap_Nat_Nat16" : Nat -> Nat16) n; +func natToNat8Wrap(n : Nat) : Nat8 = (prim "num_wrap_Nat_Nat8" : Nat -> Nat8) n; + +func intToWord64Wrap(n : Int) : Word64 = (prim "num_wrap_Int_Word64" : Int -> Word64) n; +func intToWord32Wrap(n : Int) : Word32 = (prim "num_wrap_Int_Word32" : Int -> Word32) n; +func intToWord16Wrap(n : Int) : Word16 = (prim "num_wrap_Int_Word16" : Int -> Word16) n; +func intToWord8Wrap(n : Int) : Word8 = (prim "num_wrap_Int_Word8" : Int -> Word8) n; + +func int64ToWord64(n : Int64) : Word64 = (prim "num_wrap_Int64_Word64" : Int64 -> Word64) n; +func word64ToInt64(n : Word64) : Int64 = (prim "num_wrap_Word64_Int64" : Word64 -> Int64) n; +func int32ToWord32(n : Int32) : Word32 = (prim "num_wrap_Int32_Word32" : Int32 -> Word32) n; +func word32ToInt32(n : Word32) : Int32 = (prim "num_wrap_Word32_Int32" : Word32 -> Int32) n; +func int16ToWord16(n : Int16) : Word16 = (prim "num_wrap_Int16_Word16" : Int16 -> Word16) n; +func word16ToInt16(n : Word16) : Int16 = (prim "num_wrap_Word16_Int16" : Word16 -> Int16) n; +func int8ToWord8(n : Int8) : Word8 = (prim "num_wrap_Int8_Word8" : Int8 -> Word8) n; +func word8ToInt8(n : Word8) : Int8 = (prim "num_wrap_Word8_Int8" : Word8 -> Int8) n; + +func word64ToNat64(n : Word64) : Nat64 = (prim "num_wrap_Word64_Nat64" : Word64 -> Nat64) n; +func nat64ToWord64(n : Nat64) : Word64 = (prim "num_wrap_Nat64_Word64" : Nat64 -> Word64) n; +func word32ToNat32(n : Word32) : Nat32 = (prim "num_wrap_Word32_Nat32" : Word32 -> Nat32) n; +func nat32ToWord32(n : Nat32) : Word32 = (prim "num_wrap_Nat32_Word32" : Nat32 -> Word32) n; +func word16ToNat16(n : Word16) : Nat16 = (prim "num_wrap_Word16_Nat16" : Word16 -> Nat16) n; +func nat16ToWord16(n : Nat16) : Word16 = (prim "num_wrap_Nat16_Word16" : Nat16 -> Word16) n; +func word8ToNat8(n : Word8) : Nat8 = (prim "num_wrap_Word8_Nat8" : Word8 -> Nat8) n; +func nat8ToWord8(n : Nat8) : Word8 = (prim "num_wrap_Nat8_Word8" : Nat8 -> Word8) n; + +// Temporary, to break less of base in #2324 +let natToWord8 : Nat -> Word8 = intToWord8Wrap; +let intToWord8 : Int -> Word8 = intToWord8Wrap; +let natToWord16 : Nat -> Word16 = intToWord16Wrap; +let intToWord16 : Int -> Word16 = intToWord16Wrap; +let natToWord32 : Nat -> Word32 = intToWord32Wrap; +let intToWord32 : Int -> Word32 = intToWord32Wrap; +let natToWord64 : Nat -> Word64 = intToWord64Wrap; +let intToWord64 : Int -> Word64 = intToWord64Wrap; + + +// Char conversion and properties + +func charToWord32(c : Char) : Word32 = (prim "num_wrap_Char_Word32" : Char -> Word32) c; func word32ToChar(w : Word32) : Char = (prim "num_conv_Word32_Char" : Word32 -> Char) w; func charToText(c : Char) : Text = (prim "conv_Char_Text" : Char -> Text) c; diff --git a/test/repl/ok/outrange-int-nat.stderr.ok b/test/repl/ok/outrange-int-nat.stderr.ok index 1cf893b29fe..89e69ec6b84 100644 --- a/test/repl/ok/outrange-int-nat.stderr.ok +++ b/test/repl/ok/outrange-int-nat.stderr.ok @@ -1,12 +1,12 @@ -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds +prim:___: execution error, value out of bounds diff --git a/test/run/conversions.mo b/test/run/conversions.mo index 61d2ff41a71..aace484441a 100644 --- a/test/run/conversions.mo +++ b/test/run/conversions.mo @@ -3,19 +3,19 @@ import Prim "mo:prim"; // Nat <--> Word32 func n2w(n : Nat) : ?Word32 { - let w = Prim.natToWord32 n; + let w = Prim.intToWord32Wrap n; if (n == Prim.word32ToNat w) ?w else null }; -assert(Prim.natToWord32 0 == (0 : Word32)); -assert(Prim.natToWord32 42 == (42 : Word32)); -assert(Prim.natToWord32 65535 == (65535 : Word32)); // 2**16 - 1 +assert(Prim.intToWord32Wrap 0 == (0 : Word32)); +assert(Prim.intToWord32Wrap 42 == (42 : Word32)); +assert(Prim.intToWord32Wrap 65535 == (65535 : Word32)); // 2**16 - 1 -assert(Prim.natToWord32 2147483647 == (2147483647 : Word32)); // 2**31 - 1 -assert(Prim.natToWord32 2147483648 == (2147483648 : Word32)); // 2**31 -assert(Prim.natToWord32 2147483649 == (2147483649 : Word32)); // 2**31 + 1 -assert(Prim.natToWord32 4294967295 == (4294967295 : Word32)); // 2**32 - 1 +assert(Prim.intToWord32Wrap 2147483647 == (2147483647 : Word32)); // 2**31 - 1 +assert(Prim.intToWord32Wrap 2147483648 == (2147483648 : Word32)); // 2**31 +assert(Prim.intToWord32Wrap 2147483649 == (2147483649 : Word32)); // 2**31 + 1 +assert(Prim.intToWord32Wrap 4294967295 == (4294967295 : Word32)); // 2**32 - 1 assert(Prim.word32ToNat 0 == 0); @@ -26,12 +26,12 @@ assert(Prim.word32ToNat 4294967295 == 4294967295); // 2**32 - 1 func forall (f : T -> (), l : [T]) = for (e in l.vals()) { f e }; do { - func roundtrip(n : Nat) = assert (Prim.word32ToNat (Prim.natToWord32 n) == n); + func roundtrip(n : Nat) = assert (Prim.word32ToNat (Prim.intToWord32Wrap n) == n); forall(roundtrip, [0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000, 0x7FFFFFFF, 0xFFFFFFFF]); }; do { - func roundtrip(w : Word32) = assert (Prim.natToWord32 (Prim.word32ToNat w) == w); + func roundtrip(w : Word32) = assert (Prim.intToWord32Wrap (Prim.word32ToNat w) == w); forall(roundtrip, [0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000, 0x7FFFFFFF, 0xFFFFFFFF]); @@ -93,38 +93,38 @@ do { // Int <--> Word32 func i2w(n : Nat) : ?Word32 { - let w = Prim.intToWord32 n; + let w = Prim.intToWord32Wrap n; if (n == Prim.int32ToInt (Prim.word32ToInt32(w))) ?w else null }; -assert(Prim.intToWord32 0 == (0 : Word32)); -assert(Prim.intToWord32 42 == (42 : Word32)); -assert(Prim.intToWord32 65535 == (65535 : Word32)); // 2**16 - 1 +assert(Prim.intToWord32Wrap 0 == (0 : Word32)); +assert(Prim.intToWord32Wrap 42 == (42 : Word32)); +assert(Prim.intToWord32Wrap 65535 == (65535 : Word32)); // 2**16 - 1 -assert(Prim.intToWord32 (-42) == (-42/*!*/ : Word32)); -assert(Prim.intToWord32 (-65535) == (-65535/*!*/ : Word32)); // - 2**16 + 1 -assert(Prim.intToWord32 (-65536) == (-65536/*!*/ : Word32)); // - 2**16 -assert(Prim.intToWord32 (-2147483648) == (-2147483648/*!*/ : Word32)); // - 2**31 +assert(Prim.intToWord32Wrap (-42) == (-42/*!*/ : Word32)); +assert(Prim.intToWord32Wrap (-65535) == (-65535/*!*/ : Word32)); // - 2**16 + 1 +assert(Prim.intToWord32Wrap (-65536) == (-65536/*!*/ : Word32)); // - 2**16 +assert(Prim.intToWord32Wrap (-2147483648) == (-2147483648/*!*/ : Word32)); // - 2**31 -assert(Prim.intToWord32 2147483647 == (2147483647 : Word32)); // 2**31 - 1 -assert(Prim.intToWord32 2147483648 == (2147483648 : Word32)); // 2**31 -assert(Prim.intToWord32 2147483649 == (2147483649 : Word32)); // 2**31 + 1 -assert(Prim.intToWord32 4294967295 == (4294967295 : Word32)); // 2**32 - 1 +assert(Prim.intToWord32Wrap 2147483647 == (2147483647 : Word32)); // 2**31 - 1 +assert(Prim.intToWord32Wrap 2147483648 == (2147483648 : Word32)); // 2**31 +assert(Prim.intToWord32Wrap 2147483649 == (2147483649 : Word32)); // 2**31 + 1 +assert(Prim.intToWord32Wrap 4294967295 == (4294967295 : Word32)); // 2**32 - 1 func println(i : Int) { Prim.debugPrintInt(i) }; do { - func roundtrip(i : Int) = assert (Prim.int32ToInt (Prim.word32ToInt32 (Prim.intToWord32 i)) == i); + func roundtrip(i : Int) = assert (Prim.int32ToInt (Prim.word32ToInt32 (Prim.intToWord32Wrap i)) == i); forall(roundtrip, [0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000, 0x7FFFFFFF]); forall(roundtrip, [-10, -100, -1000, -10000, -100000, -1000000, -10000000, -100000000, -1000000000, -2147483648]); }; do { - func roundtrip(w : Word32) = assert (Prim.intToWord32 (Prim.int32ToInt (Prim.word32ToInt32 w)) == w); + func roundtrip(w : Word32) = assert (Prim.intToWord32Wrap (Prim.int32ToInt (Prim.word32ToInt32 w)) == w); forall(roundtrip, [0, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000, 0x7FFFFFFF, 0xFFFFFFFF]); /* non-canonical range for Word32 */ @@ -156,12 +156,12 @@ assert(switch ("П".chars().next()) { case (?'П') true; case _ false }); // Nat <--> Word64 -assert(Prim.natToWord64 0x0000000000000000 == (0x0000000000000000 : Word64)); -assert(Prim.natToWord64 0x0000000000000001 == (0x0000000000000001 : Word64)); -assert(Prim.natToWord64 0x7FFFFFFFFFFFFFFF == (0x7FFFFFFFFFFFFFFF : Word64)); -assert(Prim.natToWord64 0x8000000000000000 == (0x8000000000000000 : Word64)); -assert(Prim.natToWord64 0x8000000000000001 == (0x8000000000000001 : Word64)); -assert(Prim.natToWord64 0xFFFFFFFFFFFFFFFF == (0xFFFFFFFFFFFFFFFF : Word64)); +assert(Prim.intToWord64Wrap 0x0000000000000000 == (0x0000000000000000 : Word64)); +assert(Prim.intToWord64Wrap 0x0000000000000001 == (0x0000000000000001 : Word64)); +assert(Prim.intToWord64Wrap 0x7FFFFFFFFFFFFFFF == (0x7FFFFFFFFFFFFFFF : Word64)); +assert(Prim.intToWord64Wrap 0x8000000000000000 == (0x8000000000000000 : Word64)); +assert(Prim.intToWord64Wrap 0x8000000000000001 == (0x8000000000000001 : Word64)); +assert(Prim.intToWord64Wrap 0xFFFFFFFFFFFFFFFF == (0xFFFFFFFFFFFFFFFF : Word64)); assert(Prim.word64ToNat 0x0000000000000000 == (0x0000000000000000 : Nat)); assert(Prim.word64ToNat 0x0000000000000001 == (0x0000000000000001 : Nat)); @@ -172,117 +172,117 @@ assert(Prim.word64ToNat 0xFFFFFFFFFFFFFFFF == (0xFFFFFFFFFFFFFFFF : Nat)); // Int <--> Word64 -assert(Prim.intToWord64 0x0000000000000000 == (0x0000000000000000 : Word64)); -assert(Prim.intToWord64 0x0000000000000001 == (0x0000000000000001 : Word64)); -assert(Prim.intToWord64 0x7FFFFFFFFFFFFFFF == (0x7FFFFFFFFFFFFFFF : Word64)); -assert(Prim.intToWord64 (-0x8000000000000000) == (0x8000000000000000 : Word64)); -assert(Prim.intToWord64 (-0x7FFFFFFFFFFFFFFF) == (0x8000000000000001 : Word64)); -assert(Prim.intToWord64 (-0x7FFFFFFFFFFFFFFE) == (0x8000000000000002 : Word64)); -assert(Prim.intToWord64 (-0x0000000000000001) == (0xFFFFFFFFFFFFFFFF : Word64)); +assert(Prim.intToWord64Wrap 0x0000000000000000 == (0x0000000000000000 : Word64)); +assert(Prim.intToWord64Wrap 0x0000000000000001 == (0x0000000000000001 : Word64)); +assert(Prim.intToWord64Wrap 0x7FFFFFFFFFFFFFFF == (0x7FFFFFFFFFFFFFFF : Word64)); +assert(Prim.intToWord64Wrap (-0x8000000000000000) == (0x8000000000000000 : Word64)); +assert(Prim.intToWord64Wrap (-0x7FFFFFFFFFFFFFFF) == (0x8000000000000001 : Word64)); +assert(Prim.intToWord64Wrap (-0x7FFFFFFFFFFFFFFE) == (0x8000000000000002 : Word64)); +assert(Prim.intToWord64Wrap (-0x0000000000000001) == (0xFFFFFFFFFFFFFFFF : Word64)); // Below conversions mainly test the interpreter's bignum arithmetics // Int <--> Word8 -assert(Prim.intToWord8 (2 ** 62) == (0 : Word8)); -assert(Prim.intToWord8 (2 ** 62 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (2 ** 62 - 1) == (255 : Word8)); -assert(Prim.intToWord8 (- 2 ** 62) == (0 : Word8)); -assert(Prim.intToWord8 (- 2 ** 62 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (- 2 ** 62 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 62) == (0 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 62 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 62 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 62) == (0 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 62 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 62 - 1) == (255 : Word8)); -assert(Prim.intToWord8 (2 ** 63) == (0 : Word8)); -assert(Prim.intToWord8 (2 ** 63 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (2 ** 63 - 1) == (255 : Word8)); -assert(Prim.intToWord8 (- 2 ** 63) == (0 : Word8)); -assert(Prim.intToWord8 (- 2 ** 63 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (- 2 ** 63 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 63) == (0 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 63 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 63 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 63) == (0 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 63 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 63 - 1) == (255 : Word8)); -assert(Prim.intToWord8 (2 ** 64) == (0 : Word8)); -assert(Prim.intToWord8 (2 ** 64 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (2 ** 64 - 1) == (255 : Word8)); -assert(Prim.intToWord8 (- 2 ** 64) == (0 : Word8)); -assert(Prim.intToWord8 (- 2 ** 64 + 1) == (1 : Word8)); -assert(Prim.intToWord8 (- 2 ** 64 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64) == (0 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 64) == (0 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 64 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (- 2 ** 64 - 1) == (255 : Word8)); // Nat <--> Word8 -assert(Prim.natToWord8 (2 ** 64) == (0 : Word8)); -assert(Prim.natToWord8 (2 ** 64 + 1) == (1 : Word8)); -assert(Prim.natToWord8 (2 ** 64 - 1) == (255 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64) == (0 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64 + 1) == (1 : Word8)); +assert(Prim.intToWord8Wrap (2 ** 64 - 1) == (255 : Word8)); // Int <--> Word16 -assert(Prim.intToWord16 (2 ** 62) == (0 : Word16)); -assert(Prim.intToWord16 (2 ** 62 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (2 ** 62 - 1) == (65535 : Word16)); -assert(Prim.intToWord16 (- 2 ** 62) == (0 : Word16)); -assert(Prim.intToWord16 (- 2 ** 62 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (- 2 ** 62 - 1) == (65535 : Word16)); - -assert(Prim.intToWord16 (2 ** 63) == (0 : Word16)); -assert(Prim.intToWord16 (2 ** 63 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (2 ** 63 - 1) == (65535 : Word16)); -assert(Prim.intToWord16 (- 2 ** 63) == (0 : Word16)); -assert(Prim.intToWord16 (- 2 ** 63 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (- 2 ** 63 - 1) == (65535 : Word16)); - -assert(Prim.intToWord16 (2 ** 64) == (0 : Word16)); -assert(Prim.intToWord16 (2 ** 64 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (2 ** 64 - 1) == (65535 : Word16)); -assert(Prim.intToWord16 (- 2 ** 64) == (0 : Word16)); -assert(Prim.intToWord16 (- 2 ** 64 + 1) == (1 : Word16)); -assert(Prim.intToWord16 (- 2 ** 64 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 62) == (0 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 62 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 62 - 1) == (65535 : Word16)); + +assert(Prim.intToWord16Wrap (2 ** 63) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 63 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 63 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 63) == (0 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 63 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 63 - 1) == (65535 : Word16)); + +assert(Prim.intToWord16Wrap (2 ** 64) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 64 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 64 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 64) == (0 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 64 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (- 2 ** 64 - 1) == (65535 : Word16)); // Nat <--> Word16 -assert(Prim.natToWord16 (2 ** 62) == (0 : Word16)); -assert(Prim.natToWord16 (2 ** 62 + 1) == (1 : Word16)); -assert(Prim.natToWord16 (2 ** 62 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 62 - 1) == (65535 : Word16)); -assert(Prim.natToWord16 (2 ** 63) == (0 : Word16)); -assert(Prim.natToWord16 (2 ** 63 + 1) == (1 : Word16)); -assert(Prim.natToWord16 (2 ** 63 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 63) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 63 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 63 - 1) == (65535 : Word16)); -assert(Prim.natToWord16 (2 ** 64) == (0 : Word16)); -assert(Prim.natToWord16 (2 ** 64 + 1) == (1 : Word16)); -assert(Prim.natToWord16 (2 ** 64 - 1) == (65535 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 64) == (0 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 64 + 1) == (1 : Word16)); +assert(Prim.intToWord16Wrap (2 ** 64 - 1) == (65535 : Word16)); // Int <--> Word32 -assert(Prim.intToWord32 (2 ** 62) == (0 : Word32)); -assert(Prim.intToWord32 (2 ** 62 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (2 ** 62 - 1) == (4294967295 : Word32)); -assert(Prim.intToWord32 (- 2 ** 62) == (0 : Word32)); -assert(Prim.intToWord32 (- 2 ** 62 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (- 2 ** 62 - 1) == (4294967295 : Word32)); - -assert(Prim.intToWord32 (2 ** 63) == (0 : Word32)); -assert(Prim.intToWord32 (2 ** 63 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (2 ** 63 - 1) == (4294967295 : Word32)); -assert(Prim.intToWord32 (- 2 ** 63) == (0 : Word32)); -assert(Prim.intToWord32 (- 2 ** 63 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (- 2 ** 63 - 1) == (4294967295 : Word32)); - -assert(Prim.intToWord32 (2 ** 64) == (0 : Word32)); -assert(Prim.intToWord32 (2 ** 64 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (2 ** 64 - 1) == (4294967295 : Word32)); -assert(Prim.intToWord32 (- 2 ** 64) == (0 : Word32)); -assert(Prim.intToWord32 (- 2 ** 64 + 1) == (1 : Word32)); -assert(Prim.intToWord32 (- 2 ** 64 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 62) == (0 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 62 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 62 - 1) == (4294967295 : Word32)); + +assert(Prim.intToWord32Wrap (2 ** 63) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 63 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 63 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 63) == (0 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 63 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 63 - 1) == (4294967295 : Word32)); + +assert(Prim.intToWord32Wrap (2 ** 64) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 64 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 64 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 64) == (0 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 64 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (- 2 ** 64 - 1) == (4294967295 : Word32)); // Nat <--> Word32 -assert(Prim.natToWord32 (2 ** 62) == (0 : Word32)); -assert(Prim.natToWord32 (2 ** 62 + 1) == (1 : Word32)); -assert(Prim.natToWord32 (2 ** 62 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 62 - 1) == (4294967295 : Word32)); -assert(Prim.natToWord32 (2 ** 63) == (0 : Word32)); -assert(Prim.natToWord32 (2 ** 63 + 1) == (1 : Word32)); -assert(Prim.natToWord32 (2 ** 63 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 63) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 63 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 63 - 1) == (4294967295 : Word32)); -assert(Prim.natToWord32 (2 ** 64) == (0 : Word32)); -assert(Prim.natToWord32 (2 ** 64 + 1) == (1 : Word32)); -assert(Prim.natToWord32 (2 ** 64 - 1) == (4294967295 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 64) == (0 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 64 + 1) == (1 : Word32)); +assert(Prim.intToWord32Wrap (2 ** 64 - 1) == (4294967295 : Word32)); diff --git a/test/run/hashes.mo b/test/run/hashes.mo index d5aef2a7a0b..9aee03661f9 100644 --- a/test/run/hashes.mo +++ b/test/run/hashes.mo @@ -9,7 +9,7 @@ func hashInt(x : Int) : Word32 { }; let base = 2**32; while (n > 0) { - hash ^= Prim.intToWord32(n % base); + hash ^= Prim.intToWord32Wrap(n % base); n /= base; }; return hash; diff --git a/test/run/iter-no-alloc.mo b/test/run/iter-no-alloc.mo index 94d4722c584..9782b066005 100644 --- a/test/run/iter-no-alloc.mo +++ b/test/run/iter-no-alloc.mo @@ -13,8 +13,8 @@ func iter(what : Text, xs : [A]) { type FixOpt = ?FixOpt; iter("Nat", Prim.Array_tabulate(iters,func x = x)); -iter("Word16", Prim.Array_tabulate(iters,func x = Prim.natToWord16 x)); -iter("Word32", Prim.Array_tabulate(iters,func x = Prim.natToWord32 x)); +iter("Word16", Prim.Array_tabulate(iters,func x = Prim.intToWord16Wrap x)); +iter("Word32", Prim.Array_tabulate(iters,func x = Prim.intToWord32Wrap x)); iter("?Nat, all null", Prim.Array_tabulate(iters,func x = null)); iter("FixOpt, all ?null", Prim.Array_tabulate(iters,func x = ?null)); iter("FixOpt, all ??null", Prim.Array_tabulate(iters,func x = ??null)); diff --git a/test/trap/ok/outrange-int16-lower.run-ir.ok b/test/trap/ok/outrange-int16-lower.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-lower.run-ir.ok +++ b/test/trap/ok/outrange-int16-lower.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int16-lower.run-low.ok b/test/trap/ok/outrange-int16-lower.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-lower.run-low.ok +++ b/test/trap/ok/outrange-int16-lower.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int16-lower.run.ok b/test/trap/ok/outrange-int16-lower.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-lower.run.ok +++ b/test/trap/ok/outrange-int16-lower.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int16-upper.run-ir.ok b/test/trap/ok/outrange-int16-upper.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-upper.run-ir.ok +++ b/test/trap/ok/outrange-int16-upper.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int16-upper.run-low.ok b/test/trap/ok/outrange-int16-upper.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-upper.run-low.ok +++ b/test/trap/ok/outrange-int16-upper.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int16-upper.run.ok b/test/trap/ok/outrange-int16-upper.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int16-upper.run.ok +++ b/test/trap/ok/outrange-int16-upper.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-lower.run-ir.ok b/test/trap/ok/outrange-int32-lower.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-lower.run-ir.ok +++ b/test/trap/ok/outrange-int32-lower.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-lower.run-low.ok b/test/trap/ok/outrange-int32-lower.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-lower.run-low.ok +++ b/test/trap/ok/outrange-int32-lower.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-lower.run.ok b/test/trap/ok/outrange-int32-lower.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-lower.run.ok +++ b/test/trap/ok/outrange-int32-lower.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-upper.run-ir.ok b/test/trap/ok/outrange-int32-upper.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-upper.run-ir.ok +++ b/test/trap/ok/outrange-int32-upper.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-upper.run-low.ok b/test/trap/ok/outrange-int32-upper.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-upper.run-low.ok +++ b/test/trap/ok/outrange-int32-upper.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int32-upper.run.ok b/test/trap/ok/outrange-int32-upper.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int32-upper.run.ok +++ b/test/trap/ok/outrange-int32-upper.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-lower.run-ir.ok b/test/trap/ok/outrange-int64-lower.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-lower.run-ir.ok +++ b/test/trap/ok/outrange-int64-lower.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-lower.run-low.ok b/test/trap/ok/outrange-int64-lower.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-lower.run-low.ok +++ b/test/trap/ok/outrange-int64-lower.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-lower.run.ok b/test/trap/ok/outrange-int64-lower.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-lower.run.ok +++ b/test/trap/ok/outrange-int64-lower.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-upper.run-ir.ok b/test/trap/ok/outrange-int64-upper.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-upper.run-ir.ok +++ b/test/trap/ok/outrange-int64-upper.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-upper.run-low.ok b/test/trap/ok/outrange-int64-upper.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-upper.run-low.ok +++ b/test/trap/ok/outrange-int64-upper.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int64-upper.run.ok b/test/trap/ok/outrange-int64-upper.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int64-upper.run.ok +++ b/test/trap/ok/outrange-int64-upper.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-lower.run-ir.ok b/test/trap/ok/outrange-int8-lower.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-lower.run-ir.ok +++ b/test/trap/ok/outrange-int8-lower.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-lower.run-low.ok b/test/trap/ok/outrange-int8-lower.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-lower.run-low.ok +++ b/test/trap/ok/outrange-int8-lower.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-lower.run.ok b/test/trap/ok/outrange-int8-lower.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-lower.run.ok +++ b/test/trap/ok/outrange-int8-lower.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-upper.run-ir.ok b/test/trap/ok/outrange-int8-upper.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-upper.run-ir.ok +++ b/test/trap/ok/outrange-int8-upper.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-upper.run-low.ok b/test/trap/ok/outrange-int8-upper.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-upper.run-low.ok +++ b/test/trap/ok/outrange-int8-upper.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-int8-upper.run.ok b/test/trap/ok/outrange-int8-upper.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-int8-upper.run.ok +++ b/test/trap/ok/outrange-int8-upper.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat16.run-ir.ok b/test/trap/ok/outrange-nat16.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat16.run-ir.ok +++ b/test/trap/ok/outrange-nat16.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat16.run-low.ok b/test/trap/ok/outrange-nat16.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat16.run-low.ok +++ b/test/trap/ok/outrange-nat16.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat16.run.ok b/test/trap/ok/outrange-nat16.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat16.run.ok +++ b/test/trap/ok/outrange-nat16.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat32.run-ir.ok b/test/trap/ok/outrange-nat32.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat32.run-ir.ok +++ b/test/trap/ok/outrange-nat32.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat32.run-low.ok b/test/trap/ok/outrange-nat32.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat32.run-low.ok +++ b/test/trap/ok/outrange-nat32.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat32.run.ok b/test/trap/ok/outrange-nat32.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat32.run.ok +++ b/test/trap/ok/outrange-nat32.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat64.run-ir.ok b/test/trap/ok/outrange-nat64.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat64.run-ir.ok +++ b/test/trap/ok/outrange-nat64.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat64.run-low.ok b/test/trap/ok/outrange-nat64.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat64.run-low.ok +++ b/test/trap/ok/outrange-nat64.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat64.run.ok b/test/trap/ok/outrange-nat64.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat64.run.ok +++ b/test/trap/ok/outrange-nat64.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat8.run-ir.ok b/test/trap/ok/outrange-nat8.run-ir.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat8.run-ir.ok +++ b/test/trap/ok/outrange-nat8.run-ir.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat8.run-low.ok b/test/trap/ok/outrange-nat8.run-low.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat8.run-low.ok +++ b/test/trap/ok/outrange-nat8.run-low.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds diff --git a/test/trap/ok/outrange-nat8.run.ok b/test/trap/ok/outrange-nat8.run.ok index c528d8b4c4e..785d7427085 100644 --- a/test/trap/ok/outrange-nat8.run.ok +++ b/test/trap/ok/outrange-nat8.run.ok @@ -1 +1 @@ -prim:___: execution error, numeric overflow +prim:___: execution error, value out of bounds