Skip to content

Commit 1e40897

Browse files
jvanburenjvanburen
committed
formatted
1 parent 8ad12b4 commit 1e40897

File tree

1 file changed

+62
-62
lines changed

1 file changed

+62
-62
lines changed

‎middle_end/flambda2/to_cmm/to_cmm_primitive.ml

+62-62
Original file line numberDiff line numberDiff line change
@@ -528,24 +528,24 @@ let dead_slots_msg dbg function_slots value_slots =
528528

529529
(* Arithmetic primitives *)
530530

531-
let integral_of_standard_int : K.Standard_int.t -> C.Numeric.Integral.t
532-
=
531+
let integral_of_standard_int : K.Standard_int.t -> C.Numeric.Integral.t =
533532
let[@inline] untagged_int bit_width : C.Numeric.Integral.t =
534533
Untagged (C.Numeric.Integer.create_exn ~bit_width ~signedness:Signed)
535534
in
536535
function
537-
| Naked_int8 -> untagged_int 8
538-
| Naked_int16 -> untagged_int 16
539-
| Naked_int32 -> untagged_int 32
540-
| Naked_int64 -> untagged_int 64
541-
| Naked_nativeint -> Untagged C.Numeric.Integer.nativeint
542-
| Naked_immediate -> Untagged (C.Numeric.Tagged_integer.(untagged immediate))
543-
| Tagged_immediate -> Tagged C.Numeric.Tagged_integer.immediate
544-
545-
let numeric_of_standard_int_or_float : K.Standard_int_or_float.t -> C.Numeric.t =
536+
| Naked_int8 -> untagged_int 8
537+
| Naked_int16 -> untagged_int 16
538+
| Naked_int32 -> untagged_int 32
539+
| Naked_int64 -> untagged_int 64
540+
| Naked_nativeint -> Untagged C.Numeric.Integer.nativeint
541+
| Naked_immediate -> Untagged C.Numeric.Tagged_integer.(untagged immediate)
542+
| Tagged_immediate -> Tagged C.Numeric.Tagged_integer.immediate
543+
544+
let numeric_of_standard_int_or_float : K.Standard_int_or_float.t -> C.Numeric.t
545+
=
546546
let[@inline] untagged_int bit_width : C.Numeric.t =
547-
Integral (Untagged (C.Numeric.Integer.create_exn
548-
~bit_width ~signedness:Signed))
547+
Integral
548+
(Untagged (C.Numeric.Integer.create_exn ~bit_width ~signedness:Signed))
549549
in
550550
function
551551
| Naked_int8 -> untagged_int 8
@@ -554,30 +554,29 @@ let numeric_of_standard_int_or_float : K.Standard_int_or_float.t -> C.Numeric.t
554554
| Naked_int64 -> untagged_int 64
555555
| Naked_nativeint -> Integral (Untagged C.Numeric.Integer.nativeint)
556556
| Naked_immediate ->
557-
Integral (Untagged (C.Numeric.Tagged_integer.(untagged immediate)))
557+
Integral (Untagged C.Numeric.Tagged_integer.(untagged immediate))
558558
| Tagged_immediate -> Integral (Tagged C.Numeric.Tagged_integer.immediate)
559559
| Naked_float32 -> Float Float32
560560
| Naked_float -> Float Float64
561561

562-
563562
let unary_int_arith_primitive _env dbg kind op arg =
564563
match (op : P.unary_int_arith_op) with
565564
| Neg -> (
566-
match integral_of_standard_int kind with
567-
| Tagged src ->
568-
C.Numeric.Tagged_integer.static_cast arg
569-
~src ~dst:C.Numeric.Tagged_integer.immediate ~dbg
570-
|> (fun arg -> (C.negint arg dbg))
571-
|> C.Numeric.Tagged_integer.static_cast
572-
~src:C.Numeric.Tagged_integer.immediate ~dst:src ~dbg
573-
| Untagged src ->
574-
C.Numeric.Integer.static_cast arg
575-
~src ~dst:C.Numeric.Integer.nativeint ~dbg
576-
|> (fun arg ->
577-
let bits = C.Numeric.Integer.bit_width src in
578-
(C.sub_int (C.int ~dbg 0) (C.low_bits ~bits arg dbg) dbg))
579-
|> C.Numeric.Integer.static_cast
580-
~src:C.Numeric.Integer.nativeint ~dst:src ~dbg)
565+
match integral_of_standard_int kind with
566+
| Tagged src ->
567+
C.Numeric.Tagged_integer.static_cast arg ~src
568+
~dst:C.Numeric.Tagged_integer.immediate ~dbg
569+
|> (fun arg -> C.negint arg dbg)
570+
|> C.Numeric.Tagged_integer.static_cast
571+
~src:C.Numeric.Tagged_integer.immediate ~dst:src ~dbg
572+
| Untagged src ->
573+
C.Numeric.Integer.static_cast arg ~src ~dst:C.Numeric.Integer.nativeint
574+
~dbg
575+
|> (fun arg ->
576+
let bits = C.Numeric.Integer.bit_width src in
577+
C.sub_int (C.int ~dbg 0) (C.low_bits ~bits arg dbg) dbg)
578+
|> C.Numeric.Integer.static_cast ~src:C.Numeric.Integer.nativeint ~dst:src
579+
~dbg)
581580
| Swap_byte_endianness -> (
582581
match (kind : K.Standard_int.t) with
583582
| Tagged_immediate ->
@@ -614,11 +613,12 @@ let arithmetic_conversion dbg src dst arg =
614613
let extra =
615614
match src, dst with
616615
| Integral (Tagged src), Integral (Untagged dst)
617-
when C.Numeric.Integer.equal (C.Numeric.Tagged_integer.untagged src)
618-
dst
619-
-> Some (Env.Untag arg)
620-
| (Integral (Tagged _ | Untagged _) | Float (Float32 | Float64)),
621-
(Integral (Tagged _ | Untagged _) | Float (Float32 | Float64)) -> None
616+
when C.Numeric.Integer.equal (C.Numeric.Tagged_integer.untagged src) dst
617+
->
618+
Some (Env.Untag arg)
619+
| ( (Integral (Tagged _ | Untagged _) | Float (Float32 | Float64)),
620+
(Integral (Tagged _ | Untagged _) | Float (Float32 | Float64)) ) ->
621+
None
622622
in
623623
extra, C.Numeric.static_cast ~dbg ~src ~dst arg
624624

@@ -629,21 +629,21 @@ let phys_equal _env dbg op x y =
629629
| Neq -> C.neq ~dbg x y
630630

631631
let binary_int_arith_primitive _env dbg (kind : K.Standard_int.t)
632-
(op : P.binary_int_arith_op) x y =
632+
(op : P.binary_int_arith_op) x y =
633633
let kind = integral_of_standard_int kind in
634-
let[@inline] wrap f =
634+
let[@inline] wrap f =
635635
(* We cast the operands to the width that the operator expects, apply the
636636
operator, and cast the result back. *)
637637
let operator_type : C.Numeric.Integral.t =
638638
match kind with
639-
| Untagged _ -> Untagged (C.Numeric.Integer.nativeint)
640-
| Tagged _ -> Tagged (C.Numeric.Tagged_integer.immediate)
639+
| Untagged _ -> Untagged C.Numeric.Integer.nativeint
640+
| Tagged _ -> Tagged C.Numeric.Tagged_integer.immediate
641641
in
642642
let requires_sign_extended_operands =
643643
match op with
644644
| Div | Mod ->
645-
(* Note that it would be wrong to apply [C.low_bits] to operands
646-
for div and mod.
645+
(* Note that it would be wrong to apply [C.low_bits] to operands for div
646+
and mod.
647647
648648
Some background: The problem arises in cases like: [(num1 * num2) /
649649
num3]. If an overflow occurs in the multiplication, then we must deal
@@ -694,30 +694,30 @@ let binary_int_arith_primitive _env dbg (kind : K.Standard_int.t)
694694
sign-extensions, e.g. when chaining additions together. Also see comment
695695
below about [C.low_bits] in the [Div] and [Mod] cases. *)
696696
in
697-
698697
match kind with
699-
| Tagged _ -> (match op with
698+
| Tagged _ -> (
699+
match op with
700700
| Add -> wrap C.add_int_caml
701701
| Sub -> wrap C.sub_int_caml
702702
| Mul -> wrap C.mul_int_caml
703703
| Div -> wrap (C.div_int_caml Unsafe)
704704
| Mod -> wrap (C.mod_int_caml Unsafe)
705705
| And -> wrap C.and_int_caml
706-
| Or -> wrap C.or_int_caml
706+
| Or -> wrap C.or_int_caml
707707
| Xor -> wrap C.xor_int_caml)
708-
| Untagged untagged ->
708+
| Untagged untagged -> (
709709
let dividend_cannot_be_min_int =
710710
C.Numeric.Integer.bit_width untagged < C.arch_bits
711711
in
712-
(match op with
713-
| Add -> wrap C.add_int
714-
| Sub -> wrap C.sub_int
715-
| Mul -> wrap C.mul_int
716-
| Div -> wrap (C.safe_div_bi Unsafe ~dividend_cannot_be_min_int)
717-
| Mod -> wrap (C.safe_mod_bi Unsafe ~dividend_cannot_be_min_int)
718-
| And -> wrap C.and_int
719-
| Or -> wrap C.or_int
720-
| Xor -> wrap C.xor_int)
712+
match op with
713+
| Add -> wrap C.add_int
714+
| Sub -> wrap C.sub_int
715+
| Mul -> wrap C.mul_int
716+
| Div -> wrap (C.safe_div_bi Unsafe ~dividend_cannot_be_min_int)
717+
| Mod -> wrap (C.safe_mod_bi Unsafe ~dividend_cannot_be_min_int)
718+
| And -> wrap C.and_int
719+
| Or -> wrap C.or_int
720+
| Xor -> wrap C.xor_int)
721721

722722
let binary_int_shift_primitive _env dbg kind (op : P.int_shift_op) x y =
723723
(* See comments on [binary_int_arity_primitive], above, about sign extension
@@ -773,14 +773,14 @@ let binary_int_comp_primitive _env dbg kind cmp x y =
773773
| Tagged _, Gt Unsigned -> C.ugt ~dbg (C.ignore_low_bit_int x) y
774774
| Tagged _, Ge Unsigned -> C.uge ~dbg x (C.ignore_low_bit_int y)
775775
(* Naked integers. *)
776-
| Untagged _ , Lt Signed -> C.lt ~dbg x y
777-
| Untagged _ , Le Signed -> C.le ~dbg x y
778-
| Untagged _ , Gt Signed -> C.gt ~dbg x y
779-
| Untagged _ , Ge Signed -> C.ge ~dbg x y
780-
| Untagged _ , Lt Unsigned -> C.ult ~dbg x y
781-
| Untagged _ , Le Unsigned -> C.ule ~dbg x y
782-
| Untagged _ , Gt Unsigned -> C.ugt ~dbg x y
783-
| Untagged _ , Ge Unsigned -> C.uge ~dbg x y
776+
| Untagged _, Lt Signed -> C.lt ~dbg x y
777+
| Untagged _, Le Signed -> C.le ~dbg x y
778+
| Untagged _, Gt Signed -> C.gt ~dbg x y
779+
| Untagged _, Ge Signed -> C.ge ~dbg x y
780+
| Untagged _, Lt Unsigned -> C.ult ~dbg x y
781+
| Untagged _, Le Unsigned -> C.ule ~dbg x y
782+
| Untagged _, Gt Unsigned -> C.ugt ~dbg x y
783+
| Untagged _, Ge Unsigned -> C.uge ~dbg x y
784784
| (Tagged _ | Untagged _), Eq -> C.eq ~dbg x y
785785
| (Tagged _ | Untagged _), Neq -> C.neq ~dbg x y
786786

0 commit comments

Comments
 (0)