;; Husky Interpreter ;; An ATOM is one of: ;; -- Number ;; -- Boolean ;; -- String ;; An SExp is one of: ;; - Atom ;; - LOS ;; An LOS (listof SExp) is one of: ;; - empty ;; - (cons SExp LOS) ;; --------------------------------------------------------- ;;; Syntax -- the grammar of Husky, as ISL sexpressions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; A HExp (Husky Expression) is one of: ;;; - Number ; ;;; - Var ; ;;; - (list 'const SExp) ; (CONST ) ;;; - (list 'fun (list Var ...) HExp) ; (FUN ( ...) ) ;;; - (list 'if HExp HExp HExp) ; (IF ) ;;; - (list HExp HExp ...) ; ( ...) ;;; ;;; A Var is a Symbol. ;;; Two example Husky programs: ;;; ((fun (abs) (list (abs (- 5 7)) ; Should produce ;;; (abs (- 7 5)))) ; '(2 2) ;;; (fun (x) (if (< x 0) (- x) x))) ;;; ;;; ((fun (x) (if (< x 0) (const (x is negative)) ; Should produce ;;; (if (= x 0) (const (x is zero)) ; '(x is negative) ;;; (const (x is positive))))) ;;; (* 3 (- 7 10))) ;; A Value is one of: ;; - SExp ;; - Procedure (define-struct closure (params body env)) (define-struct primop (handler)) ;; A Procedure is one of: ;; - (make-closure [Listof Var] HExp Env) ;; - (make-primop [[Listof Value] -> Value]) (define-struct binding (var val)) ;; Env = [Listof (make-binding Var Value)] ;; lookup : Env Var -> Value ;; Lookup variable's value in the environment ;; Envs should be scanned left to right, so binding for var ;; at front shadows earlier bindings (on the right) (define (lookup env var) (cond [(empty? env) (error 'lookup "Var not found: " var)] [else (local ((define b (first env))) (if (symbol=? (binding-var b) var) (binding-val b) (lookup (rest env) var)))])) (define test-env (list (make-binding 'x 5) (make-binding 'y 2) (make-binding 'x 7))) (check-expect (lookup test-env 'x) 5) (check-expect (lookup test-env 'y) 2) (check-error (lookup test-env 'z) "lookup: Var not found: 'z") ;; keyword=? : Symbol (Symbol or HExp) -> Boolean (define (keyword=? kwd s) (and (symbol? s) (symbol=? kwd s))) ;; eval : HExp Env -> Value ;; Evaluate exp in given env (define (eval exp env) (cond [(number? exp) exp] [(symbol? exp) (lookup env exp)] [else (local ((define e1 (first exp))) (cond [(keyword=? 'const e1) ;; (const sexp) (second exp)] [(keyword=? 'fun e1) (make-closure (second exp) ;; params (third exp) ;; body env)] ;; env [(keyword=? 'if e1) (local ((define tst (second exp)) (define thn (third exp)) (define els (fourth exp))) (if (eval tst env) (eval thn env) (eval els env)))] [else (app (eval e1 env) ;; eval the func (map (lambda (a) (eval a env)) (rest exp)))]))])) ;; app : Value [Listof Value] -> Value ;; apply the procedure to its args (define (app f args) (cond [(closure? f) (eval (closure-body f) (append (map make-binding (closure-params f) args) (closure-env f)))] [(primop? f) ((primop-handler f) args)] [else (error 'app "Attempting to apply a non-procedure: " f)])) ;; run : HExp -> Value ;; run the Husky exp in the top-level environ (define (run e) (eval e top-env)) (check-expect (run '1) 1) (check-expect (run '(plus2 5)) 7) (check-expect (run '(plus2 5)) 7) (check-expect (run '((fun (x) (minus1 (plus2 x))) 5)) 6) (check-expect (run '((fun (f) (f (f 0))) plus2)) 4) (check-expect (run '(if ((fun (n) (= 0 n)) 0) 5 0)) 5) (check-expect (run '((fun (x) (cons 1 (cons x emty))) 4)) (list 1 4)) ;--------------------------------------------------------- (define (racket->husky-primop f) (make-primop (lambda (args) (apply f args)))) (define top-env (list (make-binding '+ (racket->husky-primop +)) (make-binding '- (racket->husky-primop -)) (make-binding '* (racket->husky-primop *)) (make-binding 'plus1 (racket->husky-primop add1)) (make-binding 'plus2 (racket->husky-primop (lambda (n) (+ n 2)))) (make-binding 'minus1 (racket->husky-primop sub1)) (make-binding 'furst (racket->husky-primop first)) (make-binding 'rast (racket->husky-primop rest)) (make-binding 'emty empty) (make-binding 'cons (racket->husky-primop cons)) (make-binding '= (racket->husky-primop =)) ; (make-binding 'true true) ; (make-binding 'false false) (make-binding 'not (racket->husky-primop not)) (make-binding 'pos? (racket->husky-primop positive?)))) ;;---------------------------------------------------------------- ;; Y combinator ;; Y combinator, used to implement length (((lambda (f) ((lambda (g) (lambda (x) ((f (g g)) x))) (lambda (g) (lambda (x) ((f (g g)) x))))) (lambda (fact) (lambda (n) (cond [(zero? n) 1] [else (* n (fact (- n 1)))])))) 5)