From fc28ab09654b1e1b0df366b7c16d63bff4d59d70 Mon Sep 17 00:00:00 2001
From: Virgile Prevosto <virgile.prevosto@m4x.org>
Date: Thu, 13 Sep 2018 10:16:16 +0200
Subject: [PATCH] [stdlib] Transitioning support for 4.05 List functions
---
Makefile.generating | 17 +++++++++++++++
configure.in | 27 ++++++++++++++----------
share/Makefile.config.in | 1 +
src/libraries/stdlib/transitioning.ml.in | 22 +++++++++++++++++++
src/libraries/stdlib/transitioning.mli | 7 ++++++
5 files changed, 63 insertions(+), 11 deletions(-)
diff --git a/Makefile.generating b/Makefile.generating
index e8248203739..7265432b405 100644
--- a/Makefile.generating
+++ b/Makefile.generating
@@ -134,13 +134,30 @@ else
SPLIT_ON_CHAR=split_on_char
endif
+ifeq ($(HAS_OCAML405),yes)
+ NTH_OPT=List.nth_opt
+ FIND_OPT=List.find_opt
+ ASSOC_OPT=List.assoc_opt
+ ASSQ_OPT=List.assq_opt
+else
+ NTH_OPT=nth_opt
+ FIND_OPT=find_opt
+ ASSOC_OPT=assoc_opt
+ ASSQ_OPT=assq_opt
+endif
+
src/libraries/stdlib/transitioning.ml: \
src/libraries/stdlib/transitioning.ml.in \
Makefile.generating share/Makefile.config
+ $(PRINT_MAKING) $@
rm -f $@
sed \
-e 's/@SPLIT_ON_CHAR@/$(SPLIT_ON_CHAR)/g' \
-e 's/@STACK_FOLD@/$(STACK_FOLD)/g' \
+ -e 's/@NTH_OPT@/$(NTH_OPT)/g' \
+ -e 's/@FIND_OPT@/$(FIND_OPT)/g' \
+ -e 's/@ASSOC_OPT@/$(ASSOC_OPT)/g' \
+ -e 's/@ASSQ_OPT@/$(ASSQ_OPT)/g' \
$< > $@
$(CHMOD_RO) $@
diff --git a/configure.in b/configure.in
index 2a21c43cd5f..7c191bf2fbd 100644
--- a/configure.in
+++ b/configure.in
@@ -119,6 +119,7 @@ AC_SUBST(OCAMLPATCHNB)
AC_SUBST(HAS_OCAML403)
AC_SUBST(HAS_OCAML404)
+AC_SUBST(HAS_OCAML405)
AC_SUBST(HAS_OCAML407)
OCAMLMAJORNB=$(echo $OCAMLVERSION | cut -f 1 -d .)
@@ -127,22 +128,26 @@ OCAMLPATCHNB=$(echo $OCAMLVERSION | cut -f 3 -d .)
if test $OCAMLMAJORNB -gt 4; then
HAS_OCAML403=yes;
+ HAS_OCAML404=yes;
+ HAS_OCAML405=yes;
HAS_OCAML407=yes;
-else if test $OCAMLMINORNB -lt 3; then
+else
HAS_OCAML403=no;
+ HAS_OCAML404=no;
+ HAS_OCAML405=no;
HAS_OCAML407=no;
-else
- HAS_OCAML403=yes;
- if test $OCAMLMINORNB -lt 4; then
- HAS_OCAML404=no;
- HAS_OCAML407=no;
- else if test $OCAMLMINORNB -lt 7; then
- HAS_OCAML407=no;
- else
+ if test $OCAMLMINORNB -ge 3; then
+ HAS_OCAML403=yes;
+ fi;
+ if test $OCAMLMINORNB -ge 4; then
+ HAS_OCAML404=yes;
+ fi;
+ if test $OCAMLMINORNB -ge 5; then
+ HAS_OCAML405=yes;
+ fi;
+ if test $OCAMLMINORNB -ge 7; then
HAS_OCAML407=yes;
fi;
- fi; # 404
-fi; # 403
fi; # MAJORNB -gt 4
# Ocaml library path
diff --git a/share/Makefile.config.in b/share/Makefile.config.in
index 13ec84dc7c8..e401b7b6f42 100644
--- a/share/Makefile.config.in
+++ b/share/Makefile.config.in
@@ -85,6 +85,7 @@ OCAMLPATCHNB ?=@OCAMLPATCHNB@
HAS_OCAML403 ?=@HAS_OCAML403@
HAS_OCAML404 ?=@HAS_OCAML404@
+HAS_OCAML405 ?=@HAS_OCAML405@
HAS_OCAML407 ?=@HAS_OCAML407@
NATIVE_THREADS ?=@HAS_NATIVE_THREADS@
diff --git a/src/libraries/stdlib/transitioning.ml.in b/src/libraries/stdlib/transitioning.ml.in
index 147ffcf58cc..635167b68b2 100644
--- a/src/libraries/stdlib/transitioning.ml.in
+++ b/src/libraries/stdlib/transitioning.ml.in
@@ -37,10 +37,25 @@ let stack_fold f x s =
Stack.iter do_it s;
!res
+let nth_opt l n =
+ try Some (List.nth l n)
+ with Failure _ when n >= 0 -> None
+(* OCaml manual states that a negative argument still raises a Failure. *)
+
+let find_opt f l = try Some (List.find f l) with Not_found -> None
+
+let assoc_opt x l = try Some (List.assoc x l) with Not_found -> None
+
+let assq_opt x l = try Some (List.assq x l) with Not_found -> None
+
(* the implementations above are only used in case we compile against an
old OCaml version. Avoid unused warning in other cases. *)
let _: char -> string -> string list = split_on_char
let _: ('a -> 'b -> 'a) -> 'a -> 'b Stack.t -> 'a = stack_fold
+let _: 'a list -> int -> 'a option = nth_opt
+let _: ('a -> bool) -> 'a list -> 'a option = find_opt
+let _: 'a -> ('a * 'b) list -> 'b option = assoc_opt
+let _: 'a -> ('a * 'b) list -> 'b option = assq_opt
[@@@ warning "-3"]
@@ -61,6 +76,13 @@ module Stack = struct
let fold = @STACK_FOLD@
end
+module List = struct
+ let nth_opt = @NTH_OPT@
+ let find_opt = @FIND_OPT@
+ let assoc_opt = @ASSOC_OPT@
+ let assq_opt = @ASSQ_OPT@
+end
+
module Q = struct
let round_to_float x exact =
diff --git a/src/libraries/stdlib/transitioning.mli b/src/libraries/stdlib/transitioning.mli
index b2817c9bb4c..2038c085a07 100644
--- a/src/libraries/stdlib/transitioning.mli
+++ b/src/libraries/stdlib/transitioning.mli
@@ -58,6 +58,13 @@ module Stack: sig
val fold: ('a -> 'b -> 'a) -> 'a -> 'b Stack.t -> 'a (** 4.03 *)
end
+module List: sig
+ val nth_opt: 'a list -> int -> 'a option (** 4.05 *)
+ val find_opt: ('a -> bool) -> 'a list -> 'a option (** 4.05 *)
+ val assoc_opt: 'a -> ('a * 'b) list -> 'b option (** 4.05 *)
+ val assq_opt: 'a -> ('a * 'b) list -> 'b option (** 4.05 *)
+end
+
(** {1 Zarith} *)
(** Function [Q.to_float] was introduced in Zarith 1.5 *)
--
GitLab