Skip to content

Commit

Permalink
Distinguish the different kind of integers
Browse files Browse the repository at this point in the history
Co-authored-by: Olivier Nicole <[email protected]>
  • Loading branch information
vouillon and OlivierNicole committed Jul 31, 2024
1 parent dd2ad41 commit 38695ed
Show file tree
Hide file tree
Showing 5 changed files with 60 additions and 18 deletions.
58 changes: 47 additions & 11 deletions compiler/lib/code.ml
Original file line number Diff line number Diff line change
Expand Up @@ -363,9 +363,11 @@ type constant =
| NativeString of Native_string.t
| Float of float
| Float_array of float array
| Int of int32
| Int32 of int32
| Int64 of int64
| NativeInt of nativeint
| Tuple of int * constant array * array_or_not
| Int of int32

let rec constant_equal a b =
match a, b with
Expand All @@ -383,26 +385,58 @@ let rec constant_equal a b =
| Some s, Some c -> same := Some (s && c)
done;
!same
| Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
| Int64 a, Int64 b -> Some (Int64.equal a b)
| NativeInt a, NativeInt b -> Some (Nativeint.equal a b)
| Float_array a, Float_array b -> Some (Array.equal Float.equal a b)
| Int a, Int b -> Some (Int32.equal a b)
| Float a, Float b -> Some (Float.equal a b)
| String _, NativeString _ | NativeString _, String _ -> None
| Int _, Float _ | Float _, Int _ -> None
| Tuple ((0 | 254), _, _), Float_array _ -> None
| Float_array _, Tuple ((0 | 254), _, _) -> None
| Tuple _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Float_array _) ->
Some false
| Float_array _, (String _ | NativeString _ | Int64 _ | Int _ | Float _ | Tuple _) ->
Some false
| String _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
| NativeString _, (Int64 _ | Int _ | Float _ | Tuple _ | Float_array _) -> Some false
| Int64 _, (String _ | NativeString _ | Int _ | Float _ | Tuple _ | Float_array _) ->
| ( Tuple _
, ( String _
| NativeString _
| Int64 _
| Int _
| Int32 _
| NativeInt _
| Float _
| Float_array _ ) ) -> Some false
| ( Float_array _
, ( String _
| NativeString _
| Int64 _
| Int _
| Int32 _
| NativeInt _
| Float _
| Tuple _ ) ) -> Some false
| String _, (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _)
-> Some false
| ( NativeString _
, (Int64 _ | Int _ | Int32 _ | NativeInt _ | Float _ | Tuple _ | Float_array _) ) ->
Some false
| ( Int64 _
, ( String _
| NativeString _
| Int _
| Int32 _
| NativeInt _
| Float _
| Tuple _
| Float_array _ ) ) -> Some false
| Float _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
Some false
| Int _, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ->
| ( (Int _ | Int32 _ | NativeInt _)
, (String _ | NativeString _ | Float_array _ | Int64 _ | Tuple (_, _, _)) ) ->
Some false
(* Note: the following cases should not occur when compiling to Javascript *)
| Int _, (Int32 _ | NativeInt _)
| Int32 _, (Int _ | NativeInt _)
| NativeInt _, (Int _ | Int32 _)
| (Int32 _ | NativeInt _), Float _
| Float _, (Int32 _ | NativeInt _) -> None

type loc =
| No
Expand Down Expand Up @@ -492,7 +526,10 @@ module Print = struct
Format.fprintf f "%.12g" a.(i)
done;
Format.fprintf f "|]"
| Int i -> Format.fprintf f "%ld" i
| Int32 i -> Format.fprintf f "%ldl" i
| Int64 i -> Format.fprintf f "%LdL" i
| NativeInt i -> Format.fprintf f "%ndn" i
| Tuple (tag, a, _) -> (
Format.fprintf f "<%d>" tag;
match Array.length a with
Expand All @@ -509,7 +546,6 @@ module Print = struct
constant f a.(i)
done;
Format.fprintf f ")")
| Int i -> Format.fprintf f "%ld" i

let arg f a =
match a with
Expand Down
4 changes: 3 additions & 1 deletion compiler/lib/code.mli
Original file line number Diff line number Diff line change
Expand Up @@ -181,9 +181,11 @@ type constant =
| NativeString of Native_string.t
| Float of float
| Float_array of float array
| Int of int32
| Int32 of int32 (** Only produced when compiling to WebAssembly. *)
| Int64 of int64
| NativeInt of nativeint (** Only produced when compiling to WebAssembly. *)
| Tuple of int * constant array * array_or_not
| Int of int32

val constant_equal : constant -> constant -> bool option

Expand Down
12 changes: 7 additions & 5 deletions compiler/lib/eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -110,8 +110,8 @@ let eval_prim x =
| "caml_mul_float", _ -> float_binop l ( *. )
| "caml_div_float", _ -> float_binop l ( /. )
| "caml_fmod_float", _ -> float_binop l mod_float
| "caml_int_of_float", [ Float f ] -> Some (Int (Int32.of_float f))
| "to_int", [ Float f ] -> Some (Int (Int32.of_float f))
| "caml_int_of_float", [ Float f ] -> Some (Int (Int.of_float f))
| "to_int", [ Float f ] -> Some (Int (Int.of_float f))
| "to_int", [ Int i ] -> Some (Int i)
(* Math *)
| "caml_neg_float", _ -> float_unop l ( ~-. )
Expand All @@ -130,9 +130,9 @@ let eval_prim x =
| "caml_sqrt_float", _ -> float_unop l sqrt
| "caml_tan_float", _ -> float_unop l tan
| ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
let pos = Int.to_int pos in
let pos = Int32.to_int pos in
if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
then Some (Int (Int.of_int (Char.code s.[pos])))
then Some (Int (Int32.of_int (Char.code s.[pos])))
else None
| "caml_string_equal", [ String s1; String s2 ] -> bool (String.equal s1 s2)
| "caml_string_notequal", [ String s1; String s2 ] ->
Expand Down Expand Up @@ -332,10 +332,12 @@ let the_cond_of info x =
info
(fun x ->
match Flow.Info.def info x with
| Some (Constant (Int 0l)) -> Zero
| Some (Constant (Int 0l | Int32 0l | NativeInt 0n)) -> Zero
| Some
(Constant
( Int _
| Int32 _
| NativeInt _
| Float _
| Tuple _
| String _
Expand Down
2 changes: 2 additions & 0 deletions compiler/lib/generate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -490,6 +490,8 @@ let rec constant_rec ~ctx x level instrs =
in
Mlvalue.Block.make ~tag ~args:l, instrs)
| Int i -> int32 i, instrs
| Int32 _ | NativeInt _ ->
assert false (* Should not be produced when compiling to Javascript *)

let constant ~ctx x level =
let expr, instr = constant_rec ~ctx x level [] in
Expand Down
2 changes: 1 addition & 1 deletion compiler/lib/parse_bytecode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -515,7 +515,7 @@ end = struct
| Float_array _ -> false
| Int64 _ -> false
| Tuple _ -> false
| Int _ -> true
| Int _ | Int32 _ | NativeInt _ -> true
end

let const i = Constant (Int i)
Expand Down

0 comments on commit 38695ed

Please sign in to comment.