Getting more from Sloth
As we’ve seen, using strict
in places where we need an actual value
rather than a delayed promise is enough to get a working lazy
evaluator. Our current implementation assumes that all primitive
functions need strict values, therefore the argument values are all
passed through the strict
function — but this is not always the
case. Specifically, if we have constructor functions, then we don’t
need (and usually don’t want) to force the promises. This is basically
what allows us to use infinite lists in Lazy Racket: the fact that
list
and cons
do not require forcing their arguments.
To allow some primitive functions to consume strict values and some to
leave them as is, we’re going to change racket-func->prim-val
and add
a flag that indicates whether the primitive function is strict or not.
Obviously, we also need to move the strict
call around arguments to a
primitive function application into the racket-func->prim-val
generated function — which simplifies the Call
case in eval
(we go
from (proc (map strict arg-vals)) back to (proc arg-vals)). The new
code for racket-func->prim-val
and its helper is:
(: unwrap-rktv : VAL -> Any)
;; helper for `racket-func->prim-val': strict and unwrap a RktV
;; wrapper in preparation to be sent to the primitive function
(define (unwrap-rktv x)
(let ([s (strict x)])
(cases s
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" s)])))
(: racket-func->prim-val : Function Boolean -> VAL)
;; converts a racket function to a primitive evaluator function ...
(define (racket-func->prim-val racket-func strict?)
(define list-func (make-untyped-list-function racket-func))
(PrimV (lambda (args)
(let ([args (if strict?
(map unwrap-rktv args)
args)]) ;*** use values as is!
(RktV (list-func args))))))
We now need to annotate the primitives in the global environment, as
well as add a few constructors:
;; The global environment has a few primitives:
(: global-environment : ENV)
(define global-environment
(FrameEnv (list (list '+ (racket-func->prim-val + #t))
(list '- (racket-func->prim-val - #t))
(list '* (racket-func->prim-val * #t))
(list '/ (racket-func->prim-val / #t))
(list '< (racket-func->prim-val < #t))
(list '> (racket-func->prim-val > #t))
(list '= (racket-func->prim-val = #t))
;; note flags:
(list 'cons (racket-func->prim-val cons #f))
(list 'list (racket-func->prim-val list #f))
(list 'first (racket-func->prim-val car #t)) ;**
(list 'rest (racket-func->prim-val cdr #t)) ;**
(list 'null? (racket-func->prim-val null? #t))
;; values
(list 'true (RktV #t))
(list 'false (RktV #f))
(list 'null (RktV null)))
(EmptyEnv)))
Note that this last change raises a subtle type issue: we’re actually
abusing the Racket list
and cons
constructors to hold Sloth values.
One way in which this becomes a problem is the current assumption that a
primitive function always returns a Racket value (it is always wrapped
in a RktV
) — but this is no longer the case for first
and rest
:
when we use
{cons 1 null}
in Sloth, the resulting value will be
(RktV (cons (ExprV (Num 1) ...) (ExprV (Id null) ...)))
This leads to two problems: first, if we use Racket’s first
and
rest
, they will complain (throw a runtime error) since the input value
is not a proper list (it’s a pair that has a non-list value in its
tail). To resolve that, we use the more primitive car
and cdr
functions to implement Sloth’s first
and rest
.
The second problem happens when we try and grab the first value of this
{first {cons 1 null}}
we will eventually get back the ExprV
and wrap it in a RktV
:
(RktV (ExprV (Num 1) ...))
and finally run
will strip off the RktV
and return the ExprV
. A
solution to this is to make our first
and rest
functions return a
value without wrapping it in a RktV
— we can identify this
situation by the fact that the returned value is already a VAL instead
of some other Racket value. We can identify such values with the VAL?
predicate that gets defined by our define-type
, implemented by a new
wrap-in-val
helper:
(: unwrap-rktv : VAL -> Any)
;; helper for `racket-func->prim-val': strict and unwrap a RktV
;; wrapper in preparation to be sent to the primitive function
(define (unwrap-rktv x)
(let ([s (strict x)])
(cases s
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" s)])))
(: wrap-in-val : Any -> VAL)
;; helper that ensures a VAL output using RktV wrapper when needed,
;; but leaving as is otherwise
(define (wrap-in-val x)
(if (VAL? x) x (RktV x)))
(: racket-func->prim-val : Function Boolean -> VAL)
;; converts a racket function to a primitive evaluator function ...
(define (racket-func->prim-val racket-func strict?)
(define list-func (make-untyped-list-function racket-func))
(PrimV (lambda (args)
(let ([args (if strict? (map unwrap-rktv args) args)])
(wrap-in-val (list-func args))))))
Note that we don’t need to worry about the result being an ExprV
—
that will eventually be taken care of by strict
.
The complete Sloth code follows. It can be used to do the same fun
things we did with Lazy Racket.
▶#lang pl
;;; ----------------------------------------------------------------
;;; Syntax
#| The BNF:
<SLOTH> ::= <num>
| <id>
| { bind {{ <id> <SLOTH> } ... } <SLOTH> }
| { fun { <id> ... } <SLOTH> }
| { if <SLOTH> <SLOTH> <SLOTH> }
| { <SLOTH> <SLOTH> ... }
|#
;; A matching abstract syntax tree datatype:
(define-type SLOTH
[Num Number]
[Id Symbol]
[Bind (Listof Symbol) (Listof SLOTH) SLOTH]
[Fun (Listof Symbol) SLOTH]
[Call SLOTH (Listof SLOTH)]
[If SLOTH SLOTH SLOTH])
(: unique-list? : (Listof Any) -> Boolean)
;; Tests whether a list is unique, guards Bind and Fun values.
(define (unique-list? xs)
(or (null? xs)
(and (not (member (first xs) (rest xs)))
(unique-list? (rest xs)))))
(: parse-sexpr : Sexpr -> SLOTH)
;; parses s-expressions into SLOTHs
(define (parse-sexpr sexpr)
(match sexpr
[(number: n) (Num n)]
[(symbol: name) (Id name)]
[(cons 'bind more)
(match sexpr
[(list 'bind (list (list (symbol: names) (sexpr: nameds))
...)
body)
(if (unique-list? names)
(Bind names (map parse-sexpr nameds) (parse-sexpr body))
(error 'parse-sexpr "duplicate `bind' names: ~s" names))]
[else (error 'parse-sexpr "bad `bind' syntax in ~s" sexpr)])]
[(cons 'fun more)
(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)])]
[(cons 'if more)
(match sexpr
[(list 'if cond then else)
(If (parse-sexpr cond)
(parse-sexpr then)
(parse-sexpr else))]
[else (error 'parse-sexpr "bad `if' syntax in ~s" sexpr)])]
[(list fun args ...) ; other lists are applications
(Call (parse-sexpr fun)
(map parse-sexpr args))]
[else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
(: parse : String -> SLOTH)
;; Parses a string containing an SLOTH expression to a SLOTH AST.
(define (parse str)
(parse-sexpr (string->sexpr str)))
;;; ----------------------------------------------------------------
;;; Values and environments
(define-type ENV
[EmptyEnv]
[FrameEnv FRAME ENV])
;; a frame is an association list of names and values.
(define-type FRAME = (Listof (List Symbol VAL)))
(define-type VAL
[RktV Any]
[FunV (Listof Symbol) SLOTH ENV]
[ExprV SLOTH ENV]
[PrimV ((Listof VAL) -> VAL)])
(: extend : (Listof Symbol) (Listof VAL) ENV -> ENV)
;; extends an environment with a new frame.
(define (extend names values env)
(if (= (length names) (length values))
(FrameEnv (map (lambda ([name : Symbol] [val : VAL])
(list name val))
names values)
env)
(error 'extend "arity mismatch for names: ~s" names)))
(: lookup : Symbol ENV -> 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)))]))
(: unwrap-rktv : VAL -> Any)
;; helper for `racket-func->prim-val': strict and unwrap a RktV
;; wrapper in preparation to be sent to the primitive function
(define (unwrap-rktv x)
(let ([s (strict x)])
(cases s
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" s)])))
(: wrap-in-val : Any -> VAL)
;; helper that ensures a VAL output using RktV wrapper when needed,
;; but leaving as is otherwise
(define (wrap-in-val x)
(if (VAL? x) x (RktV x)))
(: racket-func->prim-val : Function Boolean -> VAL)
;; converts a racket function to a primitive evaluator function
;; which is a PrimV holding a ((Listof VAL) -> VAL) function.
;; (the resulting function will use the list function as is,
;; and it is the list function's responsibility to throw an error
;; if it's given a bad number of arguments or bad input types.)
(define (racket-func->prim-val racket-func strict?)
(define list-func (make-untyped-list-function racket-func))
(PrimV (lambda (args)
(let ([args (if strict? (map unwrap-rktv args) args)])
(wrap-in-val (list-func args))))))
;; The global environment has a few primitives:
(: global-environment : ENV)
(define global-environment
(FrameEnv (list (list '+ (racket-func->prim-val + #t))
(list '- (racket-func->prim-val - #t))
(list '* (racket-func->prim-val * #t))
(list '/ (racket-func->prim-val / #t))
(list '< (racket-func->prim-val < #t))
(list '> (racket-func->prim-val > #t))
(list '= (racket-func->prim-val = #t))
;; note flags:
(list 'cons (racket-func->prim-val cons #f))
(list 'list (racket-func->prim-val list #f))
(list 'first (racket-func->prim-val car #t))
(list 'rest (racket-func->prim-val cdr #t))
(list 'null? (racket-func->prim-val null? #t))
;; values
(list 'true (RktV #t))
(list 'false (RktV #f))
(list 'null (RktV null)))
(EmptyEnv)))
;;; ----------------------------------------------------------------
;;; Evaluation
(: strict : VAL -> VAL)
;; forces a (possibly nested) ExprV promise, returns a VAL that is
;; not an ExprV
(define (strict val)
(cases val
[(ExprV expr env) (strict (eval expr env))]
[else val]))
(: eval : SLOTH ENV -> VAL)
;; evaluates SLOTH expressions
(define (eval expr env)
;; convenient helper
(: eval* : SLOTH -> VAL)
(define (eval* expr) (ExprV expr env))
(cases expr
[(Num n) (RktV n)]
[(Id name) (lookup name env)]
[(Bind names exprs bound-body)
(eval bound-body (extend names (map eval* exprs) env))]
[(Fun names bound-body)
(FunV names bound-body env)]
[(Call fun-expr arg-exprs)
(let ([fval (strict (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 (strict (eval* cond-expr))
[(RktV v) v] ; Racket value => use as boolean
[else #t]) ; other values are always true
then-expr
else-expr))]))
(: run : String -> Any)
;; evaluate a SLOTH program contained in a string
(define (run str)
(let ([result (strict (eval (parse str) global-environment))])
(cases result
[(RktV v) v]
[else (error 'run "evaluation returned a bad value: ~s"
result)])))
;;; ----------------------------------------------------------------
;;; Tests
(test (run "{{fun {x} {+ x 1}} 4}")
=> 5)
(test (run "{bind {{add3 {fun {x} {+ x 3}}}} {add3 1}}")
=> 4)
(test (run "{bind {{add3 {fun {x} {+ x 3}}}
{add1 {fun {x} {+ x 1}}}}
{bind {{x 3}} {add1 {add3 x}}}}")
=> 7)
(test (run "{bind {{identity {fun {x} x}}
{foo {fun {x} {+ x 1}}}}
{{identity foo} 123}}")
=> 124)
(test (run "{bind {{x 3}}
{bind {{f {fun {y} {+ x y}}}}
{bind {{x 5}}
{f 4}}}}")
=> 7)
(test (run "{{{fun {x} {x 1}}
{fun {x} {fun {y} {+ x y}}}}
123}")
=> 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 "{+ 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 laziness
(test (run "{{fun {x} 1} {/ 9 0}}") => 1)
(test (run "{{fun {x} 1} {{fun {x} {x x}} {fun {x} {x x}}}}") => 1)
(test (run "{bind {{x {{fun {x} {x x}} {fun {x} {x x}}}}} 1}") => 1)
;; Test lazy constructors
(test (run "{bind {{l {list 1 {/ 9 0} 3}}}
{+ {first l} {first {rest {rest l}}}}}")
=> 4)
;;; ----------------------------------------------------------------
Implementing Call by Need
As we have seen, there are a number of advantages for lazy evaluation,
but its main disadvantage is the fact that it is extremely inefficient,
to the point of rendering lots of programs impractical, for example, in:
{bind {{x {+ 4 5}}}
{bind {{y {+ x x}}}
y}}
we end up adding 4 and 5 twice. In other words, we don’t suffer from
textual redundancy (each expression is written once), but we don’t avoid
dynamic redundancy. We can get it back by simply caching evaluation
results, using a box that will be used to remember the results. The box
will initially hold #f
, and it will change to hold the VAL that
results from evaluation:
(define-type VAL
[RktV Any]
[FunV (Listof Symbol) SLOTH ENV]
[ExprV SLOTH ENV (Boxof (U #f VAL))] ;*** new: mutable cache field
[PrimV ((Listof VAL) -> VAL)])
We need a utility function to create an evaluation promise, because when
an ExprV
is created, its initial cache box needs to be initialized.
(: eval-promise : SLOTH ENV -> VAL)
;; used instead of `eval' to create an evaluation promise
(define (eval-promise expr env)
(ExprV expr env (box #f)))
(And note that Typed Racket needs to figure out that the #f
in this
definition has a type of (U #f VAL)
and not just #f
.)
This eval-promise
is used instead of ExprV
in eval. Finally,
whenever we force such an ExprV
promise, we need to check if it was
already evaluated, otherwise force it and cache the result. This is
simple to do since there is a single field that is used both as a flag
and a cached value:
(: strict : VAL -> VAL)
;; forces a (possibly nested) ExprV promise, returns a VAL that is
;; not an ExprV
(define (strict val)
(cases val
[(ExprV expr env cache)
(or (unbox cache)
(let ([val* (strict (eval expr env))])
(set-box! cache val*)
val*))]
[else val]))
But note that this makes using side-effects in our interpreter even more
confusing. (It was true with call-by-name too.)
The resulting code follows.
▶;; A call-by-need version of the SLOTH interpreter
#lang pl
;;; ----------------------------------------------------------------
;;; Syntax
#| The BNF:
<SLOTH> ::= <num>
| <id>
| { bind {{ <id> <SLOTH> } ... } <SLOTH> }
| { fun { <id> ... } <SLOTH> }
| { if <SLOTH> <SLOTH> <SLOTH> }
| { <SLOTH> <SLOTH> ... }
|#
;; A matching abstract syntax tree datatype:
(define-type SLOTH
[Num Number]
[Id Symbol]
[Bind (Listof Symbol) (Listof SLOTH) SLOTH]
[Fun (Listof Symbol) SLOTH]
[Call SLOTH (Listof SLOTH)]
[If SLOTH SLOTH SLOTH])
(: unique-list? : (Listof Any) -> Boolean)
;; Tests whether a list is unique, guards Bind and Fun values.
(define (unique-list? xs)
(or (null? xs)
(and (not (member (first xs) (rest xs)))
(unique-list? (rest xs)))))
(: parse-sexpr : Sexpr -> SLOTH)
;; parses s-expressions into SLOTHs
(define (parse-sexpr sexpr)
(match sexpr
[(number: n) (Num n)]
[(symbol: name) (Id name)]
[(cons 'bind more)
(match sexpr
[(list 'bind (list (list (symbol: names) (sexpr: nameds))
...)
body)
(if (unique-list? names)
(Bind names (map parse-sexpr nameds) (parse-sexpr body))
(error 'parse-sexpr "duplicate `bind' names: ~s" names))]
[else (error 'parse-sexpr "bad `bind' syntax in ~s" sexpr)])]
[(cons 'fun more)
(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)])]
[(cons 'if more)
(match sexpr
[(list 'if cond then else)
(If (parse-sexpr cond)
(parse-sexpr then)
(parse-sexpr else))]
[else (error 'parse-sexpr "bad `if' syntax in ~s" sexpr)])]
[(list fun args ...) ; other lists are applications
(Call (parse-sexpr fun)
(map parse-sexpr args))]
[else (error 'parse-sexpr "bad syntax in ~s" sexpr)]))
(: parse : String -> SLOTH)
;; Parses a string containing an SLOTH expression to a SLOTH AST.
(define (parse str)
(parse-sexpr (string->sexpr str)))
;;; ----------------------------------------------------------------
;;; Values and environments
(define-type ENV
[EmptyEnv]
[FrameEnv FRAME ENV])
;; a frame is an association list of names and values.
(define-type FRAME = (Listof (List Symbol VAL)))
(define-type VAL
[RktV Any]
[FunV (Listof Symbol) SLOTH ENV]
[ExprV SLOTH ENV (Boxof (U #f VAL))]
[PrimV ((Listof VAL) -> VAL)])
(: extend : (Listof Symbol) (Listof VAL) ENV -> ENV)
;; extends an environment with a new frame.
(define (extend names values env)
(if (= (length names) (length values))
(FrameEnv (map (lambda ([name : Symbol] [val : VAL])
(list name val))
names values)
env)
(error 'extend "arity mismatch for names: ~s" names)))
(: lookup : Symbol ENV -> 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)))]))
(: unwrap-rktv : VAL -> Any)
;; helper for `racket-func->prim-val': strict and unwrap a RktV
;; wrapper in preparation to be sent to the primitive function
(define (unwrap-rktv x)
(let ([s (strict x)])
(cases s
[(RktV v) v]
[else (error 'racket-func "bad input: ~s" s)])))
(: wrap-in-val : Any -> VAL)
;; helper that ensures a VAL output using RktV wrapper when needed,
;; but leaving as is otherwise
(define (wrap-in-val x)
(if (VAL? x) x (RktV x)))
(: racket-func->prim-val : Function Boolean -> VAL)
;; converts a racket function to a primitive evaluator function
;; which is a PrimV holding a ((Listof VAL) -> VAL) function.
;; (the resulting function will use the list function as is,
;; and it is the list function's responsibility to throw an error
;; if it's given a bad number of arguments or bad input types.)
(define (racket-func->prim-val racket-func strict?)
(define list-func (make-untyped-list-function racket-func))
(PrimV (lambda (args)
(let ([args (if strict? (map unwrap-rktv args) args)])
(wrap-in-val (list-func args))))))
;; The global environment has a few primitives:
(: global-environment : ENV)
(define global-environment
(FrameEnv (list (list '+ (racket-func->prim-val + #t))
(list '- (racket-func->prim-val - #t))
(list '* (racket-func->prim-val * #t))
(list '/ (racket-func->prim-val / #t))
(list '< (racket-func->prim-val < #t))
(list '> (racket-func->prim-val > #t))
(list '= (racket-func->prim-val = #t))
;; note flags:
(list 'cons (racket-func->prim-val cons #f))
(list 'list (racket-func->prim-val list #f))
(list 'first (racket-func->prim-val car #t))
(list 'rest (racket-func->prim-val cdr #t))
(list 'null? (racket-func->prim-val null? #t))
;; values
(list 'true (RktV #t))
(list 'false (RktV #f))
(list 'null (RktV null)))
(EmptyEnv)))
;;; ----------------------------------------------------------------
;;; Evaluation
(: eval-promise : SLOTH ENV -> VAL)
;; used instead of `eval' to create an evaluation promise
(define (eval-promise expr env)
(ExprV expr env (box #f)))
(: strict : VAL -> VAL)
;; forces a (possibly nested) ExprV promise, returns a VAL that is
;; not an ExprV
(define (strict val)
(cases val
[(ExprV expr env cache)
(or (unbox cache)
(let ([val* (strict (eval expr env))])
(set-box! cache val*)
val*))]
[else val]))
(: eval : SLOTH ENV -> VAL)
;; evaluates SLOTH expressions
(define (eval expr env)
;; convenient helper
(: eval* : SLOTH -> VAL)
(define (eval* expr) (eval-promise expr env))
(cases expr
[(Num n) (RktV n)]
[(Id name) (lookup name env)]
[(Bind names exprs bound-body)
(eval bound-body (extend names (map eval* exprs) env))]
[(Fun names bound-body)
(FunV names bound-body env)]
[(Call fun-expr arg-exprs)
(let ([fval (strict (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 (strict (eval* cond-expr))
[(RktV v) v] ; Racket value => use as boolean
[else #t]) ; other values are always true
then-expr
else-expr))]))
(: run : String -> Any)
;; evaluate a SLOTH program contained in a string
(define (run str)
(let ([result (strict (eval (parse str) global-environment))])
(cases result
[(RktV v) v]
[else (error 'run "evaluation returned a bad value: ~s"
result)])))
;;; ----------------------------------------------------------------
;;; Tests
(test (run "{{fun {x} {+ x 1}} 4}")
=> 5)
(test (run "{bind {{add3 {fun {x} {+ x 3}}}} {add3 1}}")
=> 4)
(test (run "{bind {{add3 {fun {x} {+ x 3}}}
{add1 {fun {x} {+ x 1}}}}
{bind {{x 3}} {add1 {add3 x}}}}")
=> 7)
(test (run "{bind {{identity {fun {x} x}}
{foo {fun {x} {+ x 1}}}}
{{identity foo} 123}}")
=> 124)
(test (run "{bind {{x 3}}
{bind {{f {fun {y} {+ x y}}}}
{bind {{x 5}}
{f 4}}}}")
=> 7)
(test (run "{{{fun {x} {x 1}}
{fun {x} {fun {y} {+ x y}}}}
123}")
=> 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 "{+ 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 laziness
(test (run "{{fun {x} 1} {/ 9 0}}") => 1)
(test (run "{{fun {x} 1} {{fun {x} {x x}} {fun {x} {x x}}}}") => 1)
(test (run "{bind {{x {{fun {x} {x x}} {fun {x} {x x}}}}} 1}") => 1)
;; Test lazy constructors
(test (run "{bind {{l {list 1 {/ 9 0} 3}}}
{+ {first l} {first {rest {rest l}}}}}")
=> 4)
;;; ----------------------------------------------------------------