Ocaml prelude

(*
 * File: prelude.ml
 * Copyright (c) 2018 Justin Hanekom <justin_hanekom@yahoo.com>
 *)

(*
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and associated documentation files (the "Software"),
 * to deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 * and/or sell copies of the Software, and to permit persons to whom the
 * Software is furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 * DEALINGS IN THE SOFTWARE.
 *)

open List
open Printf
open String

(* ----- TUPLES ----- *)

(** Returns the first component of a pair. *)
let fst (a, _) = a

(** Returns the second component of pair. *)
let snd (_, b) = b


(* ----- FOLDS AND TRAVERSALS ----- *)

(**
 * Left-associative fold of a list.
 * This function is not tail recursive.
 *
 * @param fn  function to apply to  each element of the list;
 *            fn is called with the accumulator and an element,
 *            and must return a new accumulator
 * @param acc initial accumulator value
 * @param lst list of elements to be fed to f
 * @result    final accumulator value created by applying f
 *            to each element of xs, from the left
 * @see       fold_left
 *)
let foldl fn acc lst = fold_left fn acc lst

(**
 * Right-associative fold of a list.
 * This function is tail recursive.
 *
 * @param fn  function to apply to each element of the list;
 *            fn is called with the accumulator and an element,
 *            and must return a new accumulator
 * @param acc initial accumulator value
 * @param lst list of elements to be fed to f
 * @result    final accumulator value created by applying f
 *            to each element of xs, from the right
 * @see       fold_right
 *)
let foldr fn lst acc = fold_right fn lst acc

(**
 * Maps each element of a list to a function, and combines the results.
 * This function is not tail recursive.
 *
 * @param fn  function to apply to each element of the list
 * @param lst list of elements to be fed to f
 * @result    new list of the form [f l1; f l2; f l3; ...]
 * @see       map
 *)
let map fn lst = List.map fn lst

(**
 * Maps each element of a list to a function, and throws away the results.
 * This function is not tail recursive.
 *
 * @param fn  function to apply to each element of the list
 * @param lst list of elements to be fed to f
 * @see       List.iter
 *)
let map_ fn lst = List.iter fn lst

(**
 * Returns the last element of a list, which must be non-empty.
 * This function is tail-recursive.
 *
 * @param lst list to get the last element of
 * @see       first
 *)
let rec last lst = match lst with
    | x::[] -> x
    | x::xs -> last xs
    | _     -> failwith "last []"

(**
 * Returns all elements excepting the last of a list,
 * which must be non-empty.
 * This function is not tail-recursive.
 *
 * @param lst list from which to extract the initial elements
 * @see       tail
 *)
let rec init lst = match lst with
    | x::[] -> []
    | x::xs -> x::init xs
    | _     -> failwith "init []"

(**
 * Left-associative fold of a list, which must be non-empty.
 * The first element of the list is used as the initial accumulator value.
 * This function is not tail recursive.
 *
 * @param fn  function to apply to each element of the list;
 *            fn is called with the accumulator and an element,
 *            and must return a new accumulator
 * @param lst list of elements to be fed to f
 * @see       foldl
 * @see       fold_left
 * @see       foldr'
 *)
let foldl' fn lst = match lst with
    | x::xs -> fold_left fn x xs
    | _     -> failwith "foldl' []"

(**
 * Right-associative fold of a list, which must be non-empty.
 * The last element of the list is used as the initial accumulator value.
 * This function is tail recursive.
 *
 * @param fn  function to apply to each element of the list, from the right;
 *            fn is called with the accumulator and an element,
 *            and must return a new accumulator
 * @param lst list of elements to be fed to f
 * @see       foldr
 * @see       fold_right
 * @see       foldl'
 *)
let foldr' fn lst = match lst with
    | _::_ -> let acc = init lst
              and lst' = last lst in
              fold_right fn acc lst'
    | _    -> failwith "foldr' []"


(* -----  LIST OPERATIONS ----- *)

(** Returns whether or not a list is empty. *)
let null lst = match lst with
    | [] -> true
    | _  -> false

(** Returns the length of a list. *)
let length = List.length

(** Returns the first element of a list, which must be non-empty. *)
let head lst = match lst with
    | _::_ -> List.hd lst
    | []   -> failwith "head []"

(** Returns the remaining elements of a list, which must be non-empty. *)
let tail lst = match lst with
    | _::_ -> List.tl lst
    | []   -> failwith "tail []"

(** Returns a copy of a list, with the elements in reverse order. *)
let reverse = List.rev

(** Appends two lists .*)
let (++) lst1 lst2  = append lst1 lst2

(**
 * Equivalent to `(reverse lst1) ++ lst2`,
 * but tail recursive and more efficient.
 *
 * @see reverse
 * @see (++)
 * @see append
 *)
let reverse_append lst1 lst2 = List.rev_append lst1 lst2

(**
 * Concatenates a list of lists.
 *
 * @param xss a list of lists of the form [[]; []; ...]
 *)
let concat xss = List.concat xss

(**
 * Returns a number of elements from the beginning of a list.
 * This function is not tail-recursive.
 *
 * @param num number of items to take from the list
 * @param lst list from which to take elements from the left of
 * @see       drop
 *)
let rec take num lst =
    if num <= 0 || (null lst)
    then []
    else head lst::take (num-1) (tail lst)

(**
 * Drops a number of elements from the beginning of a list.
 * This function is tail-recursive.
 *
 * @param num the number of elements to drop from the list
 * @param lst list from which to drop elements
 * @result    a list that is the list lst with the first num elements removed
 * @see       @take
 *)
let rec drop num lst =
    if num <= 0
    then lst
    else drop (num-1) (tail lst)

(**
 * Returns the biggest element of a list, which must be non-empty.
 *
 * @see minimum
 *)
let maximum lst = match lst with
    | _::_ -> foldl' (fun a b -> max a b) lst
    | _    -> failwith "maximum []"

(**
 * Returns the smallest element of a list, which must be non-empty.
 *
 * @see maximum
 *)
let minimum lst = match lst with
    | _::_ -> foldl' (fun a b -> min a b) lst
    | _    -> failwith "minimum []"

(**
 * Returns the sum of a list of integers, which must be non-empty.
 *
 * @see product
 *)
let sum lst = match lst with
    | _::_ -> foldl' (fun a b -> a+b) lst
    | _    -> failwith "sum []"

(**
 * Returns the product of a list of integers, which must be non-empty.
 *
 * @see sum
 *)
let product lst = match lst with
    | _::_ -> foldl' (fun a b -> a*b) lst
    | _    -> failwith "product []"

(**
 * Returns whether or not an element is in a list.
 * This function is tail-recursive.
 *
 * @param x   the element to search for
 * @param lst the list in which to search for the element x
 * @result    true if x is found in the list lst, otherwise false
 *)
let rec elem x lst = match lst with
    | y::ys -> if x = y
               then true
               else elem x ys;
    | []    -> false


(* ----- NUMERIC FUNCTIONS ----- *)

(** Returns the negative of an integer. *)
let negate n = (-n)

(** Returns whether or not an integer is even. *)
let even n = n mod 2 = 0

(** Returns whether or not an integer is odd. *)
let odd n = n mod 2 != 0

(** Returns the sign of an integer, either 1 or -1. *)
let signum n = if n >= 0 then 1 else (-1)

(**
 * Returns the greatest common divisor of two integers.
 * This function is tail-recursive.
 *)
let gcd a b =
   let rec gcd' a b = if b = 0
                       then a
                       else gcd' b (a mod b) in
    gcd' (abs a) (abs b)

(** Returns the smallest positive integer that two integers divide by. *)
let lcm a b = match (a, b) with
    | (_, 0) -> 0
    | (0, _) -> 0
    | (a, b) -> (abs a*b) / (gcd a b)


(* ----- STRING OPERATIONS ----- *)

(** Returns whether or not the string is empty. *)
let is_empty str = str = ""

(** Compares two strings, ignoring case. *)
let compare_ignore_case str1 str2 =
    let lower1 = lowercase str1
    and lower2 = lowercase str2 in
    compare lower1 lower2

(**
 * Returns whether or not two strings are equal, ignoring case.
 *
 * @see compare_ignore_case
 *)
let equals_ignore_case str1 str2 = compare_ignore_case str1 str2 = 0

(**
 * Returns whether or not one string begins with another.
 *
 * @param prefix prefix to be searched for in str
 * @param str    string to be tested if it begins with prefix
 * @result       true if str begins with prefix, otherwise false
 * @see          ends_with
 *)
let begins_with prefix str =
    let str_len = String.length str
    and pref_len = String.length prefix in
    if str_len < pref_len
    then false
    else String.sub str 0 pref_len = prefix

(**
 * Returns whether or not one string ends with another.
 *
 * @param suffix suffix to be searched for in str
 * @param str    string to be tested if it ends with suffix
 * @result       true if str ends with suffix, otherwise false
 * @see          begins_with
 *)
let ends_with suffix str =
    let str_len = String.length str
    and suff_len = String.length suffix in
    let pos = str_len-suff_len in
    if str_len < suff_len
    then false
    else String.sub str pos suff_len = suffix

(**
 * Returns whether or not the string contains the substring.
 * This function is tail-recursive.
 *
 * @param substr substring to search for in the string
 * @param str    string to be searched for the substring
 * @result       true if the string contains the substring, otherwise false
 *)
let rec contains_substring substr str = match str with
    | "" -> false
    | _  -> if begins_with substr str
            then true
            else
                let str_len = (String.length str)-1 in
                let new_str = String.sub str 1 str_len in
                contains_substring substr new_str

(**
 * Returns the index within the string of the character ch.
 * Throws Not_found if the character does not occur in the string.
 *
 * @param ch  character to search for in the string
 * @param str string to search for the character ch
 * @result    index of the first position where ch occurs in str
 * @see       index_of
 * @see       last_index_of_char
 *)
let index_of_char ch str = index str ch

(**
 * Returns the index within the string str of the string substr.
 * Throws Not_found if the string does not occur in the string str.
 * This function is tail-recursive.
 *
 * @param substr string to search for in the string str
 * @param str    string to search for the string substr
 * @result       index of the first position where substr occurs in str
 * @see          index_of_char
 * @see          last_index_of
 *)
let index_of substr str =
    if substr = ""
    then 0
    else
        let ch = substr.[0] in
        let rec fn from =
            let i = index_from str from ch in
            let sub_len = String.length substr in
            let found = String.sub str i sub_len in
            if found = substr
            then i
            else fn (i+1) in
        fn 0

(**
 * Returns the last index within the string of the character ch.
 * Throws Not_found if the character does not occur in the string.
 *
 * @param ch  character to search for in the string
 * @param str string to search for the character ch
 * @result    index of the last position where ch occurs in the string
 * @see       index_of_char
 * @see       last_index_of
 *)
let last_index_of_char ch str = rindex str ch

(**
 * Returns the last index within the string str of the string substr.
 * Throws Not_found if the string does not occur in the string str.
 * This function is tail-recursive.
 *
 * @param substr string to search for in the string str
 * @param str    string to search for the string substr
 * @result       index of the last position where substr occurs in str
 * @see          index_of
 * @see          last_index_of_char
 *)
let last_index_of substr str =
    let last_index = String.length str - 1 in
    if substr = ""
    then last_index
    else let sub_len = String.length substr
         and ch = substr.[0] in
         let rec fn from =
            let i = rindex_from str from ch in
            let found = String.sub str i sub_len in
            if found = substr
            then i
            else fn (i-1) in
    fn last_index

(**
 * Replaces all occurances of a character within
 * the string with a different character.
 *
 * @param old character to replace in the string
 * @param nu  character to replace the old character with
 * @param str string in which to replace occurances of a character
 * @return    new string with all occurances of old replaced by nu
 *)
let replace_char old nu str =
    let fn ch = if ch = old
                then nu
                else ch in
    String.map fn str

(**
 * Splits the string str on sep and returns a list of the resulting strings.
 * The separator string is not included in the returned list of strings.
 * This function is tail-recursive.
 *
 * @param sep separator used to split the string
 * @param str string that (possibly) contains one or more
 *            occurances of the separator
 * @result list of strings that were separated by sep
 *)
let split_on sep str =
    let sep_len = String.length sep in
    let rec fn acc str =
        try let i = last_index_of sep str in
            let pos = sep_len+i
            and len = (String.length str)-sep_len-i in
            let new_str = String.sub str 0 i
            and substr = String.sub str pos len in
            fn (substr::acc) new_str
        with Not_found -> str::acc in
    fn [] str

(**
 * Joins the list of strings, interspersing the separator sep between them.
 *
 * @param sep  separator to put between each pair of strings
 * @param strs list of strings to be joined together, with the separator sep
 *             in between each pair
 * @result     string concatenation of the strings in strs, separated by sep
 *)
let join_with sep strs = String.concat sep strs


(** Returns the string representation of a boolean value. *)
let string_of_boolean flag = match flag with
    | true -> "true"
    | _    -> "false"

(** Folds a list into a string. *)
let string_of_list fn lst =
    fold_left fn "" lst |> sprintf "[%s]"

(** Returns the string representation of a list of integers. *)
let string_of_int_list lst =
    let fn a n = if a = ""
                 then sprintf "%d" n
                 else sprintf "%s; %d" a n in
    string_of_list fn lst

(** Returns the string representation of a list of strings. *)
let string_of_string_list lst =
    let fn a x = if a = ""
                 then sprintf "\"%s\"" x
                 else sprintf "%s; \"%s\"" a x in
    string_of_list fn lst


(** ----- MISCELLANEOUS FUNCTIONS ----- *)

(** Returns the identity of a value. *)
let id x = x

(**
 * Extracts the second element of a list,
 * which must have at least two elements.
 *
 * @param lst the list from which to extract the second element
 * @return  second element of list lst
 *)
let second lst = match lst with
    | _::x::xs -> x
    | _        -> failwith "second"


(* ----- FUNCTION TESTS ----- *)

type boolean_test =     { test : string; expect : bool;        result : bool }
type int_test =         { test : string; expect : int;         result : int }
type string_test =      { test : string; expect : string;      result : string }
type int_list_test =    { test : string; expect : int list;    result : int list }
type string_list_test = { test : string; expect : string list; result : string list }

type test =
    | BooleanTest    of boolean_test
    | IntTest        of int_test
    | StringTest     of string_test
    | IntListTest    of int_list_test
    | StringListTest of string_list_test

(** Prints the result of performing the test. *)
let print_test_result x =
    let print_test test expect result =
        let msg = test ^ " => " ^ result in
        print_endline @@ if expect = result
                         then msg
                         else msg ^ " *** BUT EXPECTED "^ expect in
    match x with
        | BooleanTest x    -> print_test x.test
                                         (string_of_boolean x.expect)
                                         (string_of_boolean x.result)
        | IntTest x        -> print_test x.test
                                         (string_of_int x.expect)
                                         (string_of_int x.result)
        | StringTest x     -> print_test x.test x.expect x.result
        | IntListTest x    -> print_test x.test
                                         (string_of_int_list x.expect)
                                         (string_of_int_list x.result)
        | StringListTest x -> print_test x.test
                                         (string_of_string_list x.expect)
                                         (string_of_string_list x.result)

let () =
    let p = ["alpha"; "bravo"; "charlie"; "delta"; "echo"]
    and q = ["foxtrot"; "golf"; "hotel"; "igloo"; "juliet"]
    and r = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
    and n = 42 in
    let t = (p, q) in
    let tests = [
        StringListTest { test   = "fst t";
                         expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"];
                         result = fst t };
        StringListTest { test   = "snd t";
                         expect = ["foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
                         result = snd t };
        BooleanTest { test = "even n"; expect = true; result = even n };
        BooleanTest { test = "odd n"; expect = false; result = odd n };
        IntTest { test = "signum n"; expect = 1; result = signum n };
        IntTest { test = "negate n"; expect = (-42); result = negate n };
        IntTest { test = "gcd 42 12"; expect = 6; result = gcd 42 12 };
        IntTest { test = "lcm 42 12"; expect = 84; result = lcm 42 12 };
        IntTest { test = "minimum r"; expect = 1; result = minimum r };
        IntTest { test = "maximum r"; expect = 10; result = maximum r };
        IntTest { test = "sum r"; expect = 55; result = sum r };
        IntTest { test = "product r"; expect = 3628800; result = product r };
        BooleanTest { test   = "is_empty \"\"";
                      expect = true;
                      result = is_empty "" };
        BooleanTest { test   = "is_empty \"NOT!\"";
                      expect =false;
                      result = is_empty "NOT!" };
        IntTest { test   = "compare_ignore_case \"JESUS\" \"Jesus\"";
                  expect = 0;
                  result = compare_ignore_case "JESUS" "Jesus" };
(*
        BooleanTest { test   = "begins_with \"H\" \"Hello\"";
                      expect = true;
                      test   = begins_with "H" "Hello" };
*)
        BooleanTest { test   = "ends_with '!' \"Hello!\"";
                      expect = true;
                      result = ends_with "!" "Hello, World!" };
        BooleanTest { test   = "contains_substring \"World\" \"Hello, World!\"";
                      expect = true;
                      result = contains_substring "World" "Hello, World!" };
        BooleanTest { test   = "contains_substring \"world\" \"Hello, World!\"";
                      expect = false;
                      result = contains_substring "world" "Hello, World!" };
        IntTest { test   = "index_of_char '!' \"Hello!, World!\"";
                  expect = 5;
                  result = index_of_char '!' "Hello!, World!" };
        IntTest { test   = "index_of \"World\" \"HelloW, World!\"";
                  expect = 8;
                  result = index_of "World" "HelloW, World!" };
        IntTest { test   = "last_index_of_char '!' \"Hello!, World!\"";
                  expect = 13;
                  result = last_index_of_char '!' "Hello!, World!" };
        IntTest { test   = "last_index_of \"o!\" \"Hello!, World!\"";
                  expect = 4;
                  result = last_index_of "o!" "Hello!, World!" };
        StringTest { test   = "replace_char 'l' 'x' \"Hello, World!\"";
                     expect = "Hexxo, Worxd!";
                     result = replace_char 'l' 'x' "Hello, World!" };
        BooleanTest { test = "null p"; expect = false; result = null p };
        IntTest { test = "length p"; expect = 5; result = length p };
        BooleanTest { test = "elem 3 r"; expect = true; result = elem 3 r };
        StringTest { test = "head q"; expect = "foxtrot"; result = head q };
        StringTest { test = "second q"; expect = "golf"; result = second q };
        StringListTest { test   = "tail q";
                         expect = ["golf"; "hotel"; "igloo"; "juliet"];
                         result = tail q };
        StringListTest { test   = "init p";
                         expect = ["alpha"; "bravo"; "charlie"; "delta"];
                         result = init p };
        StringTest { test = "last p"; expect = "echo"; result = last p };
        IntListTest { test   = "reverse r";
                      expect = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1];
                      result = reverse r };
        StringListTest { test   = "append p q";
                         expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
                         result = append p q };
        StringListTest { test   = "reverse_append p q";
                         expect = ["echo"; "delta"; "charlie"; "bravo"; "alpha"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
                         result = reverse_append p q };
        StringListTest { test   = "concat [p; q]";
                         expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
                         result = concat [p; q] };
        StringListTest { test   = "take 2 p";
                         expect = ["alpha"; "bravo"];
                         result = take 2 p };
        StringListTest { test   = "drop 2 p";
                         expect = ["charlie"; "delta"; "echo"];
                         result = drop 2 p };
        IntTest { test   = "foldl (fun a n -> a-n) 0 r";
                  expect = -55;
                  result = foldl (fun a n -> a-n) 0 r };
        IntTest { test   = "foldr (fun n a -> n+a) r 0";
                  expect = 55;
                  result = foldr (fun n a -> n+a) r 0 };
        IntTest { test   = "foldl' (fun a n -> a-n) r";
                  expect = -53;
                  result = foldl' (fun a n -> a-n) r };
        IntTest { test   = "foldr' (fun a n -> a+n) r";
                  expect = 55;
                  result = foldr' (fun a n -> a+n) r };
        IntListTest { test   = "map String.length p";
                      expect = [5; 5; 7; 5; 4];
                      result = map String.length p };
        StringListTest { test   = "split_on \";\" \"aaa;bbb;;ccc\"";
                         expect = ["aaa"; "bbb"; ""; "ccc"];
                         result = split_on ";" "aaa;bbb;;ccc" };
        StringTest { test   = "join_with \", \" [\"aaa\"; \"bbb\"; \"ccc\"]";
                     expect = "aaa, bbb, ccc";
                     result = join_with ", " ["aaa"; "bbb"; "ccc"] } ] in
    printf "p => %s\n" (string_of_string_list p);
    printf "q => %s\n" (string_of_string_list q);
    printf "r => %s\n" (string_of_int_list r);
    printf "t => (%s, %s)\n" (string_of_string_list p) (string_of_string_list q);
    print_endline "";
    List.iter print_test_result tests;
    print_endline ""