(define-type ExprC
  [numC (n : number)]
  [idC (s : symbol)]
  [plusC (l : ExprC) (r : ExprC)]
  [multC (l : ExprC) (r : ExprC)]
  [consC (l : ExprC) (r : ExprC)]
  [firstC (p : ExprC)]
  [restC (p : ExprC)]
  [empty?C (e : ExprC)]
  [letrecC (s : (listof symbol)) (rhs : (listof ExprC)) (body : ExprC)]
  [ifC (test-expr : ExprC) (then-expr :  ExprC) (else-expr : ExprC)]
  [lamC (par : symbol) (body : ExprC)]
  [appC (fun : ExprC) (arg : ExprC)]
  [emptyC])

; Représentation des valeurs
(define-type Value
  [numV (n : number)]
  [closV (arg : symbol) (body : ExprC) (env : Env)]
  [suspendV (body : ExprC) (env : Env) (mem : (boxof (optionof Value)))]
  [consV (l : Value) (r : Value)]
  [emptyV]
  [undefV])

; Représentation des liaisons
(define-type Binding
  [bind (name : symbol) (val : (boxof Value))])

; Manipulation de l'environnement
(define-type-alias Env (listof Binding))
(define mt-env empty)
(define extend-env cons)

;;;;;;;;;;;;;;;;;;;;;;
; Analyse syntaxique ;
;;;;;;;;;;;;;;;;;;;;;;

(define (parse [s : s-expression]) : ExprC
  (cond
    [(s-exp-match? `empty s) (emptyC)]
    [(s-exp-match? `NUMBER s) (numC (s-exp->number s))]
    [(s-exp-match? `SYMBOL s) (idC (s-exp->symbol s))]
    [(s-exp-match? '{empty? ANY} s)
     (let ([sl (s-exp->list s)])
       (empty?C (parse (second sl))))]
    [(s-exp-match? '{list ANY ...} s)
     (let ([sl (s-exp->list s)])
       (let ([arg (rest sl)])
         (if (empty? arg)
             (emptyC)
             (foldr consC (emptyC) (map parse arg)))))]
    [(s-exp-match? '{cons ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (consC (parse (second sl)) (parse (third sl))))]
    [(s-exp-match? '{first ANY} s)
     (let ([sl (s-exp->list s)])
       (firstC (parse (second sl))))]
    [(s-exp-match? '{rest ANY} s)
     (let ([sl (s-exp->list s)])
       (restC (parse (second sl))))]
    [(s-exp-match? '{+ ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (plusC (parse (second sl)) (parse (third sl))))]
    [(s-exp-match? '{* ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (multC (parse (second sl)) (parse (third sl))))]
    [(s-exp-match? '{- ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (plusC (parse (second sl)) (multC (numC -1) (parse (third sl)))))]
    [(s-exp-match? '{let {[SYMBOL ANY]} ANY} s)
     (let ([sl (s-exp->list s)])
       (let ([subst (s-exp->list (first (s-exp->list (second sl))))])
         (appC (lamC (s-exp->symbol (first subst)) (parse (third sl))) (parse (second subst)))))]
    [(s-exp-match? '{letrec {[SYMBOL ANY] [SYMBOL ANY] ...} ANY} s)
     (let ([sl (s-exp->list s)])
       (let ([subst (s-exp->list (second sl))])
         (letrecC (map s-exp->symbol (map (lambda (x) (first (s-exp->list x))) subst)) (map parse (map (lambda (x) (second (s-exp->list x))) subst)) (parse (third sl)))))]
    [(s-exp-match? '{if ANY ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (ifC (parse (second sl)) (parse (third sl)) (parse (fourth sl))))]
    [(s-exp-match? '{lambda {SYMBOL} ANY} s)
     (let ([sl (s-exp->list s)])
       (let ([sll (s-exp->list (second sl))])
         (lamC (s-exp->symbol (first sll)) (parse (third sl)))))]
    [(s-exp-match? '{ANY ANY} s)
     (let ([sl (s-exp->list s)])
       (appC (parse (first sl)) (parse (second sl))))]
    [else (error 'parse "invalid input")]))