diff --git a/06-puwae/main.rkt b/06-puwae/main.rkt index 693cbd7..43c0b39 100644 --- a/06-puwae/main.rkt +++ b/06-puwae/main.rkt @@ -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) diff --git a/14-compilation-part-1/main.rkt b/14-compilation-part-1/main.rkt index 9813f22..e2629af 100644 --- a/14-compilation-part-1/main.rkt +++ b/14-compilation-part-1/main.rkt @@ -1,6 +1,5 @@ ;;; ---<<>>---------------------------------------------------- #lang pl - ;;; ---------------------------------------------------------------- ;;; Syntax @@ -10,6 +9,7 @@ | { bind {{ } ... } ... } | { bindrec {{ } ... } ... } | { fun { ... } ... } + | { rfun { ... } ... } | { ... } | { if } | { set! } @@ -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)")