jacob/cs5
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More.

Browse Source
This commit is contained in:
jacob
2026-01-10 19:48:55 -05:00
parent a465917f36
commit 6f39eddcc6
2 changed files with 10 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files
08-barf/main.rkt
+10 -5
View File
@@ -272,9 +272,13 @@ CFG for the BARF language:
(if (string=? name fname) (f) (#f))])))])) (if (string=? name fname) (f) (#f))])))]))
(if (not foundfun) (error 'findfun "Function not found.") foundfun)) (if (not foundfun) (error 'findfun "Function not found.") foundfun))
(: eval : PROGRAM -> Primitive) (: eval : PROGRAM BARF -> Primitive)
;; evaluates PROGRAM expressions by reducing them to numbers ; Evaluates a BARF in the context of a PROGRAM.
(define (eval expr) (define (eval prog expr)
(let ([eval (lambda ([e : BARF]) (eval prog e))]
[eval-number (eval prog e)]
[eval-boolean (eval prog e)])
(cases expr (cases expr
[(Num n) n] [(Num n) n]
[(Bool p) p] [(Bool p) p]
@@ -298,9 +302,10 @@ CFG for the BARF language:
(error 'eval "Can't create parameter binding to reserved name '~s'." par) (error 'eval "Can't create parameter binding to reserved name '~s'." par)
(list (Par par) (Body body)))] (list (Par par) (Body body)))]
[(Call f arg) (eval-call (value->barf (eval f)) arg)] [(Call f arg) (eval-call (value->barf (eval f)) arg)]
[(Id name) (error 'eval "free identifier: ~s" name)])) [(Id name) (error 'eval "free identifier: ~s" name)])))
(: run : String -> Primitive) (: run : String -> Primitive)
;; evaluate an BARF program contained in a string ;; evaluate an BARF program contained in a string
(define (run str) (define (run str)
(eval (parse str))) (eval (parse str) (Call2 'main (Num 4))))
10-tidbit/main.rkt
-152
View File
@@ -1,152 +0,0 @@
#lang pl
#|
The grammar:
<TIDBIT> ::= <num>
| { + <TIDBIT> <TIDBIT> }
| { - <TIDBIT> <TIDBIT> }
| { * <TIDBIT> <TIDBIT> }
| { / <TIDBIT> <TIDBIT> }
| { with { <id> <TIDBIT> } <TIDBIT> }
| <id>
| { fun { <id> } <TIDBIT> }
| { call <TIDBIT> <TIDBIT> }
|#
(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)