module Tcore2pnf :
sig 
  val translate : Tcore.exp -> Pnf.exp
end = 
struct
  open Pnf

  exception Non_trivial

  let rec translate (e:Tcore.exp) : Pnf.exp =
    match e with
      Tcore.App(Tcore.Abs(v,t,b),a) ->
	Let(v,t,translate a,translate b)
    | Tcore.App(e1,e2) -> 
	trivialize e1 (fun tre1 -> 
	  trivialize e2 (fun tre2 -> 
	    App(tre1,tre2)))
    | Tcore.Fix(fs,b) ->  
	Fix(List.map (fun (f,e,t) -> (f,translate_triv e,t)) fs,
	    translate b) 
    | Tcore.Record r -> 
	trivialize_row r (fun trr -> Record trr)
    | Tcore.Select(l,e) ->
	trivialize e (fun tre ->
	  Select(l,tre))
    | Tcore.Variant(l,e) ->
	trivialize e (fun tre ->
	  Variant(l,tre))
    | Tcore.Switch(e,r) -> 
	trivialize e (fun tre ->
	  trivialize_row r (fun trr ->
	    Switch(tre,trr)))
    | _ -> Triv(translate_triv e)
  
  and translate_triv (e:Tcore.exp) : Pnf.trexp =
    match e with
      Tcore.Var v -> Var v
    | Tcore.Int i -> Int i
    | Tcore.Abs(v,t,e) -> Abs(v,t,translate e)
    | _ -> raise Non_trivial

  and trivialize (e:Tcore.exp)  
                 (k:Pnf.trexp -> Pnf.exp) : Pnf.exp =
    try 
      k(translate_triv e)
    with Non_trivial ->
      let x = Tcore.gensym() in
      Let(x,Tcore.IntT (*!!!!*),translate e,k(Var x))

  and trivialize_row lel (k:Pnf.row -> Pnf.exp) : Pnf.exp =
    let rec f lel xl =
      match lel with
	(l,e)::ler ->
	  trivialize e 
	    (fun tre -> 
	      f ler ((l,tre)::xl))
      |	[] -> k (List.rev xl) in
    f lel []

end