(* Exercice de programmation 4.1: n-uplets et types concrets *)

(* On repart de l'évaluateur "grands pas" du chapitre 1 *)

(* Pour simplifier l'implémentation, on ajoute dans la syntaxe abstraite
   des cas spéciaux pour les projections, l'application de constructeurs,
   et le filtrage.  C'est plus simple que d'en faire des opérateurs. *)

type expression =
    Var of string
  | Const of int
  | Op of string
  | Proj of int                         (* n-ième projection *)
  | Fun of string * expression
  | App of expression * expression
  | Let of string * expression * expression
  | Nuplet of expression list           (* n-uplet *)
  | Constr of string * expression       (* nom du constructeur + argument *)
  | Filtrage of expression * (string * string * expression) list
      (* expression filtrée et liste de cas.  Chaque cas du filtrage est
         (nom du constructeur, nom de la variable liée, expression associée) *)

(* Substitution d'une variable x par une expression b dans une expression a *)

let rec subst a x b =
  match a with
    Var v -> if v = x then b else a
  | Const n -> a
  | Op o -> a
  | Proj n -> a
  | Fun(v, a1) -> if v = x then a else Fun(v, subst a1 x b)
  | App(a1, a2) -> App(subst a1 x b, subst a2 x b)
  | Let(v, a1, a2) -> Let(v, subst a1 x b, if v = x then a2 else subst a2 x b)
  | Nuplet al -> Nuplet(List.map (fun a -> subst a x b) al)
  | Constr(cstr, a) -> Constr(cstr, subst a x b)
  | Filtrage(a, casl) ->
      let subst_cas (cstr, v, a) = (cstr, v, if v = x then a else subst a x b)
      in Filtrage(subst a x b, List.map subst_cas casl)

(* Renvoie le n-ième élément d'une liste *)

exception Mauvaise_projection

let rec nième n vl =
  match vl with
    [] -> raise Mauvaise_projection
  | t :: r ->
      if n <= 1 then t else nième (n-1) r

(* Trouve le cas associé à un constructeur dans une liste de filtrage *)

exception Échec_filtrage

let rec trouve_cas cstr liste_de_cas =
  match liste_de_cas with
    [] -> raise Échec_filtrage
  | (cstr', v, action) :: reste ->
      if cstr = cstr' then (v, action) else trouve_cas cstr reste

(* La fonction partielle d'évaluation *)

let rec valeur a =
  match a with
    Const c -> Const c
  | Op o -> Op o
  | Fun(x, a) -> Fun(x, a)
  | Proj n -> Proj n
  | App(a1, a2) ->
      begin match valeur a1 with
        Fun(x, a) -> valeur (subst a x (valeur a2))
      | Op "+" -> let (Nuplet[Const n1; Const n2]) = valeur a2 in Const(n1 + n2)
      | Proj n -> let (Nuplet vl) = valeur a2 in nième n vl
      end
  | Let(x, a1, a2) -> valeur (subst a2 x (valeur a1))
  | Nuplet al -> Nuplet(List.map valeur al)
  | Constr(cstr, a1) -> Constr(cstr, valeur a1)
  | Filtrage(a1, casl) ->
      begin match valeur a1 with
        Constr(cstr, arg) ->
          let (v, action) = trouve_cas cstr casl in valeur (subst action v arg)
      end