Nearly done with TidBIT.

This commit is contained in:
2026-01-13 08:22:59 -05:00
parent ef2f5f64dc
commit 96b870b2c1
+36 -20
View File
@@ -37,13 +37,28 @@ The grammar:
[CFun CORE] [CFun CORE]
[CCall CORE CORE]) [CCall CORE CORE])
(define-type BINDING-DEPTH = (Symbol -> Number)) (define-type BINDING-DEPTH = (Symbol -> Idx))
(: empty-depth : BINDING-DEPTH) (: empty-depth : BINDING-DEPTH)
(define (empty-depth s) (error 'empty-depth "empty depth")) (define (empty-depth s) (error 'empty-depth "No binding for ~s." s))
(: binding-encountered : BINDING-DEPTH Symbol -> BINDING-DEPTH) (: binding-encountered : BINDING-DEPTH Symbol -> BINDING-DEPTH)
(define (binding-encountered bd id)) (define (binding-encountered bd id)
(lambda ([s : Symbol]) (if (symbol=? s id) 1 (add1 (bd s)))))
(: preprocess : TIDBIT BINDING-DEPTH -> CORE)
(define (preprocess tb bd)
(cases tb
[(Num n) (CNum n)]
[(Add l r) (CAdd (preprocess l bd) (preprocess r bd))]
[(Sub l r) (CSub (preprocess l bd) (preprocess r bd))]
[(Mul l r) (CMul (preprocess l bd) (preprocess r bd))]
[(Div l r) (CDiv (preprocess l bd) (preprocess r bd))]
[(Id s) (CIdx (bd s))]
[(With name value body) (CWith (preprocess value bd)
(preprocess body (binding-encountered bd name)))]
[(Fun param body) (CFun (preprocess body (binding-encountered bd param)))]
[(Call fn arg) (CCall (preprocess fn bd) (preprocess arg bd))]))
(: parse-sexpr : Sexpr -> TIDBIT) (: parse-sexpr : Sexpr -> TIDBIT)
; Parses Sexprs into TIDBITs. ; Parses Sexprs into TIDBITs.
@@ -80,7 +95,6 @@ The grammar:
(define-type ENV = (Listof VAL)) (define-type ENV = (Listof VAL))
(: NumV->number : VAL -> Number) (: NumV->number : VAL -> Number)
;; convert a TIDBIT runtime numeric value to a Racket one ;; convert a TIDBIT runtime numeric value to a Racket one
(define (NumV->number val) (define (NumV->number val)
@@ -105,7 +119,7 @@ The grammar:
[(CDiv 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) [(CWith bound-val bound-body)
(eval bound-body (cons (eval bound-val env) env))] (eval bound-body (cons (eval bound-val env) env))]
[(CIdx n) (list-ref env n)] [(CIdx n) (list-ref env (sub1 n))]
[(CFun body) [(CFun body)
(FunV body env)] (FunV body env)]
[(CCall fun-expr arg-expr) [(CCall fun-expr arg-expr)
@@ -116,38 +130,40 @@ The grammar:
[else (error 'eval "`call' expects a function, got: ~s" [else (error 'eval "`call' expects a function, got: ~s"
fval)]))])) fval)]))]))
#|
(: run : String -> Number) (: run : String -> Number)
;; evaluate a TIDBIT program contained in a string ;; evaluate a TIDBIT program contained in a string
(define (run str) (define (run str)
(let ([result (eval (parse str) (EmptyEnv))]) (let ([result (eval (preprocess (parse str) empty-depth) '())])
(cases result (cases result
[(NumV n) n] [(NumV n) n]
[else (error 'run "evaluation returned a non-number: ~s" [else (error 'run "evaluation returned a non-number: ~s"
result)]))) 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}") (test (run "{{fun {x} {+ x 1}} of 4}")
=> 5) => 5)
(test (run "{with {add3 {fun {x} {+ x 3}}} (test (run "{with {add3 {fun {x} {+ x 3}}}
{add3 of 1}}") {add3 of 1}}")
=> 4) => 4)
(test (run "{with {x 1} {with {y 2} {+ x y}}}") => 3)
(test (run "{call {call {fun {x} {fun {y} {+ x y}}} 1} 2}") => 3)
(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> "empty-depth: No binding for asdf.")
(test (run "{+ 1 {fun {x} x}}") =error> "arith-op: expected a number, got: (FunV (CIdx 1) ())")
(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 (CIdx 1) ())")
(test (run "{with {identity {fun {x} x}}
{with {foo {fun {x} {+ x 1}}}
{{identity of foo} of 123}}}")
=> 124)
(test (run "{with {add3 {fun {x} {+ x 3}}} (test (run "{with {add3 {fun {x} {+ x 3}}}
{with {add1 {fun {x} {+ x 1}}} {with {add1 {fun {x} {+ x 1}}}
{with {x 3} {with {x 3}
{add1 of {add3 of x}}}}}") {add1 of {add3 of x}}}}}")
=> 7) => 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} (test (run "{with {x 3}
{with {f {fun {y} {+ x y}}} {with {f {fun {y} {+ x y}}}
{with {x 5} {with {x 5}
@@ -164,4 +180,4 @@ The grammar:
(test (run "{call {call {fun {x} {x of 1}} (test (run "{call {call {fun {x} {x of 1}}
{fun {x} {fun {y} {+ x y}}}} {fun {x} {fun {y} {+ x y}}}}
123}") 123}")
=> 124)|# => 124)