open Cupto;;

type 'a action = 
    Write of ('a * (unit -> 'a action))
  | Read of ('a -> 'a action)
;;

type 'a ref = 'a action prompt;;

let rec store p (x:'a) = function
    Write (y,f) -> store p y (set p f)
  | Read f -> store p x (set p (fun () -> f x))
;;

let (!) r = cupto r (fun f -> Read f);;
let (:=) r x = cupto r (fun f -> Write (x,f));;

let ref toplevel  (x : 'a) (a : 'a ref -> 'b)  =
  let return x = cupto toplevel (fun _ -> x) in
  let a p () = a p in 
    (cupto toplevel
       (fun z ->
          (set toplevel
             (fun () -> 
                let p = new_prompt() in
                  store p x (set p (fun () -> return (z (a p)))))))
    ) ();;
      
      
let backup r a =
  let q = new_prompt() in
  let return x = cupto q (fun _ -> x) in
  set q (fun () -> store r (!r) (set r (fun () -> return (a()))));;
  

let eval a =
  let toplevel = new_prompt() in
    set toplevel (fun () -> a toplevel)
;;