From 5268b8a155530f8d0a8e794954c3592e875a4a83 Mon Sep 17 00:00:00 2001 From: Jacob Date: Sat, 10 Jan 2026 22:28:30 -0500 Subject: [PATCH] Finished barf. Only a couple months late :). --- 08-barf/main.rkt | 255 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 188 insertions(+), 67 deletions(-) diff --git a/08-barf/main.rkt b/08-barf/main.rkt index cbc8062..6118882 100644 --- a/08-barf/main.rkt +++ b/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)