;; ** The Flang interpreter #lang pl #| The grammar: ::= | { + } | { - } | { * } | { / } | { with { } } | | { fun { } } | { call } Evaluation rules: subst: N[v/x] = N {+ E1 E2}[v/x] = {+ E1[v/x] E2[v/x]} {- E1 E2}[v/x] = {- E1[v/x] E2[v/x]} {* E1 E2}[v/x] = {* E1[v/x] E2[v/x]} {/ E1 E2}[v/x] = {/ E1[v/x] E2[v/x]} y[v/x] = y x[v/x] = v {with {y E1} E2}[v/x] = {with {y E1[v/x]} E2[v/x]} ; if y =/= x {with {x E1} E2}[v/x] = {with {x E1[v/x]} E2} {call E1 E2}[v/x] = {call E1[v/x] E2[v/x]} {fun {y} E}[v/x] = {fun {y} E[v/x]} ; if y =/= x {fun {x} E}[v/x] = {fun {x} E} eval: eval(N) = N eval({+ E1 E2}) = eval(E1) + eval(E2) \ if both E1 and E2 eval({- E1 E2}) = eval(E1) - eval(E2) \ evaluate to numbers eval({* E1 E2}) = eval(E1) * eval(E2) / otherwise error! eval({/ E1 E2}) = eval(E1) / eval(E2) / eval(id) = error! eval({with {x E1} E2}) = eval(E2[eval(E1)/x]) eval(FUN) = FUN ; assuming FUN is a function expression eval({call E1 E2}) = eval(B[eval(E2)/x]) if eval(E1)={fun {x} B}, otherwise error! |# (define-type FLANG [Num Number] [Add FLANG FLANG] [Sub FLANG FLANG] [Mul FLANG FLANG] [Div FLANG FLANG] [Id Symbol] [With 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 'with more) (match sexpr [(list 'with (list (symbol: name) named) body) (With name (parse-sexpr named) (parse-sexpr body))] [else (error 'parse-sexpr "bad `with' syntax in ~s" 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))) (: subst : FLANG Symbol FLANG -> FLANG) ;; substitutes the second argument with the third argument in the ;; first argument, as per the rules of substitution; the resulting ;; expression contains no free instances of the second argument (define (subst expr from to) (cases expr [(Num n) expr] [(Add l r) (Add (subst l from to) (subst r from to))] [(Sub l r) (Sub (subst l from to) (subst r from to))] [(Mul l r) (Mul (subst l from to) (subst r from to))] [(Div l r) (Div (subst l from to) (subst r from to))] [(Id name) (if (eq? name from) to expr)] [(With bound-id named-expr bound-body) (With bound-id (subst named-expr from to) (if (eq? bound-id from) bound-body (subst bound-body from to)))] [(Call l r) (Call (subst l from to) (subst r from to))] [(Fun bound-id bound-body) (if (eq? bound-id from) expr (Fun bound-id (subst bound-body from to)))])) (: Num->number : FLANG -> Number) ;; convert a FLANG number to a Racket one (define (Num->number e) (cases e [(Num n) n] [else (error 'arith-op "expected a number, got: ~s" e)])) (: arith-op : (Number Number -> Number) FLANG FLANG -> FLANG) ;; gets a Racket numeric binary operator, and uses it within a FLANG ;; `Num' wrapper (define (arith-op op val1 val2) (Num (op (Num->number val1) (Num->number val2)))) (: eval : FLANG -> FLANG) ;; evaluates FLANG expressions by reducing them to *expressions* but ;; only expressions that stand for values: only `Fun`s and `Num`s (define (eval expr) (cases expr [(Num n) expr] [(Add l r) (arith-op + (eval l) (eval r))] [(Sub l r) (arith-op - (eval l) (eval r))] [(Mul l r) (arith-op * (eval l) (eval r))] [(Div l r) (arith-op / (eval l) (eval r))] [(With bound-id named-expr bound-body) (eval (subst bound-body bound-id (eval named-expr)))] [(Id name) (error 'eval "free identifier: ~s" name)] [(Fun bound-id bound-body) expr] [(Call fun-expr arg-expr) (define fval (eval fun-expr)) (cases fval [(Fun bound-id bound-body) (eval (subst bound-body bound-id (eval arg-expr)))] [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))]) (cases result [(Num 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 {add {fun {x} {fun {y} {+ x y}}}} {call {call add 8} 9}}") => 17) (test (run "{with {identity {fun {x} x}} {with {foo {fun {x} {+ x 1}}} {call {call identity foo} 123}}}") => 124) (test (run "{call {call {fun {x} {call x 1}} {fun {x} {fun {y} {+ x y}}}} 123}") => 124)