(* Example of Tail Recursion *)
let rec prod l =
    match l with [] -> 1
    | (x :: rem) -> x * prod rem;;

let prod list =
    let rec prod_aux l acc =
        match l with [] -> acc
        | (y :: rest) -> prod_aux rest (acc * y)
(* Uses associativity of multiplication *)
    in prod_aux list 1;;


(* Example of Tail Recursion *)
let prod list =
    let rec prod_aux l acc =
        match l with [] -> acc
        | (y :: rest) -> prod_aux rest  (acc * y)
    in prod_aux list 1;;

let prod list =
    List.fold_left (fun acc -> fun y -> acc * y) 1 list;;

(* Example of Tail Recursion *)
let rec app fl x =
    match fl with [] -> x
     | (f :: rem_fs) -> f (app rem_fs x);;

let app fs x =
    let rec app_aux fl acc=
        match fl with [] -> acc
        | (f :: rem_fs) -> app_aux rem_fs 
                                   (fun z -> acc (f z))
    in app_aux fs (fun y -> y) x;;

(*
Continuation Passing Style

Writing procedures so that they take a continuation to which to
give (pass) the result, and return no result, is called continuation
passing style (CPS)
*)

(* Example of Tail Recursion & CSP *)
let app fs x =
    let rec app_aux fl acc=
        match fl with [] -> acc
        | (f :: rem_fs) -> app_aux rem_fs 
                                 (fun z -> acc (f z))
    in app_aux fs (fun y -> y) x;;

let rec appk fl x k =
    match fl with [] -> k x
    | (f :: rem_fs) -> appk rem_fs x (fun z -> k (f z));;

(* Example of CSP *)
let rec app fl x =
    match fl with [] -> x
     | (f :: rem_fs) -> f (app rem_fs x);;

let rec appk fl x k =
    match fl with [] -> k x
    | (f :: rem_fs) -> appk rem_fs x (fun z -> k (f z));;

(*
Continuation Passing Style

A programming technique for all forms of “non-local” control flow:
  non-local jumps
  exceptions
  general conversion of non-tail calls to tail calls

Essentially it’s a higher-order function version of GOTO
*)

(*
Continuation Passing Style

A compilation technique to implement non-local control flow,
especially useful in interpreters.

A formalization of non-local control flow in denotational semantics

Terms:
A function is in Direct Style when it returns its result back to the caller.
A Tail Call occurs when a function returns the result of another
function call without any more computations (eg tail recursion).
A function is in Continuation Passing Style when it passes its result
to another function.
Instead of returning the result to the caller, we pass it forward to
another function.
*)

(* Example *)

(* Simple reporting continuation: *)

let report x = (print_int x; print_newline( ) );;

(* Simple function using a continuation: *)
let plusk a b k = k (a + b);;

plusk 20 22 report;;

(* Recursive Functions *)
(* Recall: *)
let rec factorial n =
    if n = 0 then 1 else n * factorial (n - 1);;

(* Recursive Functions *)
let rec factorial n =
    if n = 0 then 1 (* Returned value *)
    else 
        let r = factorial (n - 1) in
        let a = n * r in
        a  (* Returned value *) ;;

(* Recursive Functions *)
let rec factorialk n k =
    if n = 0 then k 1 (* Passed value *)
    else
        let k1 r =
              let a = n * r  in k a (* Passed value *) in
factorialk (n - 1) k1 ;;

(* Recursion Functions *)
let rec factorialk n k =
  if n = 0 then k 1 else factorialk (n - 1) (fun r -> k (n * r));;

(*
Recursive Functions 
Notice: factorialk is now tail recursive
To make recursive call, must built intermediate continuation to 
take recursive value:  m
build it to final result: n * m
And pass it to final continuation: 
      k (n * m)
*)

(* Nesting CPS *)
let rec lengthk list k = match list with [ ] -> k 0
    | x :: xs -> lengthk xs (fun r -> k (r + 1));;

let rec lengthk list k = match list with [ ] -> k 0
    | x :: xs -> lengthk xs (fun r -> plusk r 1 k);;

lengthk [2;4;6;8] report;;

(* Exceptions - Example *)
exception Zero;;

let rec list_mult_aux list = 
    match list with [ ] -> 1
    | x :: xs ->
     if x = 0 then raise Zero 
                 else x * list_mult_aux xs;;

(* Exceptions - Example *)
let list_mult list =
    try list_mult_aux list with Zero -> 0;;

(*
Exceptions

When an exception is raised
The current computation is aborted
Control is “thrown” back up the call stack until a matching handler is found
All the intermediate calls waiting for a return value are thrown away
*)

(* Implementing Exceptions *)
let multkp m n k =
   let r = m * n in
    (print_string "product result: ";
     print_int r; print_string "\n";
     k r);;

(* Implementing Exceptions *)
let rec list_multk_aux list k kexcp =
    match list with [ ] -> k 1
    | x :: xs -> if x = 0 then  kexcp  0
      else list_multk_aux xs 
              (fun r -> multkp x r k) kexcp;;
let rec list_multk list k = list_multk_aux list  k  k;;

(* Implementing Exceptions *)
list_multk [3;4;2] report;;

list_multk [7;4;0] report;;

(*
Terminology

Tail Position: A subexpression s of expressions e, if it is evaluated,
will be taken as the value of e
 if (x>3) then x + 2 else x - 4
 let x = 5 in x + 4
Tail Call: A function call that occurs in tail position
 if (h x) then f x else (x + g x)
Available: A function call that can be executed by the current expression
The fastest way to be unavailable is to be
guarded by an abstraction (anonymous function).
if (h x) then f x else (x + g x)
if (h x) then (fun x -> f x) else (g (x + x)) 
*)

(* 
CPS
Transformation Step 1: Add continuation argument to any function
definition:
 let f arg = e ⇒ let f arg k = e
 Idea: Every function takes an extra parameter saying where the result goes
Step 2: A simple expression in tail position should be passed to a
continuation instead of returned:
 return a ⇒ k a
 Assuming a is a constant or variable.
 “Simple” = “No available function calls.”
Step 3: Pass the current continuation to every function call in tail position
 return f arg ⇒ f arg k
The function “isn’t going to return,” so we need to tell it where to put
the result.

Step 4: Each function call not in tail position needs to be built into a
new continuation (containing the old continuation as appropriate)
 return op (f arg) ⇒ f arg (fun r -> k(op r))
 op represents a primitive operation
*)

(* Example *)
(* Before: *)
let rec add_list lst =
match lst with
  [ ] -> 0
| 0 :: xs -> add_list xs
| x :: xs -> (+) x (add_list xs);;

(* After: *)
let rec add_listk lst k =
                       (* rule 1 *)
match lst with
| [ ] -> k 0 (* rule 2 *)
| 0 :: xs -> add_listk xs k
                          (* rule 3 *)
| x :: xs -> add_listk xs
           (fun r -> k ((+) x r));;
                    (* rule 4 *)

(* Continuations Example *)
let add a b k = print_string "Add "; k (a + b);;
let sub a b k = print_string "Sub "; k (a - b);;
let report n = print_string "Answer is: ";
                     print_int n;
                     print_newline ();;
let idk n k = k n;;

type calc = Add of int | Sub of int
(* A Small Calculator *)
let rec eval lst k =
  match lst with
  (Add x) :: xs -> eval xs (fun r -> add r x k)
| (Sub x) :: xs -> eval xs (fun r -> sub r x k)
| [ ] -> k 0;;
eval [Add 20; Sub 5; Sub 7; Add 3; Sub 5] report;;

(* Continuations Can Take Multiple Arguments *)
add 3 5 (fun r -> sub r 2 report);;

add 3 5 (fun r k -> sub r 2 k);;

add 3 5 ((fun k r -> sub r 2 k) report);;

(* Composing Continations *)
(* Problem: Suppose we want to do all additions before any subtractions *)
let ordereval lst k = 
let rec aux lst ka ks =  match lst with
| (Add x) :: xs -> aux xs (fun r k -> add r x ka k) ks
| (Sub x) :: xs -> aux xs ka (fun r k -> sub r x ks k)
| [ ] -> ka 0 ks k
in
aux lst idk idk;;
(* Sample Run *)
ordereval [Add 20; Sub 5; Sub 7; Add 3; Sub 5] report;;

(*
Execution Trace

ordereval [Add 20; Sub 5; Sub 7] report
aux [Add 20; Sub 5; Sub 7] idk idk report
aux [Sub 5; Sub 7]
       (fun r1 k1 -> add 20 r1 idk k1) idk report
aux [Sub 7] (fun r1 k1 -> add r1 20 idk k1)
                   (fun r2 k2 -> sub r2 5 idk k2) report
aux [] (fun r1 k1 -> add r1 20 idk k1)
         (fun r3 k3 -> sub r3 7
                       (fun r2 k2 -> sub r2 5 idk k2) k3)
         report
aux [] (fun r1 k1 -> add r1 20 idk k1)
         (fun r3 k3 -> sub r3 7 
                        (fun r2 k2 -> sub r2 5 idk k2) k3)
         report
(* Start calling the continuations *)
(fun r1 k1 -> add r1 20 idk k1)
    0
    (fun r3 k3 -> sub r3 7 
        (fun r2 k2 -> sub r2 5 idk k2) k3)
    report

(fun r1 k1 -> add r1 20 idk k1)
    0
    (fun r3 k3 -> sub r3 7 
        (fun r2 k2 -> sub r2 5 idk k2) k3)
    report
add 0 20 idk    (* remember idk n k = k n *)
      (fun r3 k3 -> sub r3 7 
                         (fun r2 k2 -> sub r2 5 idk k2) k3)
      report

add 0 20 idk    (* remember idk n k = k n *)
      (fun r3 k3 -> sub r3 7 
                         (fun r2 k2 -> sub r2 5 idk k2) k3)
      report
idk 20
     (fun r3 k3 -> sub r3 7
                         (fun r2 k2 -> sub r2 5 idk k2) k3)
     report

idk 20
     (fun r3 k3 -> sub r3 7
                         (fun r2 k2 -> sub r2 5 idk k2) k3)
     report
(fun r3 k3 -> sub r3 7 (fun r2 k2 -> sub r2 5 idk k2) k3)
  20 report
sub 20 7 (fun r2 k2 -> sub r2 5 idk k2) report
(fun r2 k2 -> sub r2 5 idk k2) 13 report
sub 13 5 idk report
idk 8 report  --->  report 8
*)