From 841de927482667694a80c8d60da9c4bc17b83b2e Mon Sep 17 00:00:00 2001
From: Jacob <jacob.signorovitch@gmail.com>
Date: Sun, 4 Jan 2026 00:33:56 -0500
Subject: [PATCH] Added BARF.

---
 08-barf/main.rkt | 383 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 383 insertions(+)
 create mode 100644 08-barf/main.rkt

diff --git a/08-barf/main.rkt b/08-barf/main.rkt
new file mode 100644
index 0000000..3c5902f
--- /dev/null
+++ b/08-barf/main.rkt
@@ -0,0 +1,383 @@
+#lang pl
+
+#|
+
+CFG for the BARF language:
+
+<PROG> ::= { prog <FUN> ... }
+<FUN> ::= { fun <id> { <id> } <BARF> }
+<BARF> ::= <number literal>
+           |<boolean literal>
+           | { + <BARF> ... }
+           | { * <BARF> ... }
+           | { - <BARF> <BARF> ... }
+           | { / <BARF> <BARF> ... }
+           | { = <BARF> <BARF> }
+           | { <BARF> is <BARF> } -- Sugar.
+           | { < <BARF> <BARF> }
+           | { <BARF> is less than <BARF> } -- Sugar.
+           | { <= <BARF> <BARF> }
+           | { <BARF> is less than or equal to <BARF> } -- Sugar.
+           | { with { <id> <BARF> } <BARF> }
+           | { with <id> as <BARF> <BARF> } -- Sugar.
+           | { if <BARF> <BARF> <BARF> }
+           | { if <BARF> then <BARF> else <BARF> } -- Sugar.
+           | { and <BARF> <BARF> } -- Sugar.
+           | { or <BARF> <BARF> } -- Sugar.
+           | { not <BARF> } -- Sugar.
+           | { lambda <id> <BARF> }
+           | { <BARF> of <BARF> }
+           | <id>
+           | { call <id> <BARF> }
+|#
+
+(define-type PROG [Prog (Listof FUN)])
+(define-type FUN [Fun Symbol Symbol BARF])
+(define-type BARF
+             [Num Number]
+             [Bool Boolean]
+             [Sum (Listof BARF)]
+             [Mul (Listof BARF)]
+             [Sub BARF (Listof BARF)]
+             [Div BARF (Listof BARF)]
+             [Eq BARF BARF]
+             [Lt BARF BARF]
+             [Lte BARF BARF]
+             [With Symbol BARF BARF]
+             [If BARF BARF BARF]
+             [Lambda Symbol BARF]
+             [Call BARF BARF]
+             [Id Symbol]
+             [Call2 Symbol BARF])
+
+; This is a little strange.
+(define-type LambdaContents
+             [Par Symbol]
+             [Body BARF])
+
+(define-type Primitive = (U Number Boolean (Listof LambdaContents)))
+
+(define reserved-names (list 'F 'T '+ '* '- '/ '= 'is '< 'less 'than '<= 'or 'equal 'to 'with 'if 'then 'else 'lambda 'of 'and 'not 'as 'call 'prog 'fun))
+
+(define pf (Bool #f))
+(define pt (Bool #t))
+
+(: parse : Sexpr -> PROG)
+(define (parse sexpr) (parse-prog sexpr))
+
+(: parse-prog : Sexpr -> PROG)
+;; Parses Sexprs into PROGs.
+(define (parse-prog sexpr)
+  (match sexpr
+    [(list 'prog f ...) (Prog (map parse-fun f))]
+    [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)
+     (match sexpr
+       [(list 'fun (symbol: fname) (list (symbol: param)) barf)
+        (Fun fname param (parse-barf barf))])]))
+
+(: parse-barf : Sexpr -> BARF)
+;; parses s-expressions into BARFs
+(define (parse-barf sexpr)
+  ;; utility for parsing a list of barf expressions
+  (: parse-barfs : (Listof Sexpr) -> (Listof BARF))
+  (define (parse-barfs sexprs)
+    (map parse-sexpr sexprs))
+  (match sexpr
+    [(number: n) (Num n)]
+    ['T (Bool #t)]
+    ['F (Bool #f)]
+    [(list '+ args ...) (Sum (parse-barfs args))]
+    [(list '* args ...) (Mul (parse-barfs args))]
+    [(list '- fst args ...) (Sub (parse-barf fst) (parse-barfs args))]
+    [(list '/ fst args ...) (Div (parse-barf fst) (parse-barfs args))]
+    [(list '= l r) (Eq (parse-barf l) (parse-barf r))]
+    [(list l 'is r) (Eq (parse-barf l) (parse-barf r))]
+    [(list '< l r) (Lt (parse-barf l) (parse-barf r))]
+    [(list l 'is 'less 'than r) (Lt (parse-barf l) (parse-barf r))]
+    [(list '<= l r) (Lte (parse-barf l) (parse-barf r))]
+    [(list l 'is 'less 'than 'or 'equal 'to r) (Lte (parse-barf l) (parse-barf r))]
+    [(list 'with (symbol: name) 'as val body) (With name (parse-barf val) (parse-barf body))]
+    [(cons 'with more)
+     (match sexpr
+       [(list 'with (list (symbol: name) named) body)
+        (With name (parse-barf named) (parse-barf body))]
+       [else (error 'parse-barf "bad `with' syntax in ~s" sexpr)])]
+    [(list 'if p b a) (If (parse-barf p) (parse-barf b) (parse-barf a))]
+    [(list 'if p 'then b 'else a) (If (parse-barf p) (parse-barf b) (parse-barf a))]
+    [(list 'and a b) (andhelper a b)]
+    [(list a 'and b) (andhelper a b)]
+    [(list 'or a b) (orhelper a b)]
+    [(list a 'or b) (orhelper a b)]
+    [(list 'not a) (nothelper a)]
+    [(list 'lambda (symbol: arg) body) (Lambda arg (parse-barf body))]
+    [(list f 'of arg) (Call (parse-barf f) (parse-barf arg))]
+    [(symbol: name) (Id name)]
+    [(list 'call (symbol: f) b) (Call2 f (parse-barf b))]
+    [else (error 'parse-barf "Bad barf syntax in ~s." sexpr)]))
+
+(: andhelper : Sexpr Sexpr -> BARF)
+(define (andhelper a b)
+  (If (parse-barf a) (If (parse-barf b) pt pf) pf))
+
+(: orhelper : Sexpr Sexpr -> BARF)
+(define (orhelper a b)
+  (If (parse-barf a) pt (If (parse-barf b) pt pf)))
+
+(: nothelper : Sexpr -> BARF)
+(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)))
+
+(: subst : BARF Symbol BARF -> BARF)
+;; substitutes the second argument with the third argument in the
+;; first argument, as per the rules of substitution; the resulting
+;; expression contains no free instances of the second argument
+(define (subst expr from to)
+  ;; convenient helper -- no need to specify `from' and `to'
+  (: subst* : BARF -> BARF)
+  (define (subst* x)
+    (subst x from to))
+  ;; helper to substitute lists
+  (: substs* : (Listof BARF) -> (Listof BARF))
+  (define (substs* exprs)
+    (map subst* exprs))
+  (cases expr
+         [(Num n) expr]
+         [(Bool p) expr]
+         [(Sum args) (Sum (substs* args))]
+         [(Mul args) (Mul (substs* args))]
+         [(Sub fst args) (Sub (subst* fst) (substs* args))]
+         [(Div fst args) (Div (subst* fst) (substs* args))]
+         [(Eq l r) (Eq (subst* l) (subst* r))]
+         [(Lt l r) (Lt (subst* l) (subst* r))]
+         [(Lte l r) (Lte (subst* l) (subst* r))]
+         [(If p b a) (If (subst* p) (subst* b) (subst* a))]
+         [(With bound-id named-expr bound-body)
+          (With bound-id
+                (subst* named-expr)
+                (if (eq? bound-id from)
+                    bound-body
+                    (subst* bound-body)))]
+         [(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)]))
+
+(: eval-number : BARF -> Number)
+;; helper for `eval': verifies that the result is a number
+(define (eval-number expr)
+  (let ([result (eval expr)])
+    (if (number? result)
+        result
+        (error 'eval-number "need a number when evaluating ~s, but got ~s" expr result))))
+
+(: eval-boolean : BARF -> Boolean)
+;; helper for `eval': verifies that the result is a boolean
+(define (eval-boolean expr)
+  (let ([result (eval expr)])
+    (if (boolean? result)
+        result
+        (error 'eval-boolean "need a boolean when evaluating ~s, but got ~s" expr result))))
+
+; This is pretty cursed, but I couldn't find a better way to have structured data.
+(: rehydrate : (Listof LambdaContents) -> BARF)
+; Recreates a lambda from list representation.
+(define (rehydrate l)
+  (Lambda (cases (first l) [(Par s) s] [_ (error 'rehydrate "what")])
+          (cases (second l) [(Body b) b] [_ (error 'rehydrate "what")])))
+
+(: value->barf : Primitive -> BARF)
+;; converts a value to an BARF value (so it can be used with `subst')
+(define (value->barf val)
+  (cond
+    [(number? val) (Num val)]
+    [(boolean? val) (Bool val)]
+    [(list? val) (rehydrate val)]))
+
+(: eval-sum : (Listof BARF) -> Number)
+; Evaluates a Sum expression.
+(define (eval-sum args)
+  (foldr + 0 (map eval-number args)))
+
+(: eval-mul : (Listof BARF) -> Number)
+; Evaluates a Mul expression.
+(define (eval-mul args)
+  (foldr * 1 (map eval-number args)))
+
+(: eval-sub : BARF (Listof BARF) -> Number)
+; Evaluates a Sub expression.
+(define (eval-sub fst args)
+  (define l (length args))
+  (cond [(= l 0) (- (eval-number fst))]
+        [else (- (eval-number fst) (eval-sum args))]))
+
+(: eval-div : BARF (Listof BARF) -> Number)
+; Evaluates a Div expression.
+(define (eval-div fst args)
+  (define l (length args))
+  (cond [(= l 0) (/ (eval-number fst))]
+        [else (/ (eval-number fst) (eval-mul args))])) ; Huh.
+
+(: eval-eq : BARF BARF -> Boolean)
+; Evaluates an Eq expression.
+(define (eval-eq a b)
+  (= (eval-number a) (eval-number b)))
+
+(: eval-lt : BARF BARF -> Boolean)
+; Evaluates an Lt expression.
+(define (eval-lt a b)
+  (< (eval-number a) (eval-number b)))
+
+(: eval-lte : BARF BARF -> Boolean)
+; Evaluates an Lte expression.
+(define (eval-lte a b)
+  (<= (eval-number a) (eval-number b)))
+
+(: eval-if : BARF BARF BARF -> Primitive)
+; Evaluates an If expression.
+(define (eval-if pred body alt)
+  (if (eval-boolean pred) (eval body) (eval alt)))
+
+(: eval-lambda : BARF Symbol BARF -> Primitive )
+; Evaluates a Lambda expression (in a Call expression).
+(define (eval-lambda 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-call : BARF BARF -> Primitive)
+; Evaluates a Call expression.
+(define (eval-call f arg)
+  (match f
+    [(list (symbol: par) body) (eval-lambda arg par body)]
+    [_ (cases f
+         [(Lambda par body) (eval-lambda arg par body)]
+         [_ (error 'eval-call "Expected lambda expression to call, instead got: ~s." f)])]))
+
+(: eval : BARF -> Primitive)
+;; evaluates BARF expressions by reducing them to numbers
+(define (eval 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)]
+         [(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
+                           bound-id
+                           ;; see the above `value-barf' helper
+                           (value->barf (eval 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)]))
+
+(: run : String -> Primitive)
+;; 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)