From ef2f5f64dcf55d6708305847b04b7c17ff006c0b Mon Sep 17 00:00:00 2001 From: Jacob Date: Mon, 12 Jan 2026 23:52:50 -0500 Subject: [PATCH] More. --- 09-tidbit/main.rkt | 167 +++++++++++++++++++++++++++++++++++++++++++ 09-tidbit/tidbit.rkt | 152 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 319 insertions(+) create mode 100644 09-tidbit/main.rkt create mode 100644 09-tidbit/tidbit.rkt diff --git a/09-tidbit/main.rkt b/09-tidbit/main.rkt new file mode 100644 index 0000000..41965f3 --- /dev/null +++ b/09-tidbit/main.rkt @@ -0,0 +1,167 @@ +#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]) + +(define-type Idx = Integer) + +(define-type CORE + [CNum Number] + [CAdd CORE CORE] + [CSub CORE CORE] + [CMul CORE CORE] + [CDiv CORE CORE] + [CIdx Idx] + [CWith CORE CORE] + [CFun CORE] + [CCall CORE CORE]) + +(define-type BINDING-DEPTH = (Symbol -> Number)) + +(: empty-depth : BINDING-DEPTH) +(define (empty-depth s) (error 'empty-depth "empty depth")) + +(: binding-encountered : BINDING-DEPTH Symbol -> BINDING-DEPTH) +(define (binding-encountered bd id)) + +(: parse-sexpr : Sexpr -> TIDBIT) +; Parses Sexprs 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))] + [(list fun 'of 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 VAL + [NumV Number] + [FunV CORE ENV]) + +(define-type ENV = (Listof VAL)) + + +(: 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 : CORE ENV -> VAL) +;; evaluates CORE expressions by reducing them to values +(define (eval expr env) + (cases expr + [(CNum n) (NumV n)] + [(CAdd l r) (arith-op + (eval l env) (eval r env))] + [(CSub l r) (arith-op - (eval l env) (eval r env))] + [(CMul l r) (arith-op * (eval l env) (eval r env))] + [(CDiv l r) (arith-op / (eval l env) (eval r env))] + [(CWith bound-val bound-body) + (eval bound-body (cons (eval bound-val env) env))] + [(CIdx n) (list-ref env n)] + [(CFun body) + (FunV body env)] + [(CCall fun-expr arg-expr) + (let ([fval (eval fun-expr env)]) + (cases fval + [(FunV body f-env) + (eval body (cons (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)]))) + +(test (run "{with fh dhd dhdh lja}") =error> "parse-sexpr: bad `with' syntax in (with fh dhd dhdh lja)") +(test (run "{fun fh dhd dhdh lja}") =error> "parse-sexpr: bad `fun' syntax in (fun fh dhd dhdh lja)") +(test (run "{}") =error> "parse-sexpr: bad syntax in ()") +(test (run "{asdf of 2}") =error> "lookup: no binding for asdf") +(test (run "{+ 1 {fun {x} x}}") =error> "arith-op: expected a number, got: (FunV x (Id x) (EmptyEnv))") +(test (run "{1 of 1}") =error> "eval: `call' expects a function, got: (NumV 1)") +(test (run "{fun {x} x}") =error> "run: evaluation returned a non-number: (FunV x (Id x) (EmptyEnv))") + +(test (run "{{fun {x} {+ x 1}} of 4}") + => 5) +(test (run "{with {add3 {fun {x} {+ x 3}}} + {add3 of 1}}") + => 4) +(test (run "{with {add3 {fun {x} {+ x 3}}} + {with {add1 {fun {x} {+ x 1}}} + {with {x 3} + {add1 of {add3 of x}}}}}") + => 7) +(test (run "{with {identity {fun {x} x}} + {with {foo {fun {x} {+ x 1}}} + {{identity of foo} of 123}}}") + => 124) +(test (run "{with {x 3} + {with {f {fun {y} {+ x y}}} + {with {x 5} + {f of 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} + {f of 4}}}") + => 7) +(test (run "{call {call {fun {x} {x of 1}} + {fun {x} {fun {y} {+ x y}}}} + 123}") + => 124)|# diff --git a/09-tidbit/tidbit.rkt b/09-tidbit/tidbit.rkt new file mode 100644 index 0000000..cc966e5 --- /dev/null +++ b/09-tidbit/tidbit.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