Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Value.Numerics: Refactoring to prepare word deprecation #2324

Merged
merged 12 commits into from
Feb 10, 2021
120 changes: 57 additions & 63 deletions src/codegen/compile.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -1592,6 +1592,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)))
Expand All @@ -1602,7 +1604,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
Expand Down Expand Up @@ -2485,7 +2487,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 *)
Expand Down Expand Up @@ -2827,7 +2829,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

Expand Down Expand Up @@ -5949,28 +5951,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)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'll trust you that these are computing the same result....

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That’s good, I just hope they do :-)

But with the spec in the comment (in particular the restriction on the domain), I found this code easier to understand.

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)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I assume the changes in the word cases are for uniformity?

Copy link
Collaborator Author

@nomeata nomeata Feb 9, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

more for historical reasons. In #2309 I removed word types alltogether. Then I learened that this was premature mumble mumble, and I added the word types to that PR, based on what is there (as if it never existed).

And then, I extracted part of those changes into this PR. In that sense, the diff is not minimal to where we come from (master), but to where we want to got (#2309)

| 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
Expand All @@ -5987,10 +5990,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"
Expand Down Expand Up @@ -6777,41 +6776,40 @@ 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
| _ -> 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,
Expand All @@ -6823,10 +6821,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 ^^
Expand All @@ -6846,10 +6842,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 ^^
Expand Down Expand Up @@ -7113,12 +7107,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 ^^
Expand All @@ -7127,12 +7121,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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is it ok that these use Nats but prelude types are still Word based? I assume so but just pointing out the change.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, this is a little code smell: TaggedSmallWord takes a (Motoko-level) type argument, but all it really cares about is the bit width. This just anticipates removing the Word type.

I was even considering refactoring our types to use Fixed of (Signedness * Bitwidth)… it would simplify a bunch of code like this.

| 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))

Expand Down Expand Up @@ -7171,11 +7165,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
Expand Down Expand Up @@ -7378,7 +7372,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)
Expand Down
33 changes: 17 additions & 16 deletions src/ir_def/arrange_ir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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 *)
Expand Down
8 changes: 6 additions & 2 deletions src/ir_def/check_ir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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] ->
Expand Down
61 changes: 31 additions & 30 deletions src/ir_def/ir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 *)
Expand Down Expand Up @@ -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 *)

Expand Down
Loading