Done with compilation.

This commit is contained in:
2026-04-14 22:22:42 -04:00
parent 3f92405b0e
commit b4298d25df
2 changed files with 303 additions and 152 deletions
+54 -42
View File
@@ -30,11 +30,11 @@ POSTT :== PUWAE
[Sub PUWAE PUWAE]
[Mul PUWAE PUWAE]
[Div PUWAE PUWAE]
; [Post (Listof POSTT)]
[Post (Listof POSTT)]
[With Symbol PUWAE PUWAE])
(define-type POSTT = (U '+ '- '* '/ PUWAE))
(: parse : (String -> PUWAE))
;; parse the string into our language
(define (parse str)
@@ -50,49 +50,27 @@ POSTT :== PUWAE
[(list '- l r) (Sub (sexpr->puwae l) (sexpr->puwae r))]
[(list '* l r) (Mul (sexpr->puwae l) (sexpr->puwae r))]
[(list '/ l r) (Div (sexpr->puwae l) (sexpr->puwae r))]
[(list 'post posts ...) (parsepost posts '())]
[(list 'post posts ...) (Post (sexpr-list->postts posts))]
[(list 'with (list (symbol: id) val) bound-body)
(With id (sexpr->puwae val) (sexpr->puwae bound-body))]
[_ (error 'sexpr->puwae "malformed expression in ~s" sexpr)]))
(: parsepost : (Sexpr (Listof PUWAE) -> PUWAE))
; Parse a post expression into a PUWAE.
(define (parsepost sexpr glob)
(: sexpr->postt : (Sexpr -> POSTT))
;; Turn a post into POSTT.
(define (sexpr->postt sexpr)
(match sexpr
['() (if (= 1 (length glob)) (first glob) (error 'parsepost "finished with messy glob: ~s" glob))] ; There shouldn't be anything else left in the stack.
[(cons '+ rest) (parsepost rest (parsepost-sum glob))]
[(cons '- rest) (parsepost rest (parsepost-sub glob))]
[(cons '* rest) (parsepost rest (parsepost-mul glob))]
[(cons '/ rest) (parsepost rest (parsepost-div glob))]
[(cons (symbol: id) rest) (parsepost rest (cons (Id id) glob))] ; Capture non-post symbols (variables).
[(cons exp rest) (parsepost rest (cons (sexpr->puwae exp) glob))])) ; Assume anything else must be a PUWAE.
['+ '+]
['- '-]
['* '*]
['/ '/]
[_ (sexpr->puwae sexpr)]))
(: glob-swap : Symbol (Listof PUWAE) (PUWAE PUWAE -> PUWAE) -> (Listof PUWAE))
; Validates the glob length before swapping with result of globberator.
(define (glob-swap operation glob globberator)
(if (>= (length glob) 2)
(cons (globberator (second glob) (first glob)) (rest (rest glob))) ; Replace the two arguments, while preserving whatever else was on the stack.
(error 'glob-swap "too few arguments globbed for ~s: ~s" operation glob)))
(: parsepost-sum : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post sum.
(define (parsepost-sum glob)
(glob-swap 'sum glob Sum))
(: parsepost-mul : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post product.
(define (parsepost-mul glob)
(glob-swap 'mul glob Mul))
(: parsepost-sub : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post subtration.
(define (parsepost-sub glob)
(glob-swap 'sub glob Sub))
(: parsepost-div : ((Listof PUWAE) -> (Listof PUWAE)))
; Parse a post quotient.
(define (parsepost-div glob)
(glob-swap 'div glob Div))
(: sexpr-list->postts : ((Listof Sexpr) -> (Listof POSTT)))
(define (sexpr-list->postts sexprs)
(match sexprs
['() '()]
[(cons token rest)
(cons (sexpr->postt token) (sexpr-list->postts rest))]))
(: eval : (PUWAE -> Number))
;; evaluate to a final number
@@ -104,8 +82,32 @@ POSTT :== PUWAE
[(Sub l r) (- (eval l) (eval r))]
[(Mul l r) (* (eval l) (eval r))]
[(Div l r) (/ (eval l) (eval r))]
[(Post postts) (eval-post postts '())]
[(With id pre-val bound-body) (eval (subst id (Num (eval pre-val)) bound-body))]))
(: post-stack-apply : (Symbol (Number Number -> Number) (Listof Number) -> (Listof Number)))
(define (post-stack-apply operator operation stack)
(if (>= (length stack) 2)
(cons (operation (second stack) (first stack)) (rest (rest stack)))
(error 'eval-post "Too few arguments for ~s: ~s" operator stack)))
(: eval-post : ((Listof POSTT) (Listof Number) -> Number))
(define (eval-post postts stack)
(match postts
['()
(if (= 1 (length stack))
(first stack)
(error 'eval-post "Finished with messy stack: ~s" stack))]
[(cons token rest)
(if (symbol? token)
(match token
['+ (eval-post rest (post-stack-apply '+ + stack))]
['- (eval-post rest (post-stack-apply '- - stack))]
['* (eval-post rest (post-stack-apply '* * stack))]
['/ (eval-post rest (post-stack-apply '/ / stack))]
[_ (error 'eval-post "Bad post operator ~s" token)])
(eval-post rest (cons (eval token) stack)))]))
(: subst : (Symbol PUWAE PUWAE -> PUWAE))
;; subst all instances of id with val in body
(define (subst id val body)
@@ -116,6 +118,7 @@ POSTT :== PUWAE
[(Sub l r) (Sub (subst id val l) (subst id val r))]
[(Mul l r) (Mul (subst id val l) (subst id val r))]
[(Div l r) (Div (subst id val l) (subst id val r))]
[(Post postts) (Post (subst-postts id val postts))]
[(With other-id pre-val bound-body)
(With other-id
(subst id val pre-val)
@@ -123,6 +126,15 @@ POSTT :== PUWAE
bound-body
(subst id val bound-body)))]))
(: subst-postts : (Symbol PUWAE (Listof POSTT) -> (Listof POSTT)))
(define (subst-postts id val postts)
(match postts
['() '()]
[(cons token rest)
(if (symbol? token)
(cons token (subst-postts id val rest))
(cons (subst id val token) (subst-postts id val rest)))]))
(: run : String -> Number)
;; run the program
(define (run str)
@@ -139,9 +151,9 @@ POSTT :== PUWAE
(test (run "{with {x {post 1 3 +}} {post 5 6 + x *}}") => 44)
(test (run "{post 1 3 + 5 6 + *}") => 44) ; Not 48 :P (5 + 6 ≠ 12).
(test (run "{post 3 +}") =error> "glob-swap: too few arguments globbed for sum: ((Num 3))")
(test (run "{post 3 3 3 +}") =error> "parsepost: finished with messy glob: ((Sum (Num 3) (Num 3)) (Num 3))")
(test (run "{post 1 2 + 2}") =error> "parsepost: finished with messy glob: ((Num 2) (Sum (Num 1) (Num 2)))")
(test (run "{post 3 +}") =error> "eval-post: Too few arguments for +: (3)")
(test (run "{post 3 3 3 +}") =error> "eval-post: Finished with messy stack: (6 3)")
(test (run "{post 1 2 + 2}") =error> "eval-post: Finished with messy stack: (2 3)")
(test (run "4") => 4)
(test (run "{+ 4 {* 2 3}}") => 10)
+249 -110
View File
@@ -1,6 +1,5 @@
;;; ---<<<TOY>>>----------------------------------------------------
#lang pl
;;; ----------------------------------------------------------------
;;; Syntax
@@ -10,6 +9,7 @@
| { bind {{ <id> <TOY> } ... } <TOY> ... }
| { bindrec {{ <id> <TOY> } ... } <TOY> ... }
| { fun { <id> ... } <TOY> ... }
| { rfun { <id> ... } <TOY> ... }
| { <TOY> <TOY> ... }
| { if <TOY> <TOY> <TOY> }
| { set! <id> <TOY> }
@@ -17,17 +17,18 @@
;; A matching abstract syntax tree datatype:
(define-type TOY
[Num Number]
[Id Symbol]
[Bind (Listof Symbol) (Listof TOY) (Listof TOY)]
[Bindrec (Listof Symbol) (Listof TOY) (Listof TOY)]
[Fun (Listof Symbol) (Listof TOY)]
[Call TOY (Listof TOY)]
[If TOY TOY TOY]
[Set Symbol TOY])
[Num Number]
[Id Symbol]
[Bind (Listof Symbol) (Listof TOY) (Listof TOY)]
[Bindrec (Listof Symbol) (Listof TOY) (Listof TOY)]
[Fun (Listof Symbol) (Listof TOY)]
[Rfun (Listof Symbol) (Listof TOY)]
[Call TOY (Listof TOY)]
[If TOY TOY TOY]
[Set Symbol TOY])
; Things you can't name things.
(define BAD_WORDS (list 'bind 'fun 'if 'set! '+ '- '* '/ '= '< '> 'true 'false 'void))
(define BAD_WORDS (list 'bind 'bindrec 'fun 'rfun 'if 'set! '+ '- '* '/ '= '< '> 'true 'false 'void))
(: unique-list? : (Listof Any) -> Boolean)
;; Tests whether a list is unique, guards Bind and Fun values.
@@ -36,39 +37,56 @@
(and (not (member (first xs) (rest xs)))
(unique-list? (rest xs)))))
(: no-bad-words? : (Listof Symbol) -> Boolean)
;; Tests whether a list avoids all bad words.
(define (no-bad-words? names)
(or (null? names)
(and (not (member (first names) BAD_WORDS))
(no-bad-words? (rest names)))))
(: parse-sexpr : Sexpr -> TOY)
;; parses s-expressions into TOYs
(define (parse-sexpr sexpr)
(match sexpr
; Primitives.
[(number: n) (Num n)]
[(number: n) (Num n)]
[(symbol: name) (Id name)]
; Bindrec.
[(cons (and binder (or 'bind 'bindrec)) more) ; `binder` bound to 'bind or 'bindrec.
[(cons (and binder (or 'bind 'bindrec)) _) ; `binder` bound to 'bind or 'bindrec.
; `_` feels cooler than `more`.
(match sexpr
[(list b (list (list (symbol: names) (sexpr: nameds)) ...) body ...)
(if (not (null? body))
(if (unique-list? names)
((if (symbol=? b 'bind) Bind Bindrec)
names
(map parse-sexpr nameds)
(last (map parse-sexpr body)))
(error 'parse-sexpr "duplicate `~s' names: ~s" binder names))
(error 'parse-sexpr "bind expression missing body: ~s" sexpr))]
(if (unique-list? names)
(if (no-bad-words? names)
((if (symbol=? b 'bind) Bind Bindrec)
names
(map parse-sexpr nameds)
(map parse-sexpr body))
(error 'parse-sexpr "bad word found in `~s' : ~s" binder names))
(error 'parse-sexpr "duplicate `~s' names: ~s" binder names))
(error 'parse-sexpr "bind expression missing body: ~s" sexpr))]
[else (error 'parse-sexpr "bad `~s' syntax in ~s" binder sexpr)])]
; Function definition.
[(cons 'fun more)
;
;
;
; RFun definition.
[(cons (and funer (or 'fun 'rfun)) _)
(match sexpr
[(list 'fun (list (symbol: names) ...) body)
(if (unique-list? names)
(Fun names (parse-sexpr body))
(error 'parse-sexpr "duplicate `fun' names: ~s" names))]
[else (error 'parse-sexpr "bad `fun' syntax in ~s" sexpr)])]
[(list f (list (symbol: parameters) ...) body ...)
(if (not (null? body))
(if (unique-list? parameters)
(if (no-bad-words? parameters)
((if (symbol=? f 'fun) Fun Rfun) parameters (map parse-sexpr body))
(error 'parse-sexpr "bad words found in function parameter names in ~s" sexpr))
(error 'parse-sexpr "bad parameters defined for function in ~s" sexpr))
(error 'parse-sexpr "disemobodied function in ~s" sexpr))]
[else (error 'parse-sexpr "bad function syntax in ~s" sexpr)])]
; Conditional.
[(cons 'if more)
[(cons 'if _)
(match sexpr
[(list 'if cond then else)
(If (parse-sexpr cond)
@@ -77,7 +95,7 @@
[else (error 'parse-sexpr "bad `if' syntax in ~s" sexpr)])]
; Set!.
[(cons 'set! more)
[(cons 'set! _)
(match sexpr
[(list 'set! (symbol: thing) as)
(Set thing (parse-sexpr as))])]
@@ -95,21 +113,19 @@
(define (parse str)
(parse-sexpr (string->sexpr str)))
;;; ----------------------------------------------------------------
;;; Values and environments
(define-type ENV
[EmptyEnv]
[FrameEnv FRAME ENV])
[EmptyEnv]
[FrameEnv FRAME ENV])
;; a frame is an association list of names and values.
(define-type FRAME = (Listof (List Symbol (Boxof VAL))))
(define-type VAL
[RktV Any]
[FunV (Listof Symbol) TOY ENV]
[PrimV ((Listof VAL) -> VAL)]
[VoidV])
[RktV Any]
; Parameters, compiled body, whether it's an Rfun, environment.
[FunV (Listof Symbol) (ENV -> VAL) Boolean ENV]
[PrimV ((Listof VAL) -> VAL)]
[VoidV])
(: extend : (Listof Symbol) (Listof VAL) ENV -> ENV)
(define (extend names vals env)
@@ -125,35 +141,33 @@
env)
(error 'extend "arity mismatch for names: ~s" names)))
(: extend-rec : (Listof Symbol) (Listof TOY) ENV -> ENV)
(define (extend-rec names vals env)
(define newenv (extend names (map (lambda (_) (VoidV)) vals) env))
(for-each (lambda ([name : Symbol] [val : TOY])
(set-box! (lookup name newenv) (eval val newenv)))
names vals)
(: extend-rec : (Listof Symbol) (Listof (ENV -> VAL)) ENV -> ENV)
(define (extend-rec names compiled-vals env)
(define newenv (extend names (map (lambda (_) (VoidV)) compiled-vals) env))
(for-each (lambda ([name : Symbol] [compiled-val : (ENV -> VAL)])
(set-box! (lookup name newenv) (compiled-val newenv)))
names compiled-vals)
newenv)
(: lookup : Symbol ENV -> (Boxof VAL))
;; lookup a symbol in an environment, frame by frame,
;; 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)]
[(FrameEnv frame rest)
(let ([cell (assq name frame)])
(if cell
(second cell)
(lookup name rest)))]))
[(EmptyEnv) (error 'lookup "no binding for ~s" name)]
[(FrameEnv frame rest)
(let ([cell (assq name frame)])
(if cell
(second cell)
(lookup name rest)))]))
(: unwrap-rktv : VAL -> Any)
;; helper for `racket-func->prim-val': unwrap a RktV wrapper in
;; preparation to be sent to the primitive function
(define (unwrap-rktv x)
(cases x
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" x)]))
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" x)]))
(: racket-func->prim-val : Function -> (Boxof VAL))
;; converts a racket function to a primitive evaluator function
@@ -164,7 +178,7 @@
(define (racket-func->prim-val racket-func)
(define list-func (make-untyped-list-function racket-func))
(box (PrimV (lambda (args)
(RktV (list-func (map unwrap-rktv args)))))))
(RktV (list-func (map unwrap-rktv args)))))))
;; The global environment has a few primitives:
(: global-environment : ENV)
@@ -177,59 +191,177 @@
(list '> (racket-func->prim-val >))
(list '= (racket-func->prim-val =))
;; values
(list 'true (box (RktV #t)))
(list 'true (box (RktV #t)))
(list 'false (box (RktV #f)))
(list 'void (box (VoidV))))
(EmptyEnv)))
;;; ----------------------------------------------------------------
;;; Evaluation
(: compiler-enabled? : (Boxof Boolean))
(define compiler-enabled? (box #f))
(: eval : TOY ENV -> VAL)
;; evaluates TOY expressions
(define (eval expr env)
;; convenient helper
(: eval* : TOY -> VAL)
(define (eval* expr) (eval expr env))
(: ensure-compiler-enabled! : Symbol -> Void)
(define (ensure-compiler-enabled! who)
(if (unbox compiler-enabled?)
(void)
(error who "compiler is not enabled")))
(: run-compiled-body : (Listof (ENV -> VAL)) ENV -> VAL)
; Compile a body of expressions.
(define (run-compiled-body compiled env)
(if (null? compiled)
(error 'compile "empty body")
(if (null? (rest compiled))
((first compiled) env)
(let ([_ ((first compiled) env)]) ; We've side effects in this language.
(run-compiled-body (rest compiled) env)))))
(: compile-body : (Listof TOY) -> (ENV -> VAL))
;; Compile a sequence of body expressions into runtime sequencing code.
(define (compile-body body)
(ensure-compiler-enabled! 'compile-body)
(define compiled-body (map compile body))
(lambda ([env : ENV])
(run-compiled-body compiled-body env)))
; Convenient helper for running compiled code.
(: caller : ENV -> (ENV -> VAL) -> VAL)
(define (caller env)
(lambda ([compiled : (ENV -> VAL)]) (compiled env)))
(: compile : TOY -> (ENV -> VAL))
;; compileuates TOY expressions.
(define (compile expr)
(ensure-compiler-enabled! 'compile)
(cases expr
[(Num n) (RktV n)]
[(Id name) (unbox (lookup name env))]
[(Bind names exprs bound-body)
(eval bound-body (extend names (map eval* exprs) env))]
[(Bindrec names exprs bound-body)
(eval bound-body (extend-rec names exprs env))]
[(Fun names bound-body)
(FunV names bound-body env)]
[(Call fun-expr arg-exprs)
(let ([fval (eval* fun-expr)]
[arg-vals (map eval* arg-exprs)])
(cases fval
[(PrimV proc) (proc arg-vals)]
[(FunV names body fun-env)
(eval body (extend names arg-vals fun-env))]
[else (error 'eval "function call with a non-function: ~s"
fval)]))]
[(If cond-expr then-expr else-expr)
(eval* (if (cases (eval* cond-expr)
[(RktV v) v] ; Racket value => use as boolean
[else #t]) ; other values are always true
then-expr
else-expr))]
[(Set thing as)
(set-box! (lookup thing env) (eval* as)) ; We are not a lazy language.
(VoidV)]))
[(Num n) (λ ([_ : ENV]) (RktV n))]
[(Id name) (λ ([env : ENV]) (unbox (lookup name env)))]
[(Bind names exprs body)
(define compiled-exprs (map compile exprs))
(define compiled-body (compile-body body))
(λ ([env : ENV])
(compiled-body
(extend names
(map (caller env) compiled-exprs)
env)))]
[(Bindrec names exprs body)
(define compiled-exprs (map compile exprs))
(define compiled-body (compile-body body))
(λ ([env : ENV])
(compiled-body (extend-rec names compiled-exprs env)))]
[(Fun names body)
(define compiled-body (compile-body body))
(λ ([env : ENV]) (FunV names compiled-body #f env))]
[(Rfun names body)
(define compiled-body (compile-body body))
(λ ([env : ENV]) (FunV names compiled-body #t env))]
[(Call fun-expr arg-exprs)
(define compiled-fun (compile fun-expr))
(define compiled-args (map compile arg-exprs))
(define compiled-get-boxes (compile-get-boxes arg-exprs))
(λ ([env : ENV])
(let ([fval (compiled-fun env)]
[arg-vals-thunk
(lambda ()
(map (caller env) compiled-args))]) ; THunk.
(cases fval
[(PrimV proc) (proc (arg-vals-thunk))]
[(FunV names body ref? fun-env)
(if ref?
(compile-rfun names compiled-get-boxes body env fun-env)
(body (extend names (arg-vals-thunk) fun-env)))]
[else (error 'compile "function call with a non-function: ~s"
fval)])))]
[(If cond-expr then-expr else-expr)
(define compiled-cond (compile cond-expr))
(define compiled-then (compile then-expr))
(define compiled-else (compile else-expr))
(λ ([env : ENV])
(if (cases (compiled-cond env)
[(RktV v) v] ; Racket value => use as boolean
[else #t]) ; other values are always true
(compiled-then env)
(compiled-else env)))]
[(Set thing as)
(define compiled-as (compile as))
(λ ([env : ENV])
(set-box! (lookup thing env) (compiled-as env))
(VoidV))]))
(: compile-rfun : (Listof Symbol) (ENV -> (Listof (Boxof VAL))) (ENV -> VAL) ENV ENV -> VAL)
; Compile an RFun.
(define (compile-rfun params get-boxes body callerenv calleeenv)
(body (raw-extend params (get-boxes callerenv) calleeenv)))
(: compile-get-boxes : (Listof TOY) -> (ENV -> (Listof (Boxof VAL))))
; Utility for applying rfun.
(define (compile-get-boxes exprs)
(ensure-compiler-enabled! 'compile-get-boxes)
(: compile-getter : TOY -> (ENV -> (Boxof VAL)))
(define (compile-getter expr)
(cases expr
[(Id name) (lambda ([env : ENV]) (lookup name env))]
[else
(lambda ([_ : ENV]) (error 'compile-get-boxes "non-identifier"))]))
(let ([getters (map compile-getter exprs)])
(lambda ([env : ENV])
(map (lambda ([getter : (ENV -> (Boxof VAL))])
(getter env))
getters))))
(: run : String -> Any)
;; evaluate a TOY program contained in a string
(define (run str)
(let ([result (eval (parse str) global-environment)])
(define parsed (parse str))
(set-box! compiler-enabled? #t)
(define compiled (compile parsed))
(set-box! compiler-enabled? #f)
(let ([result (compiled global-environment)])
(cases result
[(RktV v) v]
[else (error 'run "evaluation returned a bad value: ~s"
result)])))
[(RktV v) v]
[else (error 'run "evaluation returned a bad value: ~s"
result)])))
;;; ----------------------------------------------------------------
;;; Tests
(test (run "{{rfun {x} x} {/ 4 0}}") =error> "non-identifier")
(test (run "{5 {/ 6 0}}") =error> "non-function")
(test (run "
{bind
{
{swap!
{rfun {x y}
{bind {{tmp x}}
{set! x y}
{set! y tmp}
}
}
}
{a 1}
{b 2}
}
{swap! a b}
{+ a {* 10 b}}
}") => 12)
(test (run "{bind {{make-counter
{fun {}
{bind {{c 0}}
{fun {}
{set! c {+ 1 c}}
c}}}}}
{bind {{c1 {make-counter}}
{c2 {make-counter}}}
{* {c1} {c1} {c2} {c1}}}}")
=> 6)
(test (run "{bindrec {{foo {fun {}
{set! foo {fun {} 2}}
1}}}
{+ {foo} {* 10 {foo}}}}")
=> 21)
(test (run "{bindrec {{fact {fun {n}
{if {= 0 n}
@@ -237,7 +369,7 @@
{* n {fact {- n 1}}}}}}}
{fact 5}}")
=> 120)
=> 120)
(test (run "
{bind {{x 10}}
@@ -273,18 +405,25 @@
=> 124)
;; More tests for complete coverage
(test (run "{bind x 5 x}") =error> "bad `bind' syntax")
(test (run "{fun x x}") =error> "bad `fun' syntax")
(test (run "{if x}") =error> "bad `if' syntax")
(test (run "{}") =error> "bad syntax")
(test (run "{bind {{x 5} {x 5}} x}") =error> "duplicate*bind*names")
(test (run "{fun {x x} x}") =error> "duplicate*fun*names")
(test (run "{+ x 1}") =error> "no binding for")
(test (run "{bind x 5 x}") =error> "bad `bind' syntax")
(test (run "{fun x x}") =error> "parse-sexpr: bad function syntax in (fun x x)")
(test (run "{if x}") =error> "bad `if' syntax")
(test (run "{}") =error> "bad syntax")
(test (run "{bind {{x 5} {x 5}} x}") =error> "parse-sexpr: duplicate `bind' names: (x x)")
(test (run "{fun {x x} x}") =error> "parse-sexpr: bad parameters defined for function in (fun (x x) x)")
(test (run "{+ x 1}") =error> "no binding for")
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
(test (run "{+ 1 {fun {x} x}}") =error> "bad input")
(test (run "{1 2}") =error> "with a non-function")
(test (run "{{fun {x} x}}") =error> "arity mismatch")
(test (run "{if {< 4 5} 6 7}") => 6)
(test (run "{if {< 5 4} 6 7}") => 7)
(test (run "{if + 6 7}") => 6)
(test (run "{fun {x} x}") =error> "returned a bad value")
(test (run "{1 2}") =error> "with a non-function")
(test (run "{{fun {x} x}}") =error> "arity mismatch")
(test (run "{if {< 4 5} 6 7}") => 6)
(test (run "{if {< 5 4} 6 7}") => 7)
(test (run "{if + 6 7}") => 6)
(test (run "{fun {x} x}") =error> "returned a bad value")
(test (compile (Num 1)) =error> "compiler is not enabled")
(test (compile-body (list (Num 1))) =error> "compiler is not enabled")
(test (compile-get-boxes (list (Id 'x))) =error> "compiler is not enabled")
(test (run "{bind {{if 5}} if}") =error> "parse-sexpr: bad word found in `bind' : (if)")
(test (run "{fun {if} if}") =error> "parse-sexpr: bad words found in function parameter names in (fun (if) if)")