(* state-passing style -> monadic-style programming
   great when you're in a no-state world, like Haskell or 
     client-server computing

   The interim steps below are admittedly tricky, but where we start 
   is straightforward and where we end up is elegant and easy-to-use.
 *)

(* an interface for a functional heap that returns an answer and a new heap *)
(* written by a guru who understands this will be a convenient interface *)
let empty_heap = []
let lookup str heap = ((try List.assoc str heap with _ -> 0), heap)
let update str v heap = ((), (str,v)::heap)
(* ... could have more operations ... *)

(* increment z, if original z is positive set x to y, else set x to 37 *)
(* written in a stylized way to make sure things are sequenced just right,
   manually shadowing each heap with the next one *)
let example1 heap =
  let x1,heap = lookup "z" heap in
  let x2,heap = update "z" (x1+1) heap in
  let x3,heap = if x1 > 0 then lookup "y" heap else (37,heap) in
  update "x" x3 heap

(* two lines below written by guru *)
(* f1: function from heap to result and heap
   f2: function from arg and heap to result and heap
   result: function from heap to sequenced result and heap
*)
let bind f1 f2 = (fun heap -> let x,heap' = f1 heap in f2 x heap')

(* in monad-land called "return", but this is confusing *)
let ret e = (fun heap -> (e,heap))
    
(* naively using the helper functions looks like a mess, but bear with me *)
let example2 heap =
  (bind (fun heap -> lookup "z" heap)
        (fun x1 -> 
	 bind (fun heap -> update "z" (x1+1) heap)
              (fun x2 -> 
		bind (fun heap -> if x1 > 0 
		                   then lookup "y" heap 
		                   else ret 37 heap)
		     (fun x3 ->
		       (fun heap -> update "x" x3 heap)))))
    heap

(* thanks to fun x -> e1 ... en x being e1 ... en, we can now "hide"
  _every_ explicit use of heap-passing (just like in imperative programming)
 *)
let example3 =
   bind (lookup "z")
        (fun x1 -> 
	 bind (update "z" (x1+1))
              (fun x2 -> 
		 bind (if x1 > 0 
		       then lookup "y" 
		       else ret 37)
		   (fun x3 ->
		     (update "x" x3))))
    
(* and now let's not change anything except spacing and indentation.
   The result looks like imperative programming in "Hebrew":
     * bind starts each line 
        (vs. semicolon at end of line)
     * variable holding result of operation at end 
        (vs. declaration at beginning)
     * the ret part is mandatory though -- "lifting into the heap-passing"
 *)
let example4 =
   bind (lookup "z")        (fun x1 -> 
   bind (update "z" (x1+1)) (fun x2 -> 
   bind (if x1 > 0 
         then lookup "y" 
	 else ret 37)       (fun x3 ->
	(update "x" x3))))

(* syntactic sugar (not in OCaml; see Haskell) 
    x <- e1 ; e2 ==> bind e1 (fun x -> e2)
   now programmers think they're in an "imperative" setting

let example5 =
   x1 <- lookup "z" ;
   x2 <- update "z" (x1+1) ;
   x3 <- if x1 > 0 then lookup "y" else ret 37 ;
   update "x" x3

   actually also have e1; e2 ==> bind e1 (fun _ -> e2), letting us write

let example6 =
   x1 <- lookup "z" ;
   update "z" (x1+1) ;
   x3 <- if x1 > 0 then lookup "y" else ret 37 ;
   update "x" x3

*)

let pi i = print_string (string_of_int i); print_newline ()
let test f = pi (fst (lookup "x" (snd (f empty_heap))))

let _ = test example1
let _ = test example2
let _ = test example3
let _ = test example4