Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang pl
- #|
- The grammar:
- <FLANG> ::= <num>
- | True
- | False
- | { + <FLANG> <FLANG> }
- | { - <FLANG> <FLANG> }
- | { * <FLANG> <FLANG> }
- | { / <FLANG> <FLANG> }
- | { > <FLANG> <FLANG> }
- | { = <FLANG> <FLANG> }
- | { if <FLANG> then <FLANG> else <FLANG> }
- | { with { <id> <FLANG> } <FLANG> }
- | <id>
- | { fun { <id> } <FLANG> }
- | { call <FLANG> <FLANG> }
- |#
- (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]
- [Bool Boolean]
- [Eq FLANG FLANG]
- [Geq FLANG FLANG]
- [If FLANG FLANG FLANG])
- (: parse-sexpr : Sexpr -> FLANG)
- ;; to convert s-expressions into FLANGs
- (define (parse-sexpr sexpr)
- (match sexpr
- [(number: n) (Num n)]
- ['True (Bool #t)]
- ['False (Bool #f)]
- [(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)])]
- [(cons 'if more)
- (match sexpr
- [(list 'if conition 'then result1 'else result2)
- (If (parse-sexpr conition) (parse-sexpr result1) (parse-sexpr result2))]
- [else (error 'parse-sexpr "bad `if' 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 '> lhs rhs) (Geq (parse-sexpr lhs) (parse-sexpr rhs))]
- [(list '= lhs rhs) (Eq (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)))
- ;; ================= Q1.2 ======================
- ;; =============================================
- #| Evaluation rules:
- eval(N,env) = N
- eval(True,env) = #t
- eval(False,env) = #f
- eval({+ E1 E2},env) = eval(E1,env) + eval(E2,env)
- eval({- E1 E2},env) = eval(E1,env) - eval(E2,env)
- eval({* E1 E2},env) = eval(E1,env) * eval(E2,env)
- eval({/ E1 E2},env) = eval(E1,env) / eval(E2,env)
- eval({> E1 E2},env) = eval(E1,env) > eval(E2,env)
- eval({= E1 E2},env) = eval(E1,env) = eval(E2,env)
- eval(x,env) = lookup(x,env)
- eval(if Ec then Ey else En)= eval(En, env) if eval(Ec) = #f
- eval(Ey, env) otherwise
- eval({with {x E1} E2},env) = eval(E2,extend(x,eval(E1,env),env))
- eval({fun {x} E},env) = <{fun {x} E}, env>
- eval({call E1 E2},env1) = eval(Ef,extend(x,eval(E2,env1),env2))
- if eval(E1,env1) = <{fun {x} Ef}, env2> = error! otherwise
- |#
- ;; Types for environments, values, and a lookup function
- (define-type ENV
- [EmptyEnv]
- [Extend Symbol VAL ENV])
- (define-type VAL
- [NumV Number]
- [FunV Symbol FLANG ENV]
- [BoolV Boolean])
- (: lookup : Symbol ENV -> VAL)
- (define (lookup name env)
- (cases env
- [(EmptyEnv) (error 'lookup "no binding for ~s" name)]
- [(Extend id val rest-env)
- (if (eq? id name) val (lookup name rest-env))]))
- (: 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->number : VAL -> Number)
- (define (NumV->number v)
- (cases v
- [(NumV n) n]
- [else (error 'arith-op "expects a number, got: ~s" v)]))
- (NumV (op (NumV->number val1) (NumV->number val2))))
- (: logic-op : (Number Number -> Boolean) VAL VAL -> VAL)
- ;; gets a Racket logic binary operator, and uses it within a NumV
- ;; wrapper to return the result inside a BoolV wrapper.
- (define (logic-op op val1 val2)
- (: NumV->number : VAL -> Number)
- (define (NumV->number v)
- (cases v
- [(NumV n) n]
- [else (error 'logic-op "expects a number, got: ~s" v)]))
- (BoolV (op (NumV->number val1) (NumV->number val2))))
- (: extract-bool-val : VAL -> Boolean)
- ;; Return #f if the wrapped value is False, and #t otherwise
- (define (extract-bool-val val)
- (cases val
- [(BoolV b) b]
- [else (error 'extract-bool-val "expects a boolean, got: ~s" val)]))
- (: eval : FLANG ENV -> VAL)
- ;; evaluates FLANG expressions by reducing them to values
- (define (eval expr env)
- (cases expr
- [(Num n) (NumV n)]
- [(Bool b) (extract-bool-val b)]
- [(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))]
- [(Eq l r) (logic-op = (eval l env) (eval r env))]
- [(Geq l r) (logic-op > (eval l env) (eval r env))]
- [(If cond do-yes do-no)
- (if (eval cond env)
- (eval do-yes env)
- (eval do-no env))]
- [(With bound-id named-expr bound-body)
- (eval bound-body
- (Extend bound-id (eval named-expr env) env))]
- [(Id name) (lookup name env)]
- [(Fun bound-id bound-body)
- (FunV bound-id bound-body env)]
- [(Call fun-expr arg-expr)
- (let ([fval (eval fun-expr env)])
- (cases fval
- [(FunV bound-id bound-body f-env)
- (eval bound-body
- (Extend bound-id (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)])))
- (test (run "{ if True then 3 else 4 }") => 3)
- (test (run "{ if {= 2 4} then 3 else 4 }") => 4)
- (test (run "{ if {= 2 4} then { call 3 5 } else 4 }") => 4)
- (test (run "{with {is-5? {fun {x} {= x 5}}} {with {foo {fun {x} {if {call is-5? {+ x 1}}then 4 else 0}}} {call foo 123}}}") => 0)
- (test (run "{with {is-5? {fun {x} {= x 5}}} {with {foo {fun {x} {if {call is-5? {+ x 1}}4 0}}} {call foo 123}}}") =error> "parse-sexpr: bad `if' syntax in (if (call is-5? (+ x 1)) 4 0)")
- (test (run "{with {x {> 3 4}} {with {foo {fun {y} {if x then True else y}}} {call foo 5}}}") => 5)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement