Skip to content

Commit

Permalink
Float_u stdlib module (#1572)
Browse files Browse the repository at this point in the history
  • Loading branch information
ccasin authored Jul 26, 2023
1 parent 41fc1e9 commit dbe2f17
Show file tree
Hide file tree
Showing 17 changed files with 872 additions and 116 deletions.
9 changes: 8 additions & 1 deletion ocaml/Makefile.common-jst
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,8 @@ dune_config_targets = \
duneconf/main.ws \
$(ocamldir)/duneconf/dirs-to-ignore.inc \
$(ocamldir)/duneconf/jst-extra.inc \
dune-project
dune-project \
$(ocamldir)/stdlib/ocaml_compiler_internal_params

_build/_bootinstall: Makefile.config $(dune_config_targets)
echo -n '$(NATDYNLINKOPTS)' > $(ocamldir)/otherlibs/dynlink/natdynlinkops
Expand Down Expand Up @@ -172,6 +173,12 @@ _install: compiler
install: _install
mkdir -p '$(prefix)'
rsync --chmod=u+rw,go+r -rl _install/ '$(prefix)'
rm '$(prefix)/lib/ocaml/ocaml_compiler_internal_params'
# rm `ocaml_compiler_internal_params`, which is used to compile the
# stdlib `Float_u` module with `-extension layouts_alpha`, because we
# don't want user programs that happened to be named
# `ocaml/stdlib/float_u.ml` to get the flag automatically.


# Same as above, but relies on a successfull earlier _install
install_for_opam:
Expand Down
2 changes: 1 addition & 1 deletion ocaml/driver/compenv.ml
Original file line number Diff line number Diff line change
Expand Up @@ -534,7 +534,7 @@ type file_option = {
}

let scan_line ic =
Scanf.bscanf ic "%[0-9a-zA-Z_.*] : %[a-zA-Z_-] = %s "
Scanf.bscanf ic "%[0-9a-zA-Z/_.*] : %[a-zA-Z_-] = %s "
(fun pattern name value ->
let pattern =
match pattern with
Expand Down
2 changes: 2 additions & 0 deletions ocaml/ocamldoc/odoc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@

module M = Odoc_messages

let () = Language_extension.enable_maximal ()

(* we check if we must load a module given on the command line *)
let arg_list = Array.to_list Sys.argv
let (plugins, paths) =
Expand Down
10 changes: 10 additions & 0 deletions ocaml/stdlib/.depend
Original file line number Diff line number Diff line change
Expand Up @@ -325,6 +325,16 @@ stdlib__Float.cmx : float.ml \
stdlib__Float.cmi : float.mli \
stdlib.cmi \
stdlib__Seq.cmi
stdlib__Float_u.cmo : float_u.ml \
stdlib.cmi \
stdlib__Float.cmi \
stdlib__Float_u.cmi
stdlib__Float_u.cmx : float_u.ml \
stdlib.cmx \
stdlib__Float.cmx \
stdlib__Float_u.cmi
stdlib__Float_u.cmi : float_u.mli \
stdlib.cmi
stdlib__Format.cmo : format.ml \
stdlib__String.cmi \
stdlib.cmi \
Expand Down
23 changes: 23 additions & 0 deletions ocaml/stdlib/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -220,6 +220,29 @@ stdlib.cmx: stdlib.ml
-pp "$(AWK) -f ./expand_module_aliases.awk" -c $<


# special cases to add the extension flag when compiling float_u
# CR layouts: eventually these can be just [-extension layouts]
stdlib__Float_u.cmi:
$(CAMLC) $(COMPFLAGS) -extension layouts_alpha \
-o $@ -c $(filter %.mli, $^)

stdlib__Float_u.cmo:
$(CAMLC) $(COMPFLAGS) -extension layouts_alpha \
-o $@ -c $(filter %.ml, $^)

stdlib__Float_u.cmx:
$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -extension layouts_alpha \
-o $@ -c $(filter %.ml, $^)

float_u.cmi: %.mli
$(CAMLC) $(COMPFLAGS) -extension layouts_alpha -c $<

float_u.cmo: %.ml
$(CAMLC) $(COMPFLAGS) -extension layouts_alpha -c $<

float_u.cmx: %.ml
$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -extension layouts_alpha -c $<

%.cmi: %.mli
$(CAMLC) $(COMPFLAGS) -c $<

Expand Down
2 changes: 1 addition & 1 deletion ocaml/stdlib/StdlibModules
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ STDLIB_MODULE_BASENAMES = \
stdlib pervasives either \
sys obj camlinternalLazy lazy \
seq option result bool char uchar \
list int bytes string unit marshal array iarray float int32 int64 nativeint \
list int bytes string unit marshal array iarray float float_u int32 int64 nativeint \
lexing parsing set map stack queue stream buffer \
camlinternalFormat printf arg atomic \
printexc fun gc digest random hashtbl weak \
Expand Down
7 changes: 7 additions & 0 deletions ocaml/stdlib/dune
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@
(install
(files
Makefile.config
ocaml_compiler_internal_params

camlheader
camlheaderd
Expand Down Expand Up @@ -104,6 +105,8 @@
filename.mli
float.ml
float.mli
float_u.ml
float_u.mli
format.ml
format.mli
fun.ml
Expand Down Expand Up @@ -240,6 +243,9 @@
.stdlib.objs/byte/stdlib__Float.cmi
.stdlib.objs/byte/stdlib__Float.cmt
.stdlib.objs/byte/stdlib__Float.cmti
.stdlib.objs/byte/stdlib__Float_u.cmi
.stdlib.objs/byte/stdlib__Float_u.cmt
.stdlib.objs/byte/stdlib__Float_u.cmti
.stdlib.objs/byte/stdlib__Format.cmi
.stdlib.objs/byte/stdlib__Format.cmt
.stdlib.objs/byte/stdlib__Format.cmti
Expand Down Expand Up @@ -413,6 +419,7 @@
.stdlib.objs/native/stdlib__StdLabels.cmx
.stdlib.objs/native/stdlib__Weak.cmx
.stdlib.objs/native/stdlib__Float.cmx
.stdlib.objs/native/stdlib__Float_u.cmx
.stdlib.objs/native/stdlib__Pervasives.cmx
.stdlib.objs/native/stdlib__Fun.cmx
.stdlib.objs/native/stdlib__Bigarray.cmx
Expand Down
156 changes: 156 additions & 0 deletions ocaml/stdlib/float_u.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,156 @@
# 1 "float_u.ml"
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Nicolas Ojeda Bar, LexiFi *)
(* *)
(* Copyright 2018 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)

open! Stdlib

[@@@ocaml.flambda_o3]


external to_float : float# -> (float[@local_opt]) = "%box_float"

external of_float : (float[@local_opt]) -> float# = "%unbox_float"

(* CR layouts: Investigate whether it's worth making these things externals.
Are there situations where the middle-end won't inline them and remove the
boxing/unboxing? *)

let[@inline always] neg x = of_float (Float.neg (to_float x))

let[@inline always] add x y = of_float (Float.add (to_float x) (to_float y))

let[@inline always] sub x y = of_float (Float.sub (to_float x) (to_float y))

let[@inline always] mul x y = of_float (Float.mul (to_float x) (to_float y))

let[@inline always] div x y = of_float (Float.div (to_float x) (to_float y))

let[@inline always] fma x y z = of_float (Float.fma (to_float x) (to_float y) (to_float z))

let[@inline always] rem x y = of_float (Float.rem (to_float x) (to_float y))

let[@inline always] succ x = of_float (Float.succ (to_float x))

let[@inline always] pred x = of_float (Float.pred (to_float x))

let[@inline always] abs x = of_float (Float.abs (to_float x))

let[@inline always] is_finite x = Float.is_finite (to_float x)

let[@inline always] is_infinite x = Float.is_infinite (to_float x)

let[@inline always] is_nan x = Float.is_nan (to_float x)

let[@inline always] is_integer x = Float.is_integer (to_float x)

let[@inline always] of_int x = of_float (Float.of_int x)

let[@inline always] to_int x = Float.to_int (to_float x)

let[@inline always] of_string x = of_float (Float.of_string x)

let[@inline always] to_string x = Float.to_string (to_float x)

type fpclass = Stdlib.fpclass =
FP_normal
| FP_subnormal
| FP_zero
| FP_infinite
| FP_nan

let[@inline always] classify_float x = Float.classify_float (to_float x)

let[@inline always] pow x y = of_float (Float.pow (to_float x) (to_float y))

let[@inline always] sqrt x = of_float (Float.sqrt (to_float x))

let[@inline always] cbrt x = of_float (Float.cbrt (to_float x))

let[@inline always] exp x = of_float (Float.exp (to_float x))

let[@inline always] exp2 x = of_float (Float.exp2 (to_float x))

let[@inline always] log x = of_float (Float.log (to_float x))

let[@inline always] log10 x = of_float (Float.log10 (to_float x))

let[@inline always] log2 x = of_float (Float.log2 (to_float x))

let[@inline always] expm1 x = of_float (Float.expm1 (to_float x))

let[@inline always] log1p x = of_float (Float.log1p (to_float x))

let[@inline always] cos x = of_float (Float.cos (to_float x))

let[@inline always] sin x = of_float (Float.sin (to_float x))

let[@inline always] tan x = of_float (Float.tan (to_float x))

let[@inline always] acos x = of_float (Float.acos (to_float x))

let[@inline always] asin x = of_float (Float.asin (to_float x))

let[@inline always] atan x = of_float (Float.atan (to_float x))

let[@inline always] atan2 x y = of_float (Float.atan2 (to_float x) (to_float y))

let[@inline always] hypot x y = of_float (Float.hypot (to_float x) (to_float y))

let[@inline always] cosh x = of_float (Float.cosh (to_float x))

let[@inline always] sinh x = of_float (Float.sinh (to_float x))

let[@inline always] tanh x = of_float (Float.tanh (to_float x))

let[@inline always] acosh x = of_float (Float.acosh (to_float x))

let[@inline always] asinh x = of_float (Float.asinh (to_float x))

let[@inline always] atanh x = of_float (Float.atanh (to_float x))

let[@inline always] erf x = of_float (Float.erf (to_float x))

let[@inline always] erfc x = of_float (Float.erfc (to_float x))

let[@inline always] trunc x = of_float (Float.trunc (to_float x))

let[@inline always] round x = of_float (Float.round (to_float x))

let[@inline always] ceil x = of_float (Float.ceil (to_float x))

let[@inline always] floor x = of_float (Float.floor (to_float x))

let[@inline always] next_after x y = of_float (Float.next_after (to_float x) (to_float y))

let[@inline always] copy_sign x y = of_float (Float.copy_sign (to_float x) (to_float y))

let[@inline always] sign_bit x = Float.sign_bit (to_float x)

let[@inline always] ldexp x i = of_float (Float.ldexp (to_float x) i)

type t = float#

let[@inline always] compare x y = Float.compare (to_float x) (to_float y)

let[@inline always] equal x y = Float.equal (to_float x) (to_float y)

let[@inline always] min x y = of_float (Float.min (to_float x) (to_float y))

let[@inline always] max x y = of_float (Float.max (to_float x) (to_float y))

let[@inline always] min_num x y = of_float (Float.min_num (to_float x) (to_float y))

let[@inline always] max_num x y = of_float (Float.max_num (to_float x) (to_float y))
Loading

0 comments on commit dbe2f17

Please sign in to comment.