aaronmanning/ocaml-standard-library
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

terminal and fatal modules, cleaner hiding of FromStdlib functions and renamed exposed module to general

Browse Source
This commit is contained in:
Aaron Manning
2022-01-30 11:55:42 +11:00
committed by aaron-jack-manning
parent a8cdd2411f
commit e9368e17c1
36 changed files with 306 additions and 165 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
lib/bool.ml
View File

@ -1,3 +1,3 @@
open FromStdlib open Exposed
open General
let of_string = stdlib_bool_of_string_opt
let of_string = FromStdlib.bool_of_string_opt

2
lib/bool.mli
View File

@ -1,2 +1,4 @@
open General
(** Converts the string to a bool, returning option type to account for invalid strings. *)
val of_string : string -> bool option

4
lib/char.ml
View File

@ -1,3 +1,3 @@
open FromStdlib open Exposed
open General
let of_int = stdlib_char_of_int
let of_int = FromStdlib.char_of_int

2
lib/char.mli
View File

@ -1,2 +1,4 @@
open General
(** Converts an int to a char. *)
val of_int : int -> char

20
lib/exposed.ml
View File

@ -1,20 +0,0 @@
type 'a queue = { front : 'a list; back : 'a list }
type 'a result =
| Error of string
| Success of 'a
type 'a stack =
| Empty
| Stacked of 'a * 'a stack
type 'a tree =
| Leaf
| Branch of 'a * 'a tree list
let id (x : 'a) = x
let ( >> ) f g x = g (f x)
let ( << ) g f x = g (f x)

25
lib/exposed.mli
View File

@ -1,25 +0,0 @@
(** Purely functional queue, implemented as a pair of lists. *)
type 'a queue = { front : 'a list; back : 'a list }
type 'a result =
| Error of string
| Success of 'a
(** Purely functional stack. *)
type 'a stack =
| Empty
| Stacked of 'a * 'a stack
(* A purely functional tree with arbitrarily many branches at each node. *)
type 'a tree =
| Leaf
| Branch of 'a * 'a tree list
(** Identity function. *)
val id : 'a -> 'a
(** Function composition. (f >> g) x represents g (f x). *)
val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
(** Function composition. (f << g) x represents f (g x). *)
val ( << ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b

11
lib/fatal.ml Normal file
View File

@ -0,0 +1,11 @@
open General
let failwith = FromStdlib.failwith
let guarantee b =
if not b then
failwith "guarantee failed.\n"
let guarantee_equal a b =
if a <> b then
failwith "guarantee_equal failed."

10
lib/fatal.mli Normal file
View File

@ -0,0 +1,10 @@
open General
(** Throws an exception with a message. *)
val failwith : string -> 'a
(** Throws an exception if the provided bool is not true. *)
val guarantee : bool -> unit
(** Throws an exception if the provided arguments are not equal. *)
val guarantee_equal : 'a -> 'a -> unit

12
lib/float.ml
View File

@ -1,11 +1,11 @@
open FromStdlib open Exposed
open General
let ( + ) a b = stdlib_plus_float a b
let ( + ) a b = FromStdlib.plus_float a b
let ( - ) a b = stdlib_minus_float a b
let ( - ) a b = FromStdlib.minus_float a b
let ( * ) a b = stdlib_multiply_float a b
let ( * ) a b = FromStdlib.multiply_float a b
let ( / ) a b = stdlib_divide_float a b
let ( / ) a b = FromStdlib.divide_float a b
let of_string = stdlib_float_of_string_opt
let of_string = FromStdlib.float_of_string_opt

2
lib/float.mli
View File

@ -1,3 +1,5 @@
open General
val ( + ) : float -> float -> float
val ( - ) : float -> float -> float

87
lib/fromStdlib.ml
View File

@ -1,37 +1,46 @@
(* https://github.com/ocaml/ocaml/blob/cce52acc7c7903e92078e9fe40745e11a1b944f0/stdlib/pervasives.ml *)
(* For fatal.ml *)
let failwith = Stdlib.failwith
(* For terminal.ml *)
let printf = Printf.printf
external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
external ignore : 'a -> unit = "%ignore"
type 'a printf_format = ('a, out_channel, unit) format
external stdlib_int_of_char : char -> int = "%identity"
let stdlib_char_of_int = char_of_int
let stdlib_string_of_bool = string_of_bool
let stdlib_bool_of_string = bool_of_string
let stdlib_bool_of_string_opt = bool_of_string_opt
let stdlib_string_of_int = string_of_int
external stdlib_int_of_string : string -> int = "caml_int_of_string"
let stdlib_int_of_string_opt = int_of_string_opt
let stdlib_string_of_float = string_of_float
external stdlib_float_of_string : string -> float = "caml_float_of_string"
let stdlib_float_of_string_opt = float_of_string_opt
(* For int.ml *)
external int_of_char : char -> int = "%identity"
let int_of_string_opt = int_of_string_opt
external stdlib_plus_int : int -> int -> int = "%addint"
external stdlib_minus_int : int -> int -> int = "%subint"
external stdlib_multiply_int : int -> int -> int = "%mulint"
external stdlib_divide_int : int -> int -> int = "%divint"
external stdlib_mod_int : int -> int -> int = "%modint"
external plus_int : int -> int -> int = "%addint"
external minus_int : int -> int -> int = "%subint"
external multiply_int : int -> int -> int = "%mulint"
external divide_int : int -> int -> int = "%divint"
external mod_int : int -> int -> int = "%modint"
external stdlib_plus_float : float -> float -> float = "%addfloat"
external stdlib_minus_float : float -> float -> float = "%subfloat"
external stdlib_multiply_float : float -> float -> float = "%mulfloat"
external stdlib_divide_float : float -> float -> float = "%divfloat"
external stdlib_string_length : string -> int = "%string_length"
(* For float.ml *)
let float_of_string_opt = float_of_string_opt
external plus_float : float -> float -> float = "%addfloat"
external minus_float : float -> float -> float = "%subfloat"
external multiply_float : float -> float -> float = "%mulfloat"
external divide_float : float -> float -> float = "%divfloat"
(* For char.ml *)
let char_of_int = char_of_int
(* For string.ml *)
let string_of_bool = string_of_bool
let string_of_int = string_of_int
let string_of_float = string_of_float
external string_length : string -> int = "%string_length"
(* This block are not exposed *)
external bytes_create : int -> bytes = "caml_create_bytes"
external string_blit : string -> int -> bytes -> int -> int -> unit
= "caml_blit_string" [@@noalloc]
@ -39,24 +48,32 @@ external bytes_blit : bytes -> int -> bytes -> int -> int -> unit
= "caml_blit_bytes" [@@noalloc]
external bytes_unsafe_to_string : bytes -> string = "%bytes_to_string"
let stdlib_string_concat s1 s2 =
let l1 = stdlib_string_length s1 and l2 = stdlib_string_length s2 in
let string_concat s1 s2 =
let l1 = string_length s1 and l2 = string_length s2 in
let s = bytes_create (l1 + l2) in
string_blit s1 0 s 0 l1;
string_blit s2 0 s l1 l2;
bytes_unsafe_to_string s
external ( = ) : 'a -> 'a -> bool = "%equal"
external ( <> ) : 'a -> 'a -> bool = "%notequal"
external ( < ) : 'a -> 'a -> bool = "%lessthan"
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
(* For bool.ml *)
let bool_of_string_opt = bool_of_string_opt
(* For general.ml *)
external equal : 'a -> 'a -> bool = "%equal"
external not_equal : 'a -> 'a -> bool = "%notequal"
external less_than : 'a -> 'a -> bool = "%lessthan"
external greater_than : 'a -> 'a -> bool = "%greaterthan"
external less_than_or_equal : 'a -> 'a -> bool = "%lessequal"
external greater_than_or_equal : 'a -> 'a -> bool = "%greaterequal"
external not : bool -> bool = "%boolnot"
external ( or ) : bool -> bool -> bool = "%sequor"
external ( & ) : bool -> bool -> bool = "%sequand"
external or_ : bool -> bool -> bool = "%sequor"
external and_ : bool -> bool -> bool = "%sequand"
external pipeline : 'a -> ('a -> 'b) -> 'b = "%revapply"
external ignore : 'a -> unit = "%ignore"

82
lib/fromStdlib.mli
View File

@ -1,43 +1,61 @@
(* For fatal.ml *)
val failwith : string -> 'a
(* For terminal.ml *)
val printf : ('a, out_channel, unit) format -> 'a
type 'a printf_format = ('a, out_channel, unit) format
external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
external ignore : 'a -> unit = "%ignore"
external stdlib_int_of_char : char -> int = "%identity"
val stdlib_char_of_int : int -> char
val stdlib_string_of_bool : bool -> string
val stdlib_bool_of_string : string -> bool
val stdlib_bool_of_string_opt : string -> bool option
val stdlib_string_of_int : int -> string
external stdlib_int_of_string : string -> int = "caml_int_of_string"
val stdlib_int_of_string_opt : string -> int option
val stdlib_string_of_float : float -> string
external stdlib_float_of_string : string -> float = "caml_float_of_string"
val stdlib_float_of_string_opt : string -> float option
(* For int.ml *)
external int_of_char : char -> int = "%identity"
val int_of_string_opt : string -> int option
external stdlib_plus_int : int -> int -> int = "%addint"
external stdlib_minus_int : int -> int -> int = "%subint"
external stdlib_multiply_int : int -> int -> int = "%mulint"
external stdlib_divide_int : int -> int -> int = "%divint"
external stdlib_mod_int : int -> int -> int = "%modint"
external plus_int : int -> int -> int = "%addint"
external minus_int : int -> int -> int = "%subint"
external multiply_int : int -> int -> int = "%mulint"
external divide_int : int -> int -> int = "%divint"
external mod_int : int -> int -> int = "%modint"
external stdlib_plus_float : float -> float -> float = "%addfloat"
external stdlib_minus_float : float -> float -> float = "%subfloat"
external stdlib_multiply_float : float -> float -> float = "%mulfloat"
external stdlib_divide_float : float -> float -> float = "%divfloat"
external stdlib_string_length : string -> int = "%string_length"
val stdlib_string_concat : string -> string -> string
(* For float.ml *)
val float_of_string_opt : string -> float option
external ( = ) : 'a -> 'a -> bool = "%equal"
external ( <> ) : 'a -> 'a -> bool = "%notequal"
external plus_float : float -> float -> float = "%addfloat"
external minus_float : float -> float -> float = "%subfloat"
external multiply_float : float -> float -> float = "%mulfloat"
external divide_float : float -> float -> float = "%divfloat"
external ( < ) : 'a -> 'a -> bool = "%lessthan"
external ( > ) : 'a -> 'a -> bool = "%greaterthan"
external ( <= ) : 'a -> 'a -> bool = "%lessequal"
external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
(* For char.ml *)
val char_of_int : int -> char
(* For string.ml *)
val string_of_bool : bool -> string
val string_of_int : int -> string
val string_of_float : float -> string
external string_length : string -> int = "%string_length"
val string_concat : string -> string -> string
(* For bool.ml *)
val bool_of_string_opt : string -> bool option
(* For general.ml *)
external equal : 'a -> 'a -> bool = "%equal"
external not_equal : 'a -> 'a -> bool = "%notequal"
external less_than : 'a -> 'a -> bool = "%lessthan"
external greater_than : 'a -> 'a -> bool = "%greaterthan"
external less_than_or_equal : 'a -> 'a -> bool = "%lessequal"
external greater_than_or_equal : 'a -> 'a -> bool = "%greaterequal"
external not : bool -> bool = "%boolnot"
external ( or ) : bool -> bool -> bool = "%sequor"
external ( & ) : bool -> bool -> bool = "%sequand"
external or_ : bool -> bool -> bool = "%sequor"
external and_ : bool -> bool -> bool = "%sequand"
external pipeline : 'a -> ('a -> 'b) -> 'b = "%revapply"
external ignore : 'a -> unit = "%ignore"

42
lib/general.ml Normal file
View File

@ -0,0 +1,42 @@
type 'a queue = { front : 'a list; back : 'a list }
type 'a result =
| Error of string
| Success of 'a
type 'a stack =
| Empty
| Stacked of 'a * 'a stack
type 'a tree =
| Leaf
| Branch of 'a * 'a tree list
let ignore = FromStdlib.ignore
let id (x : 'a) = x
let ( >> ) f g x = g (f x)
let ( << ) g f x = g (f x)
let ( |> ) = FromStdlib.pipeline
let ( = ) = FromStdlib.equal
let ( <> ) = FromStdlib.not_equal
let ( < ) = FromStdlib.less_than
let ( > ) = FromStdlib.greater_than
let ( <= ) = FromStdlib.less_than_or_equal
let ( >= ) = FromStdlib.greater_than_or_equal
let not = FromStdlib.not
let ( or ) = FromStdlib.or_
let ( & ) = FromStdlib.and_

58
lib/general.mli Normal file
View File

@ -0,0 +1,58 @@
(** Purely functional queue, implemented as a pair of lists. *)
type 'a queue = { front : 'a list; back : 'a list }
type 'a result =
| Error of string
| Success of 'a
(** Purely functional stack. *)
type 'a stack =
| Empty
| Stacked of 'a * 'a stack
(* A purely functional tree with arbitrarily many branches at each node. *)
type 'a tree =
| Leaf
| Branch of 'a * 'a tree list
(** Identity function. *)
val id : 'a -> 'a
(** Suppresses compiler warnings for unassigned return value from function. *)
val ignore : 'a -> unit
(** Function composition. (f >> g) x represents g (f x). *)
val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
(** Function composition. (f << g) x represents f (g x). *)
val ( << ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
(** Pipeline operator, to reverse function application order. *)
val ( |> ) : 'a -> ('a -> 'b) -> 'b
(** Checks for structural equality. *)
val ( = ) : 'a -> 'a -> bool
(** Checks for structural inequality. *)
val ( <> ) : 'a -> 'a -> bool
(** Polymorphic less than. *)
val ( < ) : 'a -> 'a -> bool
(** Polymorphic greater than. *)
val ( > ) : 'a -> 'a -> bool
(** Polymorphic less than or equal to. *)
val ( <= ) : 'a -> 'a -> bool
(** Polymorphic greater than or equal to. *)
val ( >= ) : 'a -> 'a -> bool
(** Logical negation. *)
val not : bool -> bool
(** Logical or (infix). *)
val ( or ) : bool -> bool -> bool
(** Logical and. *)
val ( & ) : bool -> bool -> bool

16
lib/int.ml
View File

@ -1,16 +1,16 @@
open FromStdlib
open General
let ( + ) a b = stdlib_plus_int a b
let ( + ) a b = FromStdlib.plus_int a b
let ( - ) a b = stdlib_minus_int a b
let ( - ) a b = FromStdlib.minus_int a b
let ( * ) a b = stdlib_multiply_int a b
let ( * ) a b = FromStdlib.multiply_int a b
let ( / ) a b = stdlib_divide_int a b
let ( / ) a b = FromStdlib.divide_int a b
let ( mod ) a b = stdlib_mod_int a b
let ( mod ) a b = FromStdlib.mod_int a b
let of_char = stdlib_int_of_char
let of_char = FromStdlib.int_of_char
let of_string = stdlib_int_of_string_opt
let of_string = FromStdlib.int_of_string_opt

2
lib/int.mli
View File

@ -1,3 +1,5 @@
open General
val ( + ) : int -> int -> int
val ( - ) : int -> int -> int

7
lib/list.ml
View File

@ -1,5 +1,4 @@
open FromStdlib
open Exposed
open General
let empty : 'a list = []
@ -71,8 +70,8 @@ let rec zip2_rev_tr_helper (ls1 : 'a list) (ls2 : 'b list) (acc : ('a * 'b) list
else if (first_head = None & second_head <> None) or (first_head <> None & second_head = None) then
Error "The two lists must be of the same length."
else
let a = match first_head with | Some x -> x | None -> failwith "if this exception is raised there is an error in the implementation of the function that called it" in
let b = match second_head with | Some x -> x | None -> failwith "if this exception is raised there is an error in the implementation of the function that called it" in
let a = match first_head with | Some x -> x | None -> Fatal.failwith "if this exception is raised there is an error in the implementation of the function that called it" in
let b = match second_head with | Some x -> x | None -> Fatal.failwith "if this exception is raised there is an error in the implementation of the function that called it" in
zip2_rev_tr_helper (tail ls1) (tail ls2) ((a, b) :: acc)

2
lib/list.mli
View File

@ -1,4 +1,4 @@
open Exposed
open General
(** The empty list *)
val empty : 'a list

8
lib/makefile
View File

@ -6,10 +6,11 @@ build:
# fromStdlib manages things that need to be exposed from the standard library
ocamlopt $(STANDARD_FLAGS) -c fromStdlib.mli fromStdlib.ml
# exposed types and functions, that can be opened module wide
ocamlopt $(STANDARD_FLAGS) -nopervasives -c exposed.mli exposed.ml
# types and functions that should be opened module wide
ocamlopt $(STANDARD_FLAGS) -nopervasives -c general.mli general.ml
# the following files make up the core custom standard library code
$(STANDARD_COMPILE) fatal.mli fatal.ml
$(STANDARD_COMPILE) int.mli int.ml
$(STANDARD_COMPILE) float.mli float.ml
$(STANDARD_COMPILE) option.mli option.ml
@ -22,8 +23,9 @@ build:
$(STANDARD_COMPILE) string.mli string.ml
$(STANDARD_COMPILE) char.mli char.ml
$(STANDARD_COMPILE) bool.mli bool.ml
$(STANDARD_COMPILE) terminal.mli terminal.ml
ocamlopt -a fromStdlib.cmx exposed.cmx int.cmx float.cmx option.cmx stack.cmx list.cmx map.cmx queue.cmx set.cmx tree.cmx string.cmx -o $(LIB_NAME).cmxa
ocamlopt -a fromStdlib.cmx general.cmx fatal.cmx int.cmx float.cmx option.cmx stack.cmx list.cmx map.cmx queue.cmx set.cmx tree.cmx string.cmx char.cmx bool.cmx terminal.cmx -o $(LIB_NAME).cmxa
clean:
rm -f *.o *.a *.s *.cmi *.cmx *.cmxa *.cmo *.cma

4
lib/map.ml
View File

@ -1,4 +1,4 @@
open FromStdlib
open General
module type Map = sig
type key
@ -63,6 +63,6 @@ module RBTreeMap (M : MapSpecification) : Map with type key = M.key = struct
let insert ((k, v) : (key * 'v)) map =
match insert_helper (k, v) map with
| Branch (_, (key, value), left, right) -> Branch (Black, (key, value), left, right)
| Leaf -> failwith "if this exception is raised there is an error in the implementation of the function that called it"
| Leaf -> Fatal.failwith "if this exception is raised there is an error in the implementation of the function that called it"
end

2
lib/map.mli
View File

@ -1,3 +1,5 @@
open General
module type Map = sig
(** The type of keys in the map. *)
type key

2
lib/option.ml
View File

@ -1,4 +1,4 @@
open Exposed
open General
let return (x : 'a) : 'a option = Some x

2
lib/option.mli
View File

@ -1,3 +1,5 @@
open General
(* Monadic return for option type. Trivially boxes the variable of type 'a into a 'a option by applying the Some constructor. *)
val return : 'a -> 'a option

2
lib/queue.ml
View File

@ -1,5 +1,5 @@
open General
open List
open Exposed
let enqueue (a : 'a) (qu : 'a queue) : 'a queue =
{ qu with front = a :: qu.back }

2
lib/queue.mli
View File

@ -1,4 +1,4 @@
open Exposed
open General
(** Adds an element to the back of the queue, returning the new queue. Runs in O(1). *)
val enqueue : 'a -> 'a queue -> 'a queue

4
lib/set.ml
View File

@ -1,4 +1,4 @@
open FromStdlib
open General
module type RBTreeSet = sig
type member
@ -73,7 +73,7 @@ module RBTreeSet (M : SetSpecification) : RBTreeSet with type member = M.member
let insert (v : member) (set : set) : set =
match insert_helper v set with
| Branch (_, value, left, right) -> Branch (Black, value, left, right)
| Leaf -> failwith "if this exception is raised there is an error in the implementation of the function that called it"
| Leaf -> Fatal.failwith "if this exception is raised there is an error in the implementation of the function that called it"
let rec union set1 set2 =
match set1 with

2
lib/set.mli
View File

@ -1,3 +1,5 @@
open General
module type RBTreeSet = sig
(** Type of members in the set. *)
type member

2
lib/stack.ml
View File

@ -1,4 +1,4 @@
open FromStdlib open Exposed
open General
let pop (st : 'a stack) : 'a option * 'a stack =
match st with

2
lib/stack.mli
View File

@ -1,4 +1,4 @@
open Exposed
open General
(** Removes the top element from the stack, returning a tuple of the new stack, and None if the stack was empty, or Some [x] if [x] was on top of the stack. Popping an empty stack will result in the returned stack also being empty. Runs in O(1). *)
val pop : 'a stack -> 'a option * 'a stack

12
lib/string.ml
View File

@ -1,11 +1,11 @@
open FromStdlib open Exposed
open General
let ( + ) = stdlib_string_concat
let ( + ) = FromStdlib.string_concat
let length = stdlib_string_length
let length = FromStdlib.string_length
let of_int = stdlib_string_of_int
let of_int = FromStdlib.string_of_int
let of_float = stdlib_string_of_float
let of_float = FromStdlib.string_of_float
let of_bool = stdlib_string_of_bool
let of_bool = FromStdlib.string_of_bool

2
lib/string.mli
View File

@ -1,3 +1,5 @@
open General
(** Concatenates two strings together in the provided order. *)
val ( + ) : string -> string -> string

6
lib/terminal.ml Normal file
View File

@ -0,0 +1,6 @@
open General
let printf = FromStdlib.printf
let print s = printf "%s" s

7
lib/terminal.mli Normal file
View File

@ -0,0 +1,7 @@
open General
(** Formatted print to terminal. *)
val printf : 'a FromStdlib.printf_format -> 'a
(** Prints the provided string to the terminal. *)
val print : string -> unit

3
lib/tree.ml
View File

@ -1,5 +1,4 @@
open FromStdlib
open Exposed
open General
let combine (tr1 : 'a tree) (tr2 : 'a tree) (topBranch : 'a) : 'a tree =
Branch (topBranch, tr1 :: tr2 :: [])

2
lib/tree.mli
View File

@ -1,4 +1,4 @@
open Exposed
open General
(* Combines two trees of the same type, with the specified value at the new top node. Runs in O(1). *)
val combine : 'a tree -> 'a tree -> 'a -> 'a tree