(* template.ml
 * Copyright (C) 2002  Ørjan Johansen.
 * See the file COPYING.LESSER for license terms (GLPL version 2.1 or
 * later). *)

let current_ch = ref None
;;

type cont = func -> unit
and expr = cont -> unit
and func = expr -> cont -> unit

and prim = func -> cont -> unit

let rec apply:(expr->expr->expr) = fun e1 e2 c -> e1 (fun f1 -> f1 e2 c)

and prim2func:(prim->func) = fun p1 e2 c -> e2 (fun f2 -> p1 f2 c)
and func2expr:(func->expr) = fun f c -> c f
and prim2expr p = func2expr (prim2func p)
;;

let k = prim2expr
  (fun f1 -> prim2expr
    (fun f2 -> func2expr f1))
and s = prim2expr
  (fun f1 -> prim2expr
    (fun f2 -> prim2expr
      (fun f3 c ->
        let e3 = func2expr f3 in
        let eb = fun c2 -> f2 e3 c2 in
        f1 e3 (fun fa -> fa eb c))))
and i = prim2expr func2expr
and v = func2expr
  (let rec vp e c = e (fun f -> c vp)
  in vp)
and c = prim2expr
  (fun f1 c1 -> f1 (func2expr (fun e2 c2 -> e2 c1)) c1)
and d = func2expr
  (fun e1 c1 -> c1
    (prim2func
      (fun f2 c2 -> e1
        (fun f -> f (func2expr f2) c2))))
and dot ch = prim2expr
  (fun f -> print_char ch; func2expr f)
and e = prim2expr (fun f c -> ())
;;

let at = prim2expr
  (fun f c ->
    let (ch,e2) =
      try (Some (input_char stdin),i)
      with End_of_file -> (None,v) in
    current_ch := ch;
    f e2 c)
and ques ch1 = prim2expr
  (fun f c -> f
    (match !current_ch with
      None -> v
    | Some ch2 -> if (ch1=ch2) then i else v)
    c)
and pipe = prim2expr
  (fun f c -> f
    (match !current_ch with
      None -> v
    | Some ch -> dot ch)
    c)
;;