(*

   functional programming intro
   Joost Yervante Damad
   April 17, 2011

   # about

   - types & type inference
   - list, tuples
   - functions, partial application, currying and Schönfinkelisation
   - functional composition & higher-order programming
   - generics and polymorphism
   - map, fold, iter, ...

   # not about

   - monads
   - functors
   - classes & objects
   - functional laziness

*)

(* types & type inference

   - everything has a type; types are infered 
   - type is decided at compile time *)

5;;

"hello";;

(* - values, let binding *)

let a = 5

let b = a + 1

let b = "hello"

let c = 7.5

(* - lists *)

let l1 = [1;2;3]

let l2 = [ 'a'; 'b'; 'c' ]

let l3 = [ [1;2]; [3;4] ]

let l3 = [1;2;'a']

(* - tuples *)

let t1 = (1, 2, 3)

let t2 = (1, 2, 'a')

let t3 = (1, ['a';'b'], 3)

let l4 = [(1,'a'); (2,'b')]

let l5 = [('a',1); (2,'b')]

let l6 = [1,2,3]

let _a,x,_b = (1,2,3)

(* - functions *)

let inc a = a + 1

let x = inc 7

let add a b = a + b

let y = add 7 4

let z = add x 5

let u = add (inc z) 4

let a = (add 3) 1

(* - currying / partial application *)

let other_inc x = add x 1

let other_inc x = add 1 x

let other_inc x = (add 1) x

let other_inc = add 1

let b = other_inc 4

let x = 5.
let b = 5

let x = float_of_int b

(* look back at add ! *)
let add a b = a + b

let add2 = add 2

let c = add2 3

(* - higher order functions *)

let inc_if_less_then_10 a =
  if a < 10 
  then a+1
  else a

(* -||| sidebar, functional if *)

let fi x = if x > 7 then 7 else "hello"
let fi x = if x > 7 then 7
let fi x = if x > 7 then 7 else 9

(* - higher order functions *)

let d = inc_if_less_then_10 7
let e = inc_if_less_then_10 11

let less_then_10 a = a < 10

let inc_if_less_then_10 a =
  if (less_then_10 a)
  then a+1
  else a

let inc_if condition a =
  if condition a
  then a+1
  else a

(* - functional composition *)

let inc_if_less_then_10 a = inc_if less_then_10 a

let d = inc_if_less_then_10 7
let e = inc_if_less_then_10 11

let f = inc_if  less_then_10 8

let inc_if_less_then_10 = inc_if less_then_10

(* generics & polymorphism *)

let l = [1; 2; 3; 4]
let head = List.hd l
let tail = List.tl l

let second = List.hd (List.tl l)

let second list = List.hd (List.tl list)
let a = second l

(* another example of polymorphism & functional composition *)

let say_hello out_channel =
  output_string out_channel "hello\n"

let () = say_hello stdout

let say_hello out_channel i =
  if i < 0 then
    raise (Invalid_argument "expecting i >= 0")
  else
    output_string out_channel "hello\n"

let () = say_hello stdout 7
let () = say_hello stdout (-7)

let say_hello filename i =
  if i < 0 then
    raise (Invalid_argument "expecting i > 0")
  else
    let out_channel = open_out filename in
    begin
      let () = output_string out_channel "hello\n" in
      begin
	let () = close_out out_channel in
	begin
	  ()
	end
      end
    end

let () = say_hello "/dev/stdout" 7

let say_hello make_output i =
  if i < 0 then
    raise (Invalid_argument "expecting i > 0")
  else
    let out_channel = make_output () in
    let () = output_string out_channel "hello\n" in
    close_out out_channel

let make_file_output filename () = open_out filename

let () = say_hello (make_file_output "/dev/stdout") 7 

let with_file_output filename func =
  let out_channel = open_out filename in
  let a = func out_channel in
  let () = close_out out_channel in
  a

let say_hello with_output i =
  if i < 0 then
    raise (Invalid_argument "expecting i > 0")
  else
    let doit out_channel = output_string out_channel "hello\n" in
    with_output doit

let () = say_hello (with_file_output "/dev/stdout") 7

let with_stdout = with_file_output "/dev/stdout"

let say_hello_on_stdout = say_hello (with_file_output "/dev/stdout")

let write_on_stdout string = 
  let doit out_channel = output_string out_channel string in
  with_file_output "/dev/stdout" doit

let say_hello write i =
  if i < 0 then
    raise (Invalid_argument "expecting i > 0")
  else
    write "hello\n"

let () = say_hello write_on_stdout 7

(* map, iter, fold *)

(* map *)

let l = [1; 2; 3; 4]
let l2 = List.map inc l
let map = List.map
let map_inc list = List.map inc list
let map_inc = List.map inc

let l3 = map string_of_int l2
let map_string = map string_of_int

let print_int i = Printf.printf "%d\n" i
let print_int = Printf.printf "%d\n"

let l3 = List.map add l
let apply y f = f y
let crazy y = List.map (apply y) l3
let a = crazy 1
















(* this space intentionally left blank ;) *)















let a = List.map (apply 1) [add 1; add 2; add 3; add 4]

let a = [apply 1 (add 1); apply 1 (add 2); apply 1 (add 3); apply 1 (add 4)]

let a = [(add 1) 1; (add 2) 1; (add 3) 1; (add 4) 1]

let a = [add 1 1; add 2 1; add 3 1; add 4 1]

(* iter *)

let () = List.iter print_int l
let () = List.iter (Printf.printf "%d\n") l
let iter = List.iter

(* fold *)

let sum = List.fold_left add 0 l
let sum = List.fold_left ( + ) 0 l
let product = List.fold_left ( * ) 1 l

let reduce = List.fold_left

let sum = List.fold_left add

(* fold will be explained in detail later ! *)

(* |||| sidebar: functions can be data ! *)

let empty_set _key = raise Not_found

let set_add set key value =
  let new_set key2 =
    if key = key2 then value
    else set key2
  in
  new_set

let set1 = empty_set
let a = set1 "hello"

let s_set = set_add empty_set "hello" "world"
let i_set = set_add empty_set 7 3.14159

let a = s_set "hello"

let s_set2 = set_add s_set "mars" "red"
let s_set3 = set_add s_set2 "foo" 8

let a = s_set2 "hello"
let b = s_set2 "mars"
let c = s_set2 "cucu"

(* lists revisited *)

let l = [2;3;4]
let l2 = 1::l
let head = List.hd l2
let tail = List.tl l2

(* recursion *)

let show_elements show_one l = List.iter show_one l

let rec show_elements show_one l = 
  match l with
    | [] -> ()
    | x::xn ->
      let () = show_one x in
      show_elements show_one xn

let sum l = List.fold_left (+) 0 l
  
let rec sum l =
  match l with
    | [] -> 0
    | x::xn ->
      x + sum xn

let a = sum l2

let rec sum acc l =
  match l with
    | [] -> acc
    | x::xn -> sum (acc+x) xn

let b = sum 0 l2

let rec sum acc l =
  match l with
    | [] -> acc
    | x::xn ->
      let new_acc = acc+x in
      sum new_acc xn

let c = sum 0 l2

let rec sum add acc l =
  match l with
    | [] -> acc
    | x::xn ->
      let new_acc = add acc x in
      sum add new_acc xn

let d = sum add 0 l2

let rec fold_left func acc l =
  match l with
    | [] -> acc
    | x::xn ->
      let new_acc = func acc x in
      fold_left func new_acc xn

let e = fold_left (+) 0 l2 

(* reference: The Little Schemer *)

(* bonus material *)

(* lambdas *)

let add a b = a + b
let add = (+)
let add = fun a b -> a + b

let res = List.fold_left (fun a b -> (a * b)+1) 1 [1;2;3]

let set_add set key value =
  let new_set key2 =
    if key = key2 then value
    else set key2
  in
  new_set

let set_add set key value =
  (fun key2 ->
    if key = key2 then value
    else set key2
  )

(* iter and map revisited *)

let iter func l = fold_left (fun () x -> func x) () l

let map func l = fold_left 
  (fun yn x -> 
    let y = func x in
    y::yn) 
  [] l

let map func l = fold_left (fun yn x -> (func x)::yn) [] l

let l3 = List.map ((+) 1) l2

(* variant types *)

type cmd = 
  | PUT
  | GET

let show_cmd c = 
  match c with
    | PUT -> "PUT"
    | GET -> "GET"

let () = Printf.printf "%s\n" (show_cmd PUT)

type cmd =
  | PUT
  | GET
  | POST

let int_of_cmd cmd =
  match cmd with
    | PUT -> 1
    | GET -> 2 
    | POST -> 3

let cmd_of_int i =
  match i with
    | 1 -> PUT
    | 2 -> GET
    | 3 -> POST
    | _ -> failwith "illegal cmd"

type iors =
  | Int of int
  | String of string

let a = Int 5
let b = String "hello"

type sessionid = SID of int

let sid1 = SID 1

let show_session_id sid =
  match sid with
    | Sid i -> Printf.sprintf "%08x" i

let show_session_id (SID sid) = Printf.sprintf "%08x" sid

let a = show_session_id sid1

let b = sid1 + 1

let inc_session_id (SID sid) = SID (sid+1)

let c = inc_session_id sid1

(* refactoring advantage ! *)

type sessionid = SID of string

(* options *)

type listen_port_param =
  | LP_Int of int
  | LP_Take_from_config

let a = LP_Int 6667
let b = LP_Take_from_config

type 'a myoption = 
  | None 
  | Some of ('a) 

type local_port = int option

let local_port1 = Some 45
let local_port2 = None

type listen_port_param = int option

(* a tree *)

type 'a btree = 
  | Empty | Node of 'a * 'a btree * 'a btree

let a = Empty
let b = Node (7, Empty, Empty) 
let c = Node (4, b, Node (10, Empty, Empty))

(* why recursion if you have fold ? *)

let l = [1;3;8;10;12]

let a = List.fold_left 
  (fun acc x ->
    let () = Printf.printf "... trying %d\n" x in
    match acc with
      | Some _ -> acc
      | None -> if x > 7 then Some x else None
  ) None l

let a =
  let rec loop l = 
    match l with
      | [] -> raise Not_found
      | x::xn -> 
	let () = Printf.printf "... trying %d\n" x in
	if x > 7 then x 
	else loop xn
  in
  loop l
  

(* reference: Haskell book: Learn You a Haskell for Great Good!: A Beginner's Guide to Haskell *)

let a:string list = []