Skip to content

Commit

Permalink
separate module
Browse files Browse the repository at this point in the history
  • Loading branch information
hhugo committed Sep 27, 2024
1 parent 9594d2c commit c0bfcf8
Show file tree
Hide file tree
Showing 4 changed files with 128 additions and 132 deletions.
2 changes: 1 addition & 1 deletion compiler/lib/flow.mli
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,6 @@ val the_string_of : Info.t -> Code.prim_arg -> string option

val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option

val the_int : Info.t -> Code.prim_arg -> Stdlib.Targetint.t option
val the_int : Info.t -> Code.prim_arg -> Targetint.t option

val f : ?skip_param:bool -> Code.program -> Code.program * Info.t
131 changes: 0 additions & 131 deletions compiler/lib/stdlib.ml
Original file line number Diff line number Diff line change
Expand Up @@ -288,137 +288,6 @@ module Nativeint = struct
external equal : nativeint -> nativeint -> bool = "%equal"
end

module Targetint : sig
type t

val equal : t -> t -> bool

val compare : t -> t -> int

val to_string : t -> string

val to_int_exn : t -> int

val to_float : t -> float

val of_string : string -> t

val of_float : float -> t

val of_int_exn : int -> t

val of_int32_warning_on_overflow : int32 -> t

val of_nativeint_warning_on_overflow : nativeint -> t

val of_int_warning_on_overflow : int -> t

val succ : 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 logand : t -> t -> t

val logor : t -> t -> t

val logxor : t -> t -> t

val shift_left : t -> int -> t

val shift_right : t -> int -> t

val shift_right_logical : t -> int -> t

val neg : t -> t

val abs : t -> t

val ( >= ) : t -> t -> bool

val ( <= ) : t -> t -> bool

val ( < ) : t -> t -> bool

val ( > ) : t -> t -> bool

val ( = ) : t -> t -> bool

val ( <> ) : t -> t -> bool

val is_zero : t -> bool

val num_bits : int

val zero : t

val one : t
end = struct
include Int32

let num_bits = 32

let is_zero x = equal x 0l

let of_int_exn x = of_int x

let to_int_exn x = to_int x

external ( < ) : int32 -> int32 -> bool = "%lessthan"

external ( <= ) : int32 -> int32 -> bool = "%lessequal"

external ( <> ) : int32 -> int32 -> bool = "%notequal"

external ( = ) : int32 -> int32 -> bool = "%equal"

external ( > ) : int32 -> int32 -> bool = "%greaterthan"

external ( >= ) : int32 -> int32 -> bool = "%greaterequal"

let warn_overflow ~to_dec ~to_hex i i32 =
warn
"Warning: integer overflow: integer 0x%s (%s) truncated to 0x%lx (%ld); the \
generated code might be incorrect.@."
(to_hex i)
(to_dec i)
i32
i32

let convert_warning_on_overflow ~to_int32 ~of_int32 ~equal ~to_dec ~to_hex x =
let i32 = to_int32 x in
let x' = of_int32 i32 in
if not (equal x' x) then warn_overflow ~to_dec ~to_hex x i32;
i32

let of_int_warning_on_overflow i =
convert_warning_on_overflow
~to_int32:Int32.of_int
~of_int32:Int32.to_int
~equal:Int_replace_polymorphic_compare.( = )
~to_dec:(Printf.sprintf "%d")
~to_hex:(Printf.sprintf "%x")
i

let of_int32_warning_on_overflow i = i

let of_nativeint_warning_on_overflow n =
convert_warning_on_overflow
~to_int32:Nativeint.to_int32
~of_int32:Nativeint.of_int32
~equal:Nativeint.equal
~to_dec:(Printf.sprintf "%nd")
~to_hex:(Printf.sprintf "%nx")
n
end

module Option = struct
let map ~f x =
match x with
Expand Down
56 changes: 56 additions & 0 deletions compiler/lib/targetint.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,56 @@
include Int32

let num_bits = 32

let is_zero x = equal x 0l

let of_int_exn x = of_int x

let to_int_exn x = to_int x

external ( < ) : int32 -> int32 -> bool = "%lessthan"

external ( <= ) : int32 -> int32 -> bool = "%lessequal"

external ( <> ) : int32 -> int32 -> bool = "%notequal"

external ( = ) : int32 -> int32 -> bool = "%equal"

external ( > ) : int32 -> int32 -> bool = "%greaterthan"

external ( >= ) : int32 -> int32 -> bool = "%greaterequal"

let warn_overflow ~to_dec ~to_hex i i32 =
Stdlib.warn
"Warning: integer overflow: integer 0x%s (%s) truncated to 0x%lx (%ld); the \
generated code might be incorrect.@."
(to_hex i)
(to_dec i)
i32
i32

let convert_warning_on_overflow ~to_int32 ~of_int32 ~equal ~to_dec ~to_hex x =
let i32 = to_int32 x in
let x' = of_int32 i32 in
if not (equal x' x) then warn_overflow ~to_dec ~to_hex x i32;
i32

let of_int_warning_on_overflow i =
convert_warning_on_overflow
~to_int32:Int32.of_int
~of_int32:Int32.to_int
~equal:Int_replace_polymorphic_compare.( = )
~to_dec:(Printf.sprintf "%d")
~to_hex:(Printf.sprintf "%x")
i

let of_int32_warning_on_overflow i = i

let of_nativeint_warning_on_overflow n =
convert_warning_on_overflow
~to_int32:Nativeint.to_int32
~of_int32:Nativeint.of_int32
~equal:Nativeint.equal
~to_dec:(Printf.sprintf "%nd")
~to_hex:(Printf.sprintf "%nx")
n
71 changes: 71 additions & 0 deletions compiler/lib/targetint.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,71 @@
type t

val equal : t -> t -> bool

val compare : t -> t -> int

val to_string : t -> string

val to_int_exn : t -> int

val to_float : t -> float

val of_string : string -> t

val of_float : float -> t

val of_int_exn : int -> t

val of_int32_warning_on_overflow : int32 -> t

val of_nativeint_warning_on_overflow : nativeint -> t

val of_int_warning_on_overflow : int -> t

val succ : 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 logand : t -> t -> t

val logor : t -> t -> t

val logxor : t -> t -> t

val shift_left : t -> int -> t

val shift_right : t -> int -> t

val shift_right_logical : t -> int -> t

val neg : t -> t

val abs : t -> t

val ( >= ) : t -> t -> bool

val ( <= ) : t -> t -> bool

val ( < ) : t -> t -> bool

val ( > ) : t -> t -> bool

val ( = ) : t -> t -> bool

val ( <> ) : t -> t -> bool

val is_zero : t -> bool

val num_bits : int

val zero : t

val one : t

0 comments on commit c0bfcf8

Please sign in to comment.