Finished barf. Only a couple months late :).

08-barf/main.rkt

@@ -69,14 +69,14 @@ CFG for the BARF language:
 ;; Parses Sexprs into PROGs.
 (define (parse-prog sexpr)
   (match sexpr
-    [(list 'prog f ...) (Prog (map parse-fun f))]
+    [(list 'prog functions ...) (Prog (map parse-fun functions))]
     [else (error 'parse-prog "Bag prog syntax in ~s." sexpr)]))
 
 (: parse-fun : Sexpr -> FUN)
 ;; Parses Sexprs into FUNs.
 (define (parse-fun sexpr)
   (match sexpr
-    [(list 'fun more)
+    [(list 'fun more ...)
      (match sexpr
        [(list 'fun (symbol: fname) (list (symbol: param)) barf)
         (Fun fname param (parse-barf barf))])]))
@@ -87,7 +87,7 @@ CFG for the BARF language:
   ;; utility for parsing a list of barf expressions
   (: parse-barfs : (Listof Sexpr) -> (Listof BARF))
   (define (parse-barfs sexprs)
-    (map parse-sexpr sexprs))
+    (map parse-barf sexprs))
   (match sexpr
     [(number: n) (Num n)]
     ['T (Bool #t)]
@@ -133,10 +133,11 @@ CFG for the BARF language:
 (define (nothelper a )
   (If (parse-barf a) pf pt))
 
+#|
 (: parse : String -> BARF)
 ;; parses a string containing an BARF expression to an BARF AST
 (define (parse str)
-  (parse-barf (string->sexpr str)))
+  (parse-barf (string->sexpr str)))|#
 
 (: subst : BARF Symbol BARF -> BARF)
 ;; substitutes the second argument with the third argument in the
@@ -171,20 +172,21 @@ CFG for the BARF language:
          [(Lambda arg body)
           (Lambda arg (if (eq? arg from) body (subst* body)))]
          [(Call f arg) (Call (subst* f) (subst* arg))]
-         [(Id name) (if (eq? name from) to expr)]))
+         [(Id name) (if (eq? name from) to expr)]
+         [(Call2 fname arg) (Call2 fname (subst* arg))]))
 
-(: eval-number : BARF -> Number)
+(: eval-number : PROG BARF -> Number)
 ;; helper for `eval': verifies that the result is a number
-(define (eval-number expr)
-  (let ([result (eval expr)])
+(define (eval-number prog expr)
+  (let ([result (eval prog expr)])
     (if (number? result)
         result
         (error 'eval-number "need a number when evaluating ~s, but got ~s" expr result))))
 
-(: eval-boolean : BARF -> Boolean)
+(: eval-boolean : PROG BARF -> Boolean)
 ;; helper for `eval': verifies that the result is a boolean
-(define (eval-boolean expr)
-  (let ([result (eval expr)])
+(define (eval-boolean prog expr)
+  (let ([result (eval prog expr)])
     (if (boolean? result)
         result
         (error 'eval-boolean "need a boolean when evaluating ~s, but got ~s" expr result))))
@@ -204,108 +206,227 @@ CFG for the BARF language:
     [(boolean? val) (Bool val)]
     [(list? val) (rehydrate val)]))
 
-(: eval-sum : (Listof BARF) -> Number)
+(: eval-sum : PROG (Listof BARF) -> Number)
 ; Evaluates a Sum expression.
-(define (eval-sum args)
-  (foldr + 0 (map eval-number args)))
+(define (eval-sum prog args)
+  (foldr + 0 (map (lambda ([arg : BARF]) (eval-number prog arg)) args)))
 
-(: eval-mul : (Listof BARF) -> Number)
+(: eval-mul : PROG (Listof BARF) -> Number)
 ; Evaluates a Mul expression.
-(define (eval-mul args)
-  (foldr * 1 (map eval-number args)))
+(define (eval-mul prog args)
+  (foldr * 1 (map (lambda ([arg : BARF]) (eval-number prog arg)) args)))
 
-(: eval-sub : BARF (Listof BARF) -> Number)
+(: eval-sub : PROG BARF (Listof BARF) -> Number)
 ; Evaluates a Sub expression.
-(define (eval-sub fst args)
+(define (eval-sub prog fst args)
   (define l (length args))
-  (cond [(= l 0) (- (eval-number fst))]
-        [else (- (eval-number fst) (eval-sum args))]))
+  (cond [(= l 0) (- (eval-number prog fst))]
+        [else (- (eval-number prog fst) (eval-sum prog args))]))
 
-(: eval-div : BARF (Listof BARF) -> Number)
+(: eval-div : PROG BARF (Listof BARF) -> Number)
 ; Evaluates a Div expression.
-(define (eval-div fst args)
+(define (eval-div prog fst args)
   (define l (length args))
-  (cond [(= l 0) (/ (eval-number fst))]
-        [else (/ (eval-number fst) (eval-mul args))])) ; Huh.
+  (cond [(= l 0) (/ (eval-number prog fst))]
+        [else (/ (eval-number prog fst) (eval-mul prog args))]))
 
-(: eval-eq : BARF BARF -> Boolean)
+(: eval-eq : PROG BARF BARF -> Boolean)
 ; Evaluates an Eq expression.
-(define (eval-eq a b)
-  (= (eval-number a) (eval-number b)))
+(define (eval-eq prog a b)
+  (= (eval-number prog a) (eval-number prog b)))
 
-(: eval-lt : BARF BARF -> Boolean)
+(: eval-lt : PROG BARF BARF -> Boolean)
 ; Evaluates an Lt expression.
-(define (eval-lt a b)
-  (< (eval-number a) (eval-number b)))
+(define (eval-lt prog a b)
+  (< (eval-number prog a) (eval-number prog b)))
 
-(: eval-lte : BARF BARF -> Boolean)
+(: eval-lte : PROG BARF BARF -> Boolean)
 ; Evaluates an Lte expression.
-(define (eval-lte a b)
-  (<= (eval-number a) (eval-number b)))
+(define (eval-lte prog a b)
+  (<= (eval-number prog a) (eval-number prog b)))
 
-(: eval-if : BARF BARF BARF -> Primitive)
+(: eval-if : PROG BARF BARF BARF -> Primitive)
 ; Evaluates an If expression.
-(define (eval-if pred body alt)
-  (if (eval-boolean pred) (eval body) (eval alt)))
+(define (eval-if prog pred body alt)
+  (if (eval-boolean prog pred) (eval prog body) (eval prog alt)))
 
-(: eval-lambda : BARF Symbol BARF -> Primitive )
+(: eval-lambda : PROG BARF Symbol BARF -> Primitive )
 ; Evaluates a Lambda expression (in a Call expression).
-(define (eval-lambda arg par body)
+(define (eval-lambda prog arg par body)
   (if (member par reserved-names)
       (error 'eval-lambda "Can't create parameter binding to reserved name '~s'." par)
-      (eval (subst body par (value->barf (eval arg))))))
+      (eval prog (subst body par (value->barf (eval prog arg))))))
 
-(: eval-call : BARF BARF -> Primitive)
+(: eval-call : PROG BARF BARF -> Primitive)
 ; Evaluates a Call expression.
-(define (eval-call f arg)
+(define (eval-call prog f arg)
   (match f
-    [(list (symbol: par) body) (eval-lambda arg par body)]
+    [(list (symbol: par) body) (eval-lambda prog arg par body)]
     [_ (cases f
-         [(Lambda par body) (eval-lambda arg par body)]
+         [(Lambda par body) (eval-lambda prog arg par body)]
          [_ (error 'eval-call "Expected lambda expression to call, instead got: ~s." f)])]))
 
-(: findfun : Symbol PROGRAM -> FUN)
+(: findfun : Symbol PROG -> FUN)
 ; Finds the Fun.
 (define (findfun fname prog)
-  (define foundfun (cases prog [(Prog flist)
-               (ormap (lambda (f) (cases f [(Fun name param body)
-                                              (if (string=? name fname) (f) (#f))])))]))
+  (define foundfun (cases prog [(Prog functions) (ormap (lambda ([f : FUN]) (cases f [(Fun name par body) (if (symbol=? name fname) f #f)])) functions)]))
   (if (not foundfun) (error 'findfun "Function not found.") foundfun))
 
-(: eval : PROGRAM BARF -> Primitive)
-; Evaluates a BARF in the context of a PROGRAM.
-(define (eval prog expr)
-  (let ([eval (lambda ([e : BARF]) (eval prog e))]
-        [eval-number (eval prog e)]
-        [eval-boolean (eval prog e)])
+(: eval-call2 : PROG Symbol BARF -> Primitive)
+; Evaluates a call (new version).
+(define (eval-call2 prog fname arg)
+  (: fdef : FUN)
+  (define fdef (findfun fname prog)) ; Definition of the function.
+  (cases fdef [(Fun name par body)
+               (: substbody : BARF)
+               (define substbody (subst body par arg))
+               (eval prog substbody)]))
 
+(: eval : PROG BARF -> Primitive)
+; Evaluates a BARF in the context of a PROG.
+(define (eval prog expr)
   (cases expr
          [(Num n) n]
          [(Bool p) p]
-         [(Sum args) (eval-sum args)]
-         [(Mul args) (eval-mul args)]
-         [(Sub fst args) (eval-sub fst args)]
-         [(Div fst args) (eval-div fst args)]
-         [(Eq l r) (eval-eq l r)]
-         [(Lt l r) (eval-lt l r)]
-         [(Lte l r) (eval-lte l r)]
-         [(If p b a) (eval-if p b a)]
+         [(Sum args) (eval-sum prog args)]
+         [(Mul args) (eval-mul prog args)]
+         [(Sub fst args) (eval-sub prog fst args)]
+         [(Div fst args) (eval-div prog fst args)]
+         [(Eq l r) (eval-eq prog l r)]
+         [(Lt l r) (eval-lt prog l r)]
+         [(Lte l r) (eval-lte prog l r)]
+         [(If p b a) (eval-if prog p b a)]
          [(With bound-id named-expr bound-body)
           (if (member bound-id reserved-names)
               (error 'eval "Can't create binding to reserved name '~s'." bound-id)
-              (eval (subst bound-body
+              (eval prog (subst bound-body
                            bound-id
                            ;; see the above `value-barf' helper
-                           (value->barf (eval named-expr)))))]
+                           (value->barf (eval prog named-expr)))))]
          [(Lambda par body)
           (if (member par reserved-names)
               (error 'eval "Can't create parameter binding to reserved name '~s'." par)
               (list (Par par) (Body body)))]
-         [(Call f arg) (eval-call (value->barf (eval f)) arg)]
-         [(Id name) (error 'eval "free identifier: ~s" name)])))
+         [(Call f arg) (eval-call prog (value->barf (eval prog f)) arg)]
+         [(Id name) (error 'eval "free identifier: ~s" name)]
+         [(Call2 fname arg) (eval-call2 prog fname arg)]))
 
 (: run : String -> Primitive)
 ;; evaluate an BARF program contained in a string
 (define (run str)
-  (eval (parse str) (Call2 'main (Num 4))))
+  (eval (parse (string->sexpr str)) (Call2 'main (Num 4))))
 
+(: run* : String -> Primitive)
+(define (run* str)
+  (eval (Prog (list (Fun 'main 'n (parse-barf (string->sexpr str))))) (Call2 'main (Num 4))))
+
+(test (run "{prog {fun main {n} n}}") => 4)
+
+(test (run "
+{prog
+  {fun even? {n}
+    {if {= 0 n} T {call odd? {- n 1}}}}
+
+  {fun odd? {n}
+    {if {= 0 n} F {call even? {- n 1}}}}
+
+  {fun 3np1 {n}
+    {if {= n 1}
+      1
+      {+ 1 {call 3np1
+        {if {call even? n}
+        {/ n 2}
+        {+ 1 {* n 3}}}}}}}
+
+  {fun main {n}
+    {and {= {call 3np1 5} 6}
+         {= {call 3np1 4} 3}}}}"
+) => #T)
+
+; 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-barf: Bad barf syntax in (-).")
+(test (run* "{- 1}") => -1)
+(test (run* "{- 3 2 1}") => 0)
+(test (run* "{- 1 2 3}") => -4)
+
+(test (run* "{/}") =error> "parse-barf: Bad barf 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")
+
+
+
+(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)