diff --git a/Changes b/Changes index 6900b5fc6..65cb49f50 100644 --- a/Changes +++ b/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) diff --git a/manual/manual/library/Makefile b/manual/manual/library/Makefile index df9985b2b..9e5584734 100644 --- a/manual/manual/library/Makefile +++ b/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 \ diff --git a/manual/manual/library/stdlib.etex b/manual/manual/library/stdlib.etex index fb7719e82..6602165ed 100644 --- a/manual/manual/library/stdlib.etex +++ b/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} diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index 67dd078e2..9421cb9db 100644 --- a/otherlibs/threads/Makefile +++ b/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 \ diff --git a/otherlibs/threads/stdlib.ml b/otherlibs/threads/stdlib.ml index 8a458e82d..265263066 100644 --- a/otherlibs/threads/stdlib.ml +++ b/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 diff --git a/stdlib/.depend b/stdlib/.depend index 45311db0f..f47e300c4 100644 --- a/stdlib/.depend +++ b/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 diff --git a/stdlib/Makefile b/stdlib/Makefile index 0d379c3c1..7c6305287 100644 --- a/stdlib/Makefile +++ b/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 \ diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules index cb815df53..ab8df2951 100644 --- a/stdlib/StdlibModules +++ b/stdlib/StdlibModules @@ -57,6 +57,7 @@ STDLIB_MODULES=\ $(P)nativeint \ $(P)obj \ $(P)oo \ + $(P)option \ $(P)parsing \ $(P)printexc \ $(P)printf \ diff --git a/stdlib/option.ml b/stdlib/option.ml new file mode 100644 index 000000000..97fa0b4e1 --- /dev/null +++ b/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 diff --git a/stdlib/option.mli b/stdlib/option.mli new file mode 100644 index 000000000..d188612e3 --- /dev/null +++ b/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]. *) diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml index 43a842b06..30b54b10a 100644 --- a/stdlib/stdlib.ml +++ b/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 diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli index 3c0e96b28..69aa7ae92 100644 --- a/stdlib/stdlib.mli +++ b/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 diff --git a/testsuite/tests/lib-option/ocamltests b/testsuite/tests/lib-option/ocamltests new file mode 100644 index 000000000..31c13b443 --- /dev/null +++ b/testsuite/tests/lib-option/ocamltests @@ -0,0 +1 @@ +test.ml diff --git a/testsuite/tests/lib-option/test.ml b/testsuite/tests/lib-option/test.ml new file mode 100644 index 000000000..316e3eae9 --- /dev/null +++ b/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" diff --git a/testsuite/tests/lib-option/test.reference b/testsuite/tests/lib-option/test.reference new file mode 100644 index 000000000..d86bac9de --- /dev/null +++ b/testsuite/tests/lib-option/test.reference @@ -0,0 +1 @@ +OK