;; ** The FLANG-BOX interpreter #lang pl (define-type FLANG [Num Number] [Add FLANG FLANG] [Sub FLANG FLANG] [Mul FLANG FLANG] [Div FLANG FLANG] [Id Symbol] [With Symbol FLANG FLANG] [WRec Symbol FLANG FLANG] [Fun Symbol FLANG] [Call FLANG FLANG]) (: parse-sexpr : Sexpr -> FLANG) ;; parses s-expressions into FLANGs (define (parse-sexpr sexpr) (match sexpr [(number: n) (Num n)] [(symbol: name) (Id name)] [(cons (or 'with 'rec) more) (match sexpr [(list 'with (list (symbol: name) named) body) (With name (parse-sexpr named) (parse-sexpr body))] [(list 'rec (list (symbol: name) named) body) (WRec name (parse-sexpr named) (parse-sexpr body))] [(cons x more) (error 'parse-sexpr "bad `~s' syntax in ~s" x sexpr)])] [(cons 'fun more) (match sexpr [(list 'fun (list (symbol: name)) body) (Fun name (parse-sexpr body))] [else (error 'parse-sexpr "bad `fun' syntax in ~s" sexpr)])] [(list '+ lhs rhs) (Add (parse-sexpr lhs) (parse-sexpr rhs))] [(list '- lhs rhs) (Sub (parse-sexpr lhs) (parse-sexpr rhs))] [(list '* lhs rhs) (Mul (parse-sexpr lhs) (parse-sexpr rhs))] [(list '/ lhs rhs) (Div (parse-sexpr lhs) (parse-sexpr rhs))] [(list 'call fun arg) (Call (parse-sexpr fun) (parse-sexpr arg))] [else (error 'parse-sexpr "bad syntax in ~s" sexpr)])) (: parse : String -> FLANG) ;; parses a string containing a FLANG expression to a FLANG AST (define (parse str) (parse-sexpr (string->sexpr str))) ;; Types for environments, values, and a lookup function (define-type ENV [EmptyEnv] [Extend Symbol (Boxof VAL) ENV]) (define-type VAL [NumV Number] [FunV Symbol FLANG ENV]) (: lookup : Symbol ENV -> (Boxof VAL)) ;; lookup a symbol in an environment, return its value or throw an ;; error if it isn't bound (define (lookup name env) (cases env [(EmptyEnv) (error 'lookup "no binding for ~s" name)] [(Extend id boxed-val rest-env) (if (eq? id name) boxed-val (lookup name rest-env))])) (: extend-rec : Symbol FLANG ENV -> ENV) ;; extend an environment with a new binding that is the result of ;; evaluating an expression in the same environment as the extended ;; result (define (extend-rec id expr rest-env) (define new-env (Extend id (box (NumV 42)) rest-env)) (set-box! (lookup id new-env) (eval expr new-env)) new-env) (: NumV->number : VAL -> Number) ;; convert a FLANG runtime numeric value to a Racket one (define (NumV->number val) (cases val [(NumV n) n] [else (error 'arith-op "expected a number, got: ~s" val)])) (: arith-op : (Number Number -> Number) VAL VAL -> VAL) ;; gets a Racket numeric binary operator, and uses it within a NumV ;; wrapper (define (arith-op op val1 val2) (NumV (op (NumV->number val1) (NumV->number val2)))) (: eval : FLANG ENV -> VAL) ;; evaluates FLANG expressions by reducing them to values (define (eval expr env) (cases expr [(Num n) (NumV n)] [(Add l r) (arith-op + (eval l env) (eval r env))] [(Sub l r) (arith-op - (eval l env) (eval r env))] [(Mul l r) (arith-op * (eval l env) (eval r env))] [(Div l r) (arith-op / (eval l env) (eval r env))] [(With bound-id named-expr bound-body) (eval bound-body (Extend bound-id (box (eval named-expr env)) env))] [(WRec bound-id named-expr bound-body) (eval bound-body (extend-rec bound-id named-expr env))] [(Id name) (unbox (lookup name env))] [(Fun bound-id bound-body) (FunV bound-id bound-body env)] [(Call fun-expr arg-expr) (define fval (eval fun-expr env)) (cases fval [(FunV bound-id bound-body f-env) (eval bound-body (Extend bound-id (box (eval arg-expr env)) f-env))] [else (error 'eval "`call' expects a function, got: ~s" fval)])])) (: run : String -> Number) ;; evaluate a FLANG program contained in a string (define (run str) (let ([result (eval (parse str) (EmptyEnv))]) (cases result [(NumV n) n] [else (error 'run "evaluation returned a non-number: ~s" result)]))) ;; tests (test (run "{call {fun {x} {+ x 1}} 4}") => 5) (test (run "{with {add3 {fun {x} {+ x 3}}} {call add3 1}}") => 4) (test (run "{with {add3 {fun {x} {+ x 3}}} {with {add1 {fun {x} {+ x 1}}} {with {x 3} {call add1 {call add3 x}}}}}") => 7) (test (run "{with {identity {fun {x} x}} {with {foo {fun {x} {+ x 1}}} {call {call identity foo} 123}}}") => 124) (test (run "{with {x 3} {with {f {fun {y} {+ x y}}} {with {x 5} {call f 4}}}}") => 7) (test (run "{call {with {x 3} {fun {y} {+ x y}}} 4}") => 7) (test (run "{with {f {with {x 3} {fun {y} {+ x y}}}} {with {x 100} {call f 4}}}") => 7) (test (run "{call {call {fun {x} {call x 1}} {fun {x} {fun {y} {+ x y}}}} 123}") => 124)