#lang plait
(define-type FLANG
[Num (val : Number)]
[Add (l : FLANG) (r : FLANG)]
[Sub (l : FLANG) (r : FLANG)]
[Mul (l : FLANG) (r : FLANG)]
[Div (l : FLANG) (r : FLANG)]
[Id (name : Symbol)]
[Let1 (id : Symbol) (named-expr : FLANG) (bound-body : FLANG)]
[Lam (param : Symbol) (body : FLANG)]
[Call (fun : FLANG) (val : FLANG)]) ; first type!
;; a type for substitution caches:
(define-type Binding
[bind (name : Symbol) (val : FLANG)])
(define-type-alias SubstCache (Listof Binding))
(define empty-subst empty)
;
(define (extend id expr sc)
(cons (bind id expr) sc))
;
;; gets a Racket numeric binary operator, and uses it within a FLANG
;; `Num' wrapper (note H.O type)
(define (arith-op op expr1 expr2)
(local
[(define (Num->number e)
(type-case FLANG e
[(Num n) n]
[else (error 'arith-op "expects a number")]))]
(Num (op (Num->number expr1)
(Num->number expr2)))))
(define (lookup name sc)
(let ([first-name (λ () (bind-name (first sc)))]
[first-val (λ () (bind-val (first sc)))])
(cond
[(empty? sc) (error 'lookup (string-append "missing binding: " (to-string name)))]
[(eq? name (first-name)) (first-val)]
[else (lookup name (rest sc))])))
[(Call fun-expr arg-expr)
(let ([fval (interp fun-expr sc)]
[aval (interp arg-expr sc)])
(type-case FLANG fval
[(Lam bound-id bound-body)
(interp bound-body (extend bound-id aval sc))]
[else (error 'eval
(string-append "non-function: "
(to-string fval)))]))]