Stdlib: add Option module.

Changes

@@ -26,6 +26,9 @@ Working version
 
 ### Standard library:
 
+- GPR#1940: Add Option module and Format.pp_print_option
+  (Many fine eyes)
+
 - GPR#1956: Add Result module and Format.pp_print_result
   (Many fine eyes)
 

manual/manual/library/Makefile

@@ -24,7 +24,7 @@ STDLIB_INTF = Arg.tex Array.tex ArrayLabels.tex Char.tex Complex.tex \
   Digest.tex Filename.tex Format.tex \
   Gc.tex Genlex.tex Hashtbl.tex Int32.tex Int64.tex \
   Lazy.tex Lexing.tex List.tex ListLabels.tex Map.tex Marshal.tex \
-  MoreLabels.tex Nativeint.tex Obj.tex Oo.tex \
+  MoreLabels.tex Nativeint.tex Obj.tex Oo.tex Option.tex \
   Parsing.tex Printexc.tex Printf.tex Queue.tex Random.tex Result.tex \
   Scanf.tex Set.tex Stack.tex Stream.tex String.tex StringLabels.tex Sys.tex \
   Weak.tex Callback.tex Buffer.tex StdLabels.tex \

manual/manual/library/stdlib.etex

@@ -42,6 +42,7 @@ Here is a short listing, by theme, of the standard library modules.
 the above 4 modules \\
 "Char" & p.~\pageref{Char} & character operations \\
 "Uchar" & p.~\pageref{Uchar} & Unicode characters \\
+"Option" & p.~\pageref{Option} & option values \\
 "Result" & p.~\pageref{Result} & result values \\
 "Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
 "Random" & p.~\pageref{Random} & pseudo-random number generator \\
@@ -129,6 +130,7 @@ be called from C \\
 \item \ahref{libref/MoreLabels.html}{Module \texttt{MoreLabels}: Include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
 \item \ahref{libref/Nativeint.html}{Module \texttt{Nativeint}: processor-native integers}
 \item \ahref{libref/Oo.html}{Module \texttt{Oo}: object-oriented extension}
+\item \ahref{libref/Option.html}{Module \texttt{Option}: option values}
 \item \ahref{libref/Parsing.html}{Module \texttt{Parsing}: the run-time library for parsers generated by \texttt{ocamlyacc}}
 \item \ahref{libref/Printexc.html}{Module \texttt{Printexc}: facilities for printing exceptions}
 \item \ahref{libref/Printf.html}{Module \texttt{Printf}: formatting printing functions}
@@ -178,6 +180,7 @@ be called from C \\
 \input{MoreLabels.tex}
 \input{Nativeint.tex}
 \input{Oo.tex}
+\input{Option.tex}
 \input{Parsing.tex}
 \input{Printexc.tex}
 \input{Printf.tex}

otherlibs/threads/Makefile

@@ -39,7 +39,7 @@ LIB=../../stdlib
 P=stdlib__
 
 LIB_OBJS=$(LIB)/camlinternalFormatBasics.cmo stdlib.cmo \
-  $(LIB)/$(P)seq.cmo $(LIB)/$(P)result.cmo \
+  $(LIB)/$(P)seq.cmo $(LIB)/$(P)option.cmo $(LIB)/$(P)result.cmo \
   $(LIB)/$(P)array.cmo $(LIB)/$(P)list.cmo \
   $(LIB)/$(P)char.cmo $(LIB)/$(P)bytes.cmo $(LIB)/$(P)string.cmo \
   $(LIB)/$(P)sys.cmo marshal.cmo \

otherlibs/threads/stdlib.ml

@@ -675,6 +675,7 @@ module MoreLabels   = MoreLabels
 module Nativeint    = Nativeint
 module Obj          = Obj
 module Oo           = Oo
+module Option       = Option
 module Parsing      = Parsing
 module Printexc     = Printexc
 module Printf       = Printf

stdlib/.depend

@@ -123,6 +123,9 @@ stdlib__obj.cmi : stdlib__int32.cmi
 stdlib__oo.cmo : camlinternalOO.cmi stdlib__oo.cmi
 stdlib__oo.cmx : camlinternalOO.cmx stdlib__oo.cmi
 stdlib__oo.cmi : camlinternalOO.cmi
+stdlib__option.cmo : stdlib__seq.cmi stdlib__option.cmi
+stdlib__option.cmx : stdlib__seq.cmx stdlib__option.cmi
+stdlib__option.cmi : stdlib__seq.cmi
 stdlib__parsing.cmo : stdlib__obj.cmi stdlib__lexing.cmi stdlib__array.cmi stdlib__parsing.cmi
 stdlib__parsing.cmx : stdlib__obj.cmx stdlib__lexing.cmx stdlib__array.cmx stdlib__parsing.cmi
 stdlib__parsing.cmi : stdlib__obj.cmi stdlib__lexing.cmi
@@ -281,6 +284,8 @@ stdlib__obj.cmo : stdlib__marshal.cmi stdlib__int32.cmi stdlib__obj.cmi
 stdlib__obj.p.cmx : stdlib__marshal.cmx stdlib__int32.cmx stdlib__obj.cmi
 stdlib__oo.cmo : camlinternalOO.cmi stdlib__oo.cmi
 stdlib__oo.p.cmx : camlinternalOO.cmx stdlib__oo.cmi
+stdlib__option.cmo : stdlib__seq.cmi stdlib__option.cmi
+stdlib__option.p.cmx : stdlib__seq.cmx stdlib__option.cmi
 stdlib__parsing.cmo : stdlib__obj.cmi stdlib__lexing.cmi stdlib__array.cmi stdlib__parsing.cmi
 stdlib__parsing.p.cmx : stdlib__obj.cmx stdlib__lexing.cmx stdlib__array.cmx stdlib__parsing.cmi
 stdlib__printexc.cmo : stdlib__printf.cmi stdlib__obj.cmi stdlib__buffer.cmi stdlib__array.cmi stdlib__printexc.cmi

stdlib/Makefile

@@ -38,7 +38,7 @@ CAMLDEP=$(CAMLRUN) ../tools/ocamldep
 P=stdlib__
 
 OBJS=camlinternalFormatBasics.cmo stdlib.cmo $(OTHERS)
-OTHERS=$(P)seq.cmo $(P)result.cmo \
+OTHERS= $(P)seq.cmo $(P)option.cmo $(P)result.cmo \
   $(P)char.cmo $(P)uchar.cmo $(P)sys.cmo $(P)list.cmo \
   $(P)bytes.cmo $(P)string.cmo \
   $(P)marshal.cmo $(P)obj.cmo $(P)float.cmo $(P)array.cmo \

stdlib/StdlibModules

@@ -57,6 +57,7 @@ STDLIB_MODULES=\
   $(P)nativeint \
   $(P)obj \
   $(P)oo \
+  $(P)option \
   $(P)parsing \
   $(P)printexc \
   $(P)printf \

stdlib/option.ml

@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'a t = 'a option = None | Some of 'a
+
+let none = None
+let some v = Some v
+let value o ~default = match o with Some v -> v | None -> default
+let get = function Some v -> v | None -> invalid_arg "option is None"
+let bind o f = match o with None -> None | Some v -> f v
+let join = function Some (Some _ as o) -> o | _ -> None
+let map f o = match o with None -> None | Some v -> Some (f v)
+let fold ~none ~some = function Some v -> some v | None -> none
+let iter f = function Some v -> f v | None -> ()
+let is_none = function None -> true | Some _ -> false
+let is_some = function None -> false | Some _ -> true
+
+let equal eq o0 o1 = match o0, o1 with
+| Some v0, Some v1 -> eq v0 v1
+| None, None -> true
+| _ -> false
+
+let compare cmp o0 o1 = match o0, o1 with
+| Some v0, Some v1 -> cmp v0 v1
+| None, None -> 0
+| None, Some _ -> -1
+| Some _, None -> 1
+
+let to_result ~none = function None -> Error none | Some v -> Ok v
+let to_list = function None -> [] | Some v -> [v]
+let to_seq = function None -> Seq.empty | Some v -> Seq.return v

stdlib/option.mli

@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                         The OCaml programmers                          *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Option values.
+
+    Option values explicitely indicate the presence or absence of a value.
+
+    @since 4.08 *)
+
+(** {1:options Options} *)
+
+type 'a t = 'a option = None | Some of 'a
+(** The type for option values. Either [None] or a value [Some v]. *)
+
+val none : 'a option
+(** [none] is [None]. *)
+
+val some : 'a -> 'a option
+(** [some v] is [Some v]. *)
+
+val value : 'a option -> default:'a -> 'a
+(** [value o ~default] is [v] if [o] is [Some v] and [default] otherwise. *)
+
+val get : 'a option -> 'a
+(** [get o] is [v] if [o] is [Some v] and @raise Invalid_argument otherwise. *)
+
+val bind : 'a option -> ('a -> 'b option) -> 'b option
+(** [bind o f] is [Some (f v)] if [o] is [Some v] and [None] if [o] is
+    [None]. *)
+
+val join : 'a option option -> 'a option
+(** [join oo] is [Some v] if [oo] is [Some (Some v)] and [None] otherwise. *)
+
+val map : ('a -> 'b) -> 'a option -> 'b option
+(** [map f o] is [None] if [o] is [None] and [Some (f v)] is [o] is [Some v]. *)
+
+val fold : none:'a -> some:('b -> 'a) -> 'b option -> 'a
+(** [fold ~none ~some o] is [none] if [o] is [None] and [some v] if [o] is
+    [Some v]. *)
+
+val iter : ('a -> unit) -> 'a option -> unit
+(** [iter f o] is [f v] if [o] is [Some v] and [()] otherwise. *)
+
+(** {1:preds Predicates and comparisons} *)
+
+val is_none : 'a option -> bool
+(** [is_none o] is [true] iff [o] is [None]. *)
+
+val is_some : 'a option -> bool
+(** [is_some o] is [true] iff [o] is [Some o]. *)
+
+val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool
+(** [equal eq o0 o1] is [true] iff [o0] and [o1] are both [None] or if
+    they are [Some v0] and [Some v1] and [eq v0 v1] is [true]. *)
+
+val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int
+(** [compare cmp o0 o1] is a total order on options using [cmp] to compare
+    values wrapped by [Some _]. [None] is smaller than [Some _] values. *)
+
+(** {1:convert Converting} *)
+
+val to_result : none:'e -> 'a option -> ('a, 'e) result
+(** [to_result ~none o] is [Ok v] if [o] is [Some v] and [Error none]
+    otherwise. *)
+
+val to_list : 'a option -> 'a list
+(** [to_list o] is [[]] if [o] is [None] and [[v]] if [o] is [Some v]. *)
+
+val to_seq : 'a option -> 'a Seq.t
+(** [to_seq o] is [o] as a sequence. [None] is the empty sequence and
+    [Some v] is the singleton sequence containing [v]. *)

stdlib/stdlib.ml

@@ -587,6 +587,7 @@ module MoreLabels   = MoreLabels
 module Nativeint    = Nativeint
 module Obj          = Obj
 module Oo           = Oo
+module Option       = Option
 module Parsing      = Parsing
 module Printexc     = Printexc
 module Printf       = Printf

stdlib/stdlib.mli

@@ -1266,6 +1266,7 @@ module MoreLabels   = MoreLabels
 module Nativeint    = Nativeint
 module Obj          = Obj
 module Oo           = Oo
+module Option       = Option
 module Parsing      = Parsing
 module Printexc     = Printexc
 module Printf       = Printf

testsuite/tests/lib-option/ocamltests

@@ -0,0 +1 @@
+test.ml

testsuite/tests/lib-option/test.ml

@@ -0,0 +1,117 @@
+(* TEST
+*)
+
+let strf = Printf.sprintf
+let assert_raise_invalid_argument f v =
+  assert (try ignore (f v); false with Invalid_argument _ -> true);
+  ()
+
+let test_none_some () =
+  assert (Option.none = None);
+  assert (Option.some 2 = Some 2);
+  ()
+
+let test_value () =
+  assert (Option.value None ~default:5 = 5);
+  assert (Option.value (Some 3) ~default:5 = 3);
+  ()
+
+let test_get () =
+  assert_raise_invalid_argument Option.get None;
+  assert (Option.get (Some 2) = 2);
+  ()
+
+let test_bind () =
+  assert (Option.bind (Some 3) (fun x -> Some (succ x)) = Some 4);
+  assert (Option.bind (Some 3) (fun _ -> None) = None);
+  assert (Option.bind None (fun x -> Some (succ x)) = None);
+  assert (Option.bind None (fun _ -> None) = None);
+  ()
+
+let test_join () =
+  assert (Option.join (Some (Some 3)) = Some 3);
+  assert (Option.join (Some None) = None);
+  assert (Option.join None = None);
+  ()
+
+let test_map () =
+  assert (Option.map succ (Some 3) = Some 4);
+  assert (Option.map succ None = None);
+  ()
+
+let test_fold () =
+  assert (Option.fold ~none:3 ~some:succ (Some 1) = 2);
+  assert (Option.fold ~none:3 ~some:succ None = 3);
+  assert (Option.(fold ~none ~some) (Some 1) = (Some 1));
+  assert (Option.(fold ~none ~some) None = None);
+  ()
+
+let test_iter () =
+  let count = ref 0 in
+  let set_count x = count := x in
+  assert (!count = 0);
+  Option.iter set_count (Some 2); assert (!count = 2);
+  Option.iter set_count None; assert (!count = 2);
+  ()
+
+let test_is_none_some () =
+  assert (Option.is_none None = true);
+  assert (Option.is_some None = false);
+  assert (Option.is_none (Some 2) = false);
+  assert (Option.is_some (Some 2) = true);
+  ()
+
+let test_equal () =
+  let eq v0 v1 = (v0 mod 2) = (v1 mod 2) in
+  let equal = Option.equal eq in
+  assert (not @@ equal (Some 2) (Some 3));
+  assert (       equal (Some 2) (Some 4));
+  assert (not @@ equal (Some 2) None);
+  assert (not @@ equal None (Some 3));
+  assert (not @@ equal None (Some 4));
+  assert (       equal None None);
+  ()
+
+let test_compare () =
+  let compare v0 v1 = - (compare v0 v1) in
+  let compare = Option.compare compare in
+  assert (compare (Some 2) (Some 1) = -1);
+  assert (compare (Some 2) (Some 2) = 0);
+  assert (compare (Some 2) (Some 3) = 1);
+  assert (compare (Some 2) None = 1);
+  assert (compare None (Some 1) = -1);
+  assert (compare None (Some 2) = -1);
+  assert (compare None (Some 3) = -1);
+  assert (compare None None = 0);
+  ()
+
+let test_to_option_list_seq () =
+  assert (Option.to_result ~none:6 (Some 3) = Ok 3);
+  assert (Option.to_result ~none:6 None = Error 6);
+  assert (Option.to_list (Some 3) = [3]);
+  assert (Option.to_list None = []);
+  begin match (Option.to_seq (Some 3)) () with
+  | Seq.Cons (3, f) -> assert (f () = Seq.Nil)
+  | _ -> assert false
+  end;
+  assert ((Option.to_seq None) () = Seq.Nil);
+  ()
+
+let tests () =
+  test_none_some ();
+  test_value ();
+  test_get ();
+  test_bind ();
+  test_join ();
+  test_map ();
+  test_fold ();
+  test_iter ();
+  test_is_none_some ();
+  test_equal ();
+  test_compare ();
+  test_to_option_list_seq ();
+  ()
+
+let () =
+  tests ();
+  print_endline "OK"

testsuite/tests/lib-option/test.reference

@@ -0,0 +1 @@
+OK