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

exception Error

(*  'slot xk [x0; ... ; xk ; ...]' 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 
Ce(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::et2 (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::et [] in
   Mkclosrec c_fun::k
Fix (_,_) -> raise Error
Fun (x,t) ->
   let c_fun = comp (x::et [] 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

This document was translated from LATEX by HEVEA.