diff --git a/08-barf/9BARF.pdf b/08-barf/9BARF.pdf new file mode 100644 index 0000000..9e07f5c Binary files /dev/null and b/08-barf/9BARF.pdf differ diff --git a/08-barf/main.rkt b/08-barf/main.rkt index d66b708..022091e 100644 --- a/08-barf/main.rkt +++ b/08-barf/main.rkt @@ -272,8 +272,8 @@ CFG for the BARF language: (if (string=? name fname) (f) (#f))])))])) (if (not foundfun) (error 'findfun "Function not found.") foundfun)) -(: eval : BARF -> Primitive) -;; evaluates BARF expressions by reducing them to numbers +(: eval : PROGRAM -> Primitive) +;; evaluates PROGRAM expressions by reducing them to numbers (define (eval expr) (cases expr [(Num n) n] @@ -304,88 +304,3 @@ CFG for the BARF language: ;; evaluate an BARF program contained in a string (define (run str) (eval (parse str))) - -; As we'ren't writing a lazy language, we need to use the Z combinator to delay evaluation of f (otherwise it'd never terminate). This factorial function also isn't tail recursive cause it's hard enough for me to understand already ;-;. -; Z = λf.(λx.(f λv.((x x) v)))(λx.(f λv.((x x) v))) -; factorial = (Y (λself.λn.if (<= n 1) 1 (* n (self (- n 1))))) - -(test (run " -{with Z as {lambda f { - {lambda x {f of {lambda v {{x of x} of v}}}} - of - {lambda x {f of {lambda v {{x of x} of v}}}} -}} - -{with factorial as {Z of - {lambda self {lambda n - {if {n is less than or equal to 1} then 1 else {* n {self of {- n 1}}}} - } -}} - -{{{factorial of 4} is 24} and - {{factorial of 5} is 120}}}}") => #t) - -(test (run "{{lambda f {f of 1}} of {lambda x {+ x 1}}}") => 2) -(test (run "{{lambda x {+ x 1}} of 2}") => 3) -(test (run "{{lambda + {+ + +}} of 2}") =error> "Can't create parameter binding to reserved name '+'.") -(test (run "{1 of 1}") =error> "eval-call: Expected lambda expression to call, instead got: (Num 1).") -(test (run "{with {x 2} {x of 1}}") =error> "eval-call: Expected lambda expression to call, instead got: (Num 2).") - -(test (run "{and T T}") => #t) -(test (run "{and F aaaaaaaaaa}") => #f) -(test (run "{or T aaaaaaaaaa}") => #T) -(test (run "{or F T}") => #T) -(test (run "{or T T}") => #T) -(test (run "{not T}") => #F) -(test (run "{not F}") => #T) -(test (run "{with {p1 {< 1 2}} {with {p2 {< 3 4}} {and p1 p2}}}") => #T) - -(test (run "{if T 1 2}") => 1) -(test (run "{if T then 1 else 2}") => 1) - -(test (run "{with {T 2} {+ T 1}}") =error> "Can't create binding to reserved name 'T'.") -(test (run "{with {+ 2} {+ + 1}}") =error> "Can't create binding to reserved name '+'.") - -(test (run "{< 1 2}") => #t) -(test (run "{< 2 2}") => #f) -(test (run "{< 2 1}") => #f) -(test (run "{1 is 2}") => #f) -(test (run "{= 1 2}") => #f) -(test (run "{= 2 2}") => #t) -(test (run "{2 is 2}") => #t) -(test (run "{<= 1 2}") => #t) -(test (run "{<= 2 2}") => #t) -(test (run "{<= 2 1}") => #f) - -(test (run "{+}") => 0) -(test (run "{+ 12}") => 12) -(test (run "{+ 1 2 3}") => 6) - -(test (run "{*}") => 1) -(test (run "{* 12}") => 12) -(test (run "{* 2 3 5}") => 30) - -(test (run "{-}") =error> "parse-sexpr: bad syntax in (-)") -(test (run "{- 1}") => -1) -(test (run "{- 3 2 1}") => 0) -(test (run "{- 1 2 3}") => -4) - -(test (run "{/}") =error> "parse-sexpr: bad syntax in (/)") -(test (run "{/ 2}") => 1/2) -(test (run "{/ 3 2 1}") => 3/2) -(test (run "{/ 1 2 3}") => 1/6) - -(test (run "{+ x 1}") =error> "eval: free identifier: x") - -;; tests (for simple expressions) -(test (run "5") => 5) -(test (run "{+ 5 5}") => 10) -(test (run "{with {x {+ 5 5}} {+ x x}}") => 20) -(test (run "{with {x 5} {+ x x}}") => 10) -(test (run "{with {x {+ 5 5}} {with {y {- x 3}} {+ y y}}}") => 14) -(test (run "{with {x 5} {with {y {- x 3}} {+ y y}}}") => 4) -(test (run "{with {x 5} {+ x {with {x 3} 10}}}") => 15) -(test (run "{with {x 5} {+ x {with {x 3} x}}}") => 8) -(test (run "{with {x 5} {+ x {with {y 3} x}}}") => 10) -(test (run "{with {x 5} {with {y x} y}}") => 5) -(test (run "{with {x 5} {with {x x} x}}") => 5) diff --git a/10-tidbit/main.rkt b/10-tidbit/main.rkt new file mode 100644 index 0000000..cc966e5 --- /dev/null +++ b/10-tidbit/main.rkt @@ -0,0 +1,152 @@ +#lang pl + +#| +The grammar: + ::= + | { + } + | { - } + | { * } + | { / } + | { with { } } + | + | { fun { } } + | { call } +|# + +(define-type TIDBIT + [Num Number] + [Add TIDBIT TIDBIT] + [Sub TIDBIT TIDBIT] + [Mul TIDBIT TIDBIT] + [Div TIDBIT TIDBIT] + [Id Symbol] + [With Symbol TIDBIT TIDBIT] + [Fun Symbol TIDBIT] + [Call TIDBIT TIDBIT]) + +(: parse-sexpr : Sexpr -> TIDBIT) +;; parses s-expressions into TIDBITs +(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 -> TIDBIT) +;; parses a string containing a TIDBIT expression to a TIDBIT AST +(define (parse str) + (parse-sexpr (string->sexpr str))) + +;; Types for environments, values, and a lookup function + +(define-type ENV + [EmptyEnv] + [Extend Symbol VAL ENV]) + +(define-type VAL + [NumV Number] + [FunV Symbol TIDBIT ENV]) + +(: lookup : Symbol ENV -> 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 val rest-env) + (if (eq? id name) val (lookup name rest-env))])) + +(: NumV->number : VAL -> Number) +;; convert a TIDBIT 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 : TIDBIT ENV -> VAL) +;; evaluates TIDBIT 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 (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 TIDBIT 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) \ No newline at end of file