(*
Records
Records serve the same programming purpose as tuples
Provide better documentation, more readable code
Allow components to be accessed by label instead of position
Labels (aka field names must be unique)
Fields accessed by suffix dot notation
*)

(* Record Types *)
(* Record types must be declared before they can be used *)
type person = {name : string; ss : (int * int * int); age : int};;
(*
person is the type being introduced
name, ss and age are the labels, or fields
*)

(* Record Values *)
(* Records built with labels; order does not matter *)
let teacher = {name = "Elsa L. Gunter"; age = 102; ss = (119,73,6244)};;

(* Record Values *)
let student = {ss=(325,40,1276); name="Joseph Martins"; age=22};;
student = teacher;;

(* Record Pattern Matching *)
let {name = elsa; age = age; ss = (_,_,s3)} = teacher;;

(* Record Field Access*)
let soc_sec = teacher.ss;;

(* New Records from Old *)
let birthday person = {person with age = person.age + 1};;

birthday teacher;;

(* New Records from Old *)
let new_id name soc_sec person =
 {person with name = name; ss = soc_sec};;

new_id "Guieseppe Martin" (523,04,6712) student;;

(*
Variants - Syntax (slightly simplified) 

type name = C1 [of  ty1] | . . . | Cn [of tyn]
Introduce a type called name
(fun x -> Ci x) : ty1 -> name
Ci is called a constructor; if the optional type argument is omitted,
 it is called a constant
Constructors are the basis of almost all pattern matching
Enumeration Types as Variants
An enumeration type is a collection of distinct values
In C and Ocaml they have an order structure; order by order of input
*)

(* Enumeration Types as Variants *)
type weekday = Monday | Tuesday | Wednesday
   | Thursday | Friday | Saturday | Sunday;;

(* Functions over Enumerations *)
let day_after day = match day with
      Monday -> Tuesday
  | Tuesday -> Wednesday
  | Wednesday -> Thursday
  | Thursday -> Friday
  | Friday -> Saturday
  | Saturday -> Sunday
  | Sunday -> Monday;;

(* Functions over Enumerations *)
let rec days_later n day =
    match n with 0 -> day
    | _ -> if n > 0
          then day_after (days_later (n - 1) day)
         else days_later (n + 7) day;;

(* Functions over Enumerations *)
days_later 2 Tuesday;;

days_later (-1) Wednesday;;

days_later (-4) Monday;;

(*
Disjoint Union Types
Disjoint union of types, with some possibly occurring more than once
We can also add in some new singleton elements
*)

(* Disjoint Union Types *)
type id = DriversLicense of int | SocialSecurity of int | Name of string;;

let check_id id = match id with
      DriversLicense num -> 
       not (List.mem num [13570; 99999])
    | SocialSecurity num -> num < 900000000
    | Name str -> not (str = "John Doe");;

(* Polymorphism in Variants *)
(* The type 'a option is gives us something to represent non-existence
  or failure *)

type 'a option = Some of 'a | None;;

(*
Used to encode partial functions
Often can replace the raising of an exception
*)

(* Functions over option *)
let rec first p list =
    match list with [ ] -> None
    | (x::xs) -> if p x then Some x else first p xs;;

first (fun x -> x > 3) [1;3;4;2;5];;

first (fun x -> x > 5) [1;3;4;2;5];;

(* Mapping over Variants *)
let optionMap f opt =
    match opt with None -> None
    | Some x -> Some (f x);;

optionMap
  (fun x -> x - 2)
  (first (fun x -> x > 3) [1;3;4;2;5]);;

(* Folding over Variants *)
let optionFold someFun noneVal opt =
    match opt with None -> noneVal
    | Some x -> someFun x;;

let optionMap f opt =
    optionFold (fun x -> Some (f x)) None opt;;

(*
Recursive Types
The type being defined may be a component of itself
*)

(* Recursive Data Types *)
type int_Bin_Tree =
 Leaf of int | Node of (int_Bin_Tree * int_Bin_Tree);;

(* Recursive Data Type Values *)
let bin_tree =
 Node(Node(Leaf 3, Leaf 6),Leaf (-7));;

(*
Recursive Data Type Values

  bin_tree =   Node

         Node               Leaf (-7)

Leaf 3      Leaf 6
*)

(* Recursive Functions *)
let rec first_leaf_value tree =
    match tree with (Leaf n) -> n
    | Node (left_tree, right_tree) ->
     first_leaf_value left_tree;;

let left = first_leaf_value bin_tree;;

(* Mapping over Recursive Types *)
let rec ibtreeMap f tree =
    match tree with (Leaf n) -> Leaf (f n)
    | Node (left_tree, right_tree) ->
     Node (ibtreeMap f left_tree,
           ibtreeMap f right_tree);;

(* Mapping over Recursive Types *)
ibtreeMap ((+) 2) bin_tree;;

(* Folding over Recursive Types *)
let rec ibtreeFoldRight leafFun nodeFun tree =
    match tree with Leaf n -> leafFun n
    | Node (left_tree, right_tree) ->
      nodeFun
      (ibtreeFoldRight leafFun nodeFun left_tree)
      (ibtreeFoldRight leafFun nodeFun right_tree);;

(* Folding over Recursive Types *)
let tree_sum = 
    ibtreeFoldRight (fun x -> x) (+);;

tree_sum bin_tree;;

(* Mutually Recursive Types *)
type 'a tree = TreeLeaf of 'a
   | TreeNode of 'a treeList
and 'a treeList = Last of 'a tree
   | More of ('a tree * 'a treeList);;

(* Mutually Recursive Types - Values *)
let tree =
   TreeNode
    (More (TreeLeaf 5,
           (More (TreeNode
                  (More (TreeLeaf 3,
                         Last (TreeLeaf 2))),
                  Last (TreeLeaf 7)))));;


(*
Mutually Recursive Types - Values
TreeNode

More              More           Last 

TreeLeaf       TreeNode            TreeLeaf

    5                More           Last       7

                      TreeLeaf        TreeLeaf

                           3                   2
*)

(*
Mutually Recursive Types - Values
A more conventional picture 



            5                                    7


                        3               2
*)

(* Mutually Recursive Functions *)
let rec fringe tree =
    match tree with (TreeLeaf x) -> [x]
  | (TreeNode list) -> list_fringe list
and list_fringe tree_list =
    match tree_list with (Last tree) -> fringe tree
  | (More (tree,list)) ->
    (fringe tree) @ (list_fringe list);;

(* Mutually Recursive Functions *)
fringe tree;;

(* Nested Recursive Types*)
type 'a labeled_tree =
 TreeNode of ('a * 'a labeled_tree list);;

(* Nested Recursive Type Values *)
let ltree =
  TreeNode(5,
    [TreeNode (3, []);
     TreeNode (2, [TreeNode (1, []);
                   TreeNode (7, [])]);
     TreeNode (5, [])]);;

(*
Nested Recursive Type Values
Ltree =  TreeNode(5)

          ::                ::                 ::           [ ]

TreeNode(3)   TreeNode(2)   TreeNode(5)

      [ ]             ::             ::    [ ]        [ ]   

                 TreeNode(1)  TreeNode(7)

                       [ ]              [ ]
Nested Recursive Type Values

5


3           2           5


1           7
*)

(* Mutually Recursive Functions *)
let rec flatten_tree labtree =
    match labtree with TreeNode (x,treelist)
      -> x::flatten_tree_list treelist
    and flatten_tree_list treelist =
    match treelist with [] -> []
    | labtree::labtrees
      -> flatten_tree labtree
        @ flatten_tree_list labtrees;;

flatten_tree ltree;;

(* Nested recursive types lead to mutually recursive functions *)

(* Infinite Recursive Values *)
let rec ones = 1::ones;;

match ones with x::_ -> x;;

(* Infinite Recursive Values *)
let rec lab_tree = TreeNode(2, tree_list)
    and tree_list = [lab_tree; lab_tree];;

(* Infinite Recursive Values*)
match lab_tree
   with TreeNode (x, _) -> x;;