Added TidBIT

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)
+(: eval : PROGRAM -> Primitive)
-;; evaluates BARF expressions by reducing them to numbers
+;; 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)

10-tidbit/main.rkt

@@ -0,0 +1,152 @@
+#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)