(* Source compiler.ml *)
open S     (* Documentation de S *)
open Ast   (* Documentation de S.Ast *)
open Code  (* Documentation de Code *)

exception Error

(*  'slot x_k [x₀; ... ; x_k ; ...]' renvoie k,
    c'est-a-dire la position de x dans l'env *)

let slot x env =
  let rec slot_rec k = function
    | [] -> raise Error
    | y::e ->
        if x=y then k
        else slot_rec (k+1) e in
  slot_rec 0 env

(***********************************************************)
(* Compilateur proprement dit, par rapport au cours        *)
(* Ma fonction 'comp e t k' renvoie C_e(t) @ k.             *)
(***********************************************************)

let rec comp e t k = match t with
(* Facile *)
| Num n -> Ldi n::k
(* Plus géneral que les transparents, qui ne traitent que l'addition *)
| Op (op,t1,t2) ->
   comp e t1 (Push::comp e t2 (IOp op::k))
(* Attention aux arguments [] pour les compilations de t2 et t3 *)
| Ifz (t1,t2,t3) ->
    comp e t1 (Test (comp e t2 [],comp e t3 [])::k)
(* Cf. transparents *)
| Let (x,t1,t2) ->
    Pushenv::comp e t1 (Extend::comp (x::e) t2 (Popenv::k))
(* Facile (une fois écrit slot) *)
| Var x -> Search (slot x e)::k
(* Cf. transparents *)
| App (t1,t2) ->
   comp e t2 (Push::comp e t1 (Apply::k))
(* Une seule instruction MkClos, fermeture bouclées systématiques *)
| Fix (f,Fun (x,t)) ->
   let c_fun = comp (x::f::e) t [] in
   Mkclosrec c_fun::k
| Fix (_,_) -> raise Error
| Fun (x,t) ->
   let c_fun = comp (x::e) t [] in
   Mkclos c_fun::k



(* Plus grand chose d'intéressant, quoique, noter
   la technique pour afficher le code compilé *)

let debug = false

let compile env t =
  let r = comp env t [] in
  if debug then begin
    List.iter
      (fun i -> Printf.eprintf "%a\n" print_instruction i)
      r ;
    flush stderr
  end ;
  r