#lang plai
(define … list) ;; enables us to use … in templates
(print-only-errors #t)
;; Resource-bounded tests
(require racket/sandbox)
;; test/timeout works like test, but fails if actual running
;; takes more than 5 seconds or more than 256mb of memory
(define-syntax-rule (test/timeout actual expected)
(test (with-limits 5 256 actual) expected))
;; CPSC311 2020 Winter Term 1
;; Assignment 3: State Your Needs
;; Revision 2: Oct 25, 2020
;; Released: Tuesday, October 20, 2020
;; Due: Tuesday, October 27, 2020 AoE
;; Student 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Name:
;; Student Number:
;; CWL:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Student 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Name:
;; Student Number:
;; CWL:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;; Assignment 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Lazy evaluation with caching and mutable variables
;; Your challenge in this assignment is to implement
;; LMV, a lazy language with mutable variables and caching.
;;
;; By *lazy*, we mean that:
;; when a function is called, the
;; arguments are not evaluated before the function body.
;; By *caching* we mean that:
;; function arguments are evaluated only once, and their side-effects
;; must only occur once.
;; By *mutable variables* we mean that:
;; environments map identifiers to store locations,
;; stores map locations to values, and operations can change store contents.
;; In LMV you can write {setvar x e} to evaluate e and mutate the value of
;; variable x to the value of e.
;;
;; Note that to implement our interpreter, we do not use Racket’s support for
;; mutation (variables or boxes) at all:
;; mutable variables and caching of lazy values is to be implemented
;; only using store-passing.
;;
;; LMV uses static scoping.
;;
;; To facilitate lazy evaluation, there is a new variant of Value
;; called exprV. This is like a closure, but it does not take an argument.
;; It is simply an expression paired with an environment.
;; You *will* need to use this.
;;
;; This assignment consists of four questions:
;; 1. Implement the interpreter case for function application.
;; This includes writing a helper function apply-value
;; 2. Implement the interpreter case for evaluating identifiers.
;; This is done using a helper function interp-id.
;; 3. Implement the interpreter case for variable mutation.
;; This includes writing a helper function interp-setvar.
;; 4. Implement the interpreter case for seqn. Note that in LMV,
;; seqn CANNOT be implemented as syntactic sugar.
;;
;; The signatures have been given to you, as well as
;; any interpreter cases that are the same as the Hannah language.
;; We have given some tests, but as always, it is important for you
;; to write your own.
;; LMV: Lazy language with Mutable Variables
(define-type LMV
[num (n number?)]
[add (lhs LMV?) (rhs LMV?)]
[sub (lhs LMV?) (rhs LMV?)]
[id (name symbol?)]
[setvar (name symbol?) (e LMV?)]
[fun (param symbol?) (body LMV?)]
[app (rator LMV?) (arg LMV?)]
[if0 (predicate LMV?) (consequent LMV?) (alternative LMV?)]
[fix (name symbol?) (body LMV?)]
[seqn (done LMV?) (produced LMV?)])
;; interp. expressions in a language that supports applying first-class
;; functions with lazy evaluation and caching of lazy expressions.
;; Its syntax is defined by the following BNF:
;;
;; (ARITHMETIC)
;;
;; | {+
;; | {-
;; (IDENTIFIERS)
;; | {with {
;; |
;; | {setvar
;; (CONDITIONALS)
;; | {if0
;; (FUNCTIONS)
;; | {
;; | {fun {
;; (RECURSION)
;; | {fix
;; | {fixFun
;; | (equiv. to {
;; (SEQUENCING)
;; | {seqn
;; with and fixFun are syntactic sugar
(define (with x named body) (app (fun x body) named))
(define (fixFun f x body) (fix f (fun x body)))
;;Note that seqn cannot be syntactic sugar.
;; Thinking about why this is true may help you.
;; template
(define (fn-for-lmv f)
(type-case LMV f
[num (n) (… n)]
[add (l r) (… (fn-for-lmv l)
(fn-for-lmv r))]
[sub (l r) (… (fn-for-lmv l)
(fn-for-lmv r))]
[id (x) (… x)]
[setvar (x e) (… x (fn-for-lmv e))]
[fun (x body) (… x
(fn-for-lmv body))]
[app (rator rand) (… (fn-for-lmv rator)
(fn-for-lmv rand))]
[if0 (p c a)
(… (fn-for-lmv p)
(fn-for-lmv c)
(fn-for-lmv a))]
[fix (x body) (… x
(fn-for-lmv body))]
[seqn (e1 e2) (… (fn-for-lmv e1)
(fn-for-lmv e2))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interpretation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Symbol tables are defined as in Hannah
;;
;; Procedural Symbol Tables
;; (formerly “environments”, but now used more broadly)
;;
;; (symtabof X) is symbol -> X
;; interp. bindings of identifiers to objects of type X
;; Effect: signals an error if given symbol has no binding
;; extend-symtab : (symtabof X) symbol X -> (symtabof X)
(define (extend-symtab symtab x0 v)
(λ (x)
(if (symbol=? x x0)
v
(symtab x))))
;; lookup: (symtabof X) symbol -> X
;; produce the binding associated with the given symbol
;; Effect: Signal an error if the given symbol has no binding
(define (lookup-symtab symtab x) (symtab x))
;;
;; Environments as symbol tables (just a wrapper)
;;
;; (envof X) is (symtabof X)
;; interp. environment representation for lexically scoped identifiers
;; empty-env : (envof X)
;; an empty environment for lexical scoping (note the custom error msg)
;; Effect: signals an error if variable is not there
(define empty-env
(λ (x) (error ‘lookup-env “Unbound variable: ~a” x)))
;; (envof X) symbol X -> (envOf X)
(define extend-env extend-symtab)
;; (envof X) symbol -> X
;; produce the binding associated with the given symbol
;; Effect: Signal an error if the given symbol has no binding
(define lookup-env lookup-symtab)
;;
;; Stores as symbol tables (just a wrapper)
;;
;; (storeof X) is (symtabof X)
;; interp. stores represent bindings of locations to mutable values
;; (storeof X)
(define empty-store
(λ (x) (error ‘lookup-env “Unbound store location: ~a” x)))
;; (storeof X) symbol X -> (envOf X)
(define extend-store extend-symtab)
;; (storeof X) symbol -> X
;; produce the binding associated with the given symbol
;; Effect: Signal an error if the given symbol has no binding
(define lookup-store lookup-symtab)
;;
;; Interpreter Values
;;
;;
;; Values: description ADDED in rev. 2
;; These can be a number, a closure, or an unevaluated expression.
;; In hindsight, it might have been better to call this “StorableObject”,
;; to as to avoid confusion with EvaluatedValue.
;; But here we are.
(define-type Value
[numV (n number?)]
[funV (param symbol?) (body LMV?) (env procedure?)]
;; ASSIGNMENT 3: this is new!
;; an exprV is a value that stores an expression
;; to be evaluated later, and the environment in which
;; that expression is to be evaluated
[exprV (delayed LMV?) (env procedure?)])
;; EvaluatedValue: ADDED in rev. 2
;; EvaluatedValue is one of:
;; – (numV number)
;; – (funV symbol LMV (envof symbol))
;; interp. an evaluated value is a Value that isn’t an exprV.
#;
(define (fn-for-value v)
(type-case Value v
[numV (n) (… n)]
[funV (x body env) (… x
(fn-for-lmv body)
env)]
[exprV (expr env) (… (fn-for-lmv expr)
env)]))
(define (fn-for-evaluated-value v)
(type-case Value v
[numV (n) (… n)]
[funV (x body env) (… x
(fn-for-lmv body)
env)]
[else (error “Shouldn’t have exprV in evaluated value”)]))
;;
;; Self-reference Support
;;
;; BlackHole is just a dummy value that we put in the store
;; when evaluating the body of a fix.
;; These work like in Midterm 1.
(define-type BlackHole
[blackHole])
;; interp. a sentinel value for fix expressions for detecting premature
;; self-reference
(define ScaryDisneyMovieThe (blackHole))
;; StoreBinding is one of:
;; – BlackHole
;; – Value
;;
;; Note that we allow Value, not just EvaluatedValue
;; i.e. exprV may be in the store.
#;
(define (fn-for-store-binding sb)
(cond [(BlackHole? sb) (…)]
[else ;(Value? sb)
(fn-for-value sb)]))
;;
;; Concrete Environment and Store Datatypes
;;
;; Env is (envof symbol)
;; Store is (storeof StoreBinding)
;;
;; Interpretation Functions
;;
;; EvaluatedValue -> number
;; produce the number represented by the given value
;; Effect: signal an error if the value does not represent a number
(define (value->num v)
(type-case Value v
[numV (n) n]
[else (error ‘value->num “Bad number: ~a” v)]))
(test (value->num (numV 6)) 6)
(test (value->num (numV 9)) 9)
(test/exn (value->num (funV ‘x (id ‘x) empty-env)) “Bad number”)
;; (number number -> number) EvaluatedValue EvaluatedValue -> EvaluatedValue
;; apply num-op to the numbers represented by v1 and v2
;; Effect: signal an error if either argument does not represent a number
(define (num-binop-value num-op v1 v2)
(let ([n1 (value->num v1)]
[n2 (value->num v2)])
(numV (num-op n1 n2))))
(test (num-binop-value * (numV 5) (numV 6)) (numV 30))
(test/exn (num-binop-value * (numV 5) (funV ‘x (id ‘x) empty-env))
“Bad number”)
(test/exn (num-binop-value * (funV ‘x (id ‘x) empty-env) (numV 6))
“Bad number”)
(test/exn (num-binop-value * (funV ‘x (id ‘x) empty-env)
(funV ‘x (id ‘x) empty-env)) “Bad number”)
;; EvaluatedValue EvaluatedValue -> EvaluatedValue
;; produce the sum of two numbers
;; Effect: signal an error if either argument does not represent a number
(define (add-value v1 v2)
(num-binop-value + v1 v2))
(test (add-value (numV 5) (numV 6)) (numV 11))
(test/exn (add-value (numV 5) (funV ‘x (id ‘x) empty-env)) “Bad number”)
(test/exn (add-value (funV ‘x (id ‘x) empty-env) (numV 6)) “Bad number”)
(test/exn (add-value (funV ‘x (id ‘x) empty-env)
(funV ‘x (id ‘x) empty-env)) “Bad number”)
;; EvaluatedValue EvaluatedValue -> EvaluatedValue
;; produce the difference of two numbers
;; Effect: signal an error if either argument does not represent a number
(define (sub-value v1 v2)
(num-binop-value – v1 v2))
(test (sub-value (numV 5) (numV 6)) (numV -1))
(test/exn (sub-value (numV 5) (funV ‘x (id ‘x) empty-env)) “Bad number”)
(test/exn (sub-value (funV ‘x (id ‘x) empty-env) (numV 6)) “Bad number”)
(test/exn (sub-value (funV ‘x (id ‘x) empty-env)
(funV ‘x (id ‘x) empty-env)) “Bad number”)
;; EvaluatedValue -> boolean
;; produce true if v1 represents the number zero, else false
(define (zero-value? v)
(type-case Value v
[numV (n) (zero? n)]
[else #f]))
(test (zero-value? (numV 7)) #f)
(test (zero-value? (numV 0)) #t)
(test (zero-value? (funV ‘x (id ‘x) empty-env)) #f)
;; NOTE on interp-fix:
;; We use the technique from midterm1 to implement fix without using Racket
;; boxes: we interpret the body of the fix in an environment
;; extended with f, which points to a fresh location containing
;; a blackHole. On success, we return a store where the fresh location
;; contains the result of evaluating the body.
;; symbol LMV Env Store -> (list EvaluatedValue Store)
;; produce the result of interpreting {fix f body} with the given env and store
(define (interp-fix f body env store)
(let ([loc (gensym)])
(match-let ([`(,v ,store1)
(interp-lmv–acc body
(extend-env env f loc)
(extend-store store loc (blackHole)))])
(list v (extend-store store1 loc v)))))
;; interp-fix Examples below interp-lmv–acc because of mutual reference
;; ASSIGNMENT 3, PROBLEM 1(a):
;; Implement function application using lazy evaluation.
;; (See also interp-lmv-acc)
;; The argument to a function:
;; (1) must not be evaluated before the function body is evaluated; and
;; (2) must be evaluated at most once.
;; You will need to use exprV.
;; EvaluatedValue LMV Env Store -> (list EvaluatedValue Store)
;; produce the result of applying v1 to the expression earg, whose corresponding
;; environment is envCall
;; Effect: signal an error if v1 does not represent a function
;; EvaluatedValue: ADDED in rev. 2
;; EvaluatedValue is one of:
;; – (numV number)
;; – (funV symbol LMV (envof symbol))
(define (apply-value vfun earg envCall store)
(type-case Value vfun
[funV (x body env)
(let ([loc (gensym)])
(match-let ([`(,v ,store1)
(interp-lmv–acc body
(extend-env envCall x loc)
(extend-store store loc (lookup-loc(lookup-env envCall earg) store)))])))]
[exprV (delayed LMV?) (env procedure?)])
[else (error “v1 should represent a function”)])
;; apply-value EXAMPLES below interp-lmv–acc because of mutual reference
(define-type LMV
[num (n number?)]
[add (lhs LMV?) (rhs LMV?)]
[sub (lhs LMV?) (rhs LMV?)]
[id (name symbol?)]
[setvar (name symbol?) (e LMV?)]
[fun (param symbol?) (body LMV?)]
[app (rator LMV?) (arg LMV?)]
[if0 (predicate LMV?) (consequent LMV?) (alternative LMV?)]
[fix (name symbol?) (body LMV?)]
[seqn (done LMV?) (produced LMV?)])
;; apply-value examples
;; ADDED for rev. 2
;; Not full tests, since giving the result would give away some of the answers
(test (first (apply-value (funV ‘x (id ‘x) empty-env)
(num 10)
empty-env
empty-store))
(numV 10))
(test (first (apply-value (funV ‘x (id ‘x) empty-env)
(id ‘x)
(extend-env empty-env ‘x ‘locx)
(extend-store empty-store ‘locx (numV 10))))
(numV 10))
;; ASSIGNMENT 3: A helper function you might find useful
;; symbol Store -> EvaluatedValue
;; produce the value, if any, contained at the given location
;; Effect: signal an error in case of a black hole
(define (lookup-loc loc store)
(let ([v (lookup-store store loc)])
(cond
[(Value? v) v]
[else (error ‘black-hole “Nooooooooooooo…..!”)])))
;; ASSIGNMENT 3: Problem 2
;; Implement variable lookup, accomodating the fact that
;; (1) we might have expressions that was a function’s argument
;; that has not been evaluated yet
;; (2) each lazy expression should only be evaluated once
;; symbol Env Store -> (list EvaluatedValue Store)
;; produce the value bound to a given identifier
;; Effect: signal an error in case of a black hole
(define (interp-id x env store)
(list (numV 7) store)) ; stub
;; ASSIGNMENT 3: Problem 3 (a)
;; Implement variable mutation. (See also interp-lmv-acc)
;; Don’t overthink this one.
;; symbol EvaluatedValue Env Store -> (list EvaluatedValue Store)
;; assign the variable x to the value v
;; producing v and the resulting store.
;; Effect: NONE (changed rev. 2)
(define (interp-setvar x v env store)
(list v store)) ; stub
;; interp-lmv-acc : LMV Env Store -> (list EvaluatedValue Store)
;; Accumulator: env is Env
;; Invariant: env represents the bindings (in inside-out order)
;; of identifiers to values due to deferred substitutions
;; Accumulator: store is Store
;; Invariant: store represents the present contents of variables as they evolve
;; during interpretation
(define (interp-lmv–acc lmv env store)
(type-case LMV lmv
[num (n) (list (numV n) store)]
[add (l r)
(match-let ([`(,v1 ,store1) (interp-lmv–acc l env store)])
(match-let ([`(,v2 ,store2) (interp-lmv–acc r env store1)])
(list (add-value v1 v2) store2)))]
[sub (l r)
(match-let ([`(,v1 ,store1) (interp-lmv–acc l env store)])
(match-let ([`(,v2 ,store2) (interp-lmv–acc r env store1)])
(list (sub-value v1 v2) store2)))]
;; ASSIGNMENT 3 Problem 1(b)
;; The interpreter case for app
;; You should call apply-value.
[app (rator rand)
(… rator rand)]
;; Assignment 3 Problem 2(b)
;; The interpreter case for setvar
;; you should call interp-setvar.
;; This should be strict in its argument.
;; that is, e should be evaluated fully.
[setvar (x e) (… x e)]
;;Assignment 3: nothing more to implement for the id case
;; since it just calls interp-id
[id (x) (interp-id x env store)]
[fun (x body)
(list (funV x body env) store)] ;; this is a closure!
[if0 (p c a)
(match-let ([`(,v1 ,store1) (interp-lmv–acc p env store)])
(if (zero-value? v1)
(interp-lmv–acc c env store1)
(interp-lmv–acc a env store1)))]
[fix (f body)
(interp-fix f body env store)]
;; Assignment 3 Problem 4
;; Implement seqn
;; This should evaluate the first argument (including any side-effects),
;; discard the result,
;; then evaluate and produce the value of the second argument
[seqn (e1 e2)
(… e1 e2)]
))
;; interp-fix examples
(test/exn (interp-fix ‘f (id ‘f) empty-env empty-store) “No”)
(test/exn (interp-fix ‘f (add (num 7) (id ‘f)) empty-env empty-store) “No”)
(test
(match (interp-fix ‘f (fun ‘x (id ‘f)) empty-env empty-store)
[(list (funV ‘x (id ‘f) env^) store) #t]
[else #f])
#t)
;; interp-lmv : LMV -> EvaluatedValue
;; interpret the given lmv expression
;; EFFECTS: Signals an error in case of runtime type error.
(define (interp-lmv lmv)
(match-let ([`(,v1 ,store1) (interp-lmv–acc lmv empty-env empty-store)])
v1))
;; Using the built-in recursion
(test
(interp-lmv
(with ‘* (fixFun ‘mult ‘lhs
(fun ‘rhs
(if0 (id ‘rhs)
(num 0)
(add (id ‘lhs) (app (app (id ‘mult)
(id ‘lhs))
(sub (id ‘rhs)
(num 1)))))))
(app (app (id ‘*)
(num 20))
(num 3))))
(numV 60))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parsing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lmv-focused-sexp (lmvfs) is one of:
;; – number
;; – `{isnumz ,lmvfs}
;; – `{+ ,lmvfs ,lmvfs}
;; – `{- ,lmvfs ,lmvfs}
;; – `{with ,identifier ,lmvfs ,lmvfs
;; – identifier
;; – `{set-var ,identifier ,lmvfs} ;; !!! NEW THING!!!
;; – `{fun ,identifier lmvfs}
;; – `{isfunz ,lmvfs}
;; – `{,lmvfs ,lmvfs}
;; – `{fix ,identifier ,lmvfs}
;; – `{fixFun ,identifier {,identifier} ,lmvfs}
;; – `{if0 ,lmvfs ,lmvfs ,lmvfs}
;; – “any other s-expression”
;; where identifier is any symbol except +, -, with, if0, or fun
;; interp. any s-expression, but with a focus on those that represent
;; LMV expressions.
(define (identifier? x)
(and (symbol? x)
(not (member x ‘(+ – with if0 fun fix fixFun seqn)))))
#;
(define (fn-for-lmv-focused-sexp sexp)
(match sexp
[`,n
#:when (number? n)
(… n)]
[`{isnumz ,sexp1} (… (fn-for-lmv-focused-sexp sexp1))]
[`{+ ,sexp1 ,sexp2}
(… (fn-for-lmv-focused-sexp sexp1)
(fn-for-lmv-focused-sexp sexp2))]
[`{- ,sexp1 ,sexp2}
(… (fn-for-lmv-focused-sexp sexp1)
(fn-for-lmv-focused-sexp sexp2))]
[`{with {,x ,sexp1} ,sexp2}
#:when (identifier? x)
(… x
(fn-for-lmv-focused-sexp sexp1)
(fn-for-lmv-focused-sexp sexp2))]
[`,x
#:when (identifier? x)
(… x)]
[`{setvar ,x ,sexp1} (… x (fn-for-lmv-focused-sexp sexp1))]
[`{if0 ,sexp1 ,sexp2 ,sexp3}
(… (fn-for-lmv-focused-sexp sexp1)
(fn-for-lmv-focused-sexp sexp2)
(fn-for-lmv-focused-sexp sexp3))]
[`{fun {,x} ,sexp1}
#:when (identifier? x)
(… x
(fn-for-lmv-focused-sexp sexp1))]
[`{isfunz ,sexp1} (… (fn-for-lmv-focused-sexp sexp1))]
[`{fix ,f ,sexp1}
#:when (identifier? f)
(… f
(fn-for-lmv-focused-sexp sexp1))]
[`{fixFun ,f {,x} ,sexp1}
#:when (and (identifier? f) (identifier? x))
(… f
x
(fn-for-lmv-focused-sexp sexp1))]
;; Notice that application is now the last focused case…
[`{,sexp1 ,sexp2}
(… (fn-for-lmv-focused-sexp sexp1)
(fn-for-lmv-focused-sexp sexp1))]
[else (… sexp)] ))
;; parse-expr : s-expression -> LMV
;; parse the given s-expression into a LMV expression
;; EFFECT: signals an error on failure
(define (parse-expr sexp)
(match sexp
[`,n #:when (number? n) (num n)]
[`{+ ,lhs ,rhs} (add (parse-expr lhs) (parse-expr rhs))]
[`{- ,lhs ,rhs} (sub (parse-expr lhs) (parse-expr rhs))]
[`{with {,id ,named-exp} ,body}
#:when (identifier? id)
;; desugar with into anonymous function application
(with id (parse-expr named-exp) (parse-expr body))]
[`,x #:when (identifier? x) (id x)]
[`{setvar ,x ,sexp1} (setvar x (parse-expr sexp1))]
[`{if0 ,pred ,conseq ,altern}
(if0 (parse-expr pred) (parse-expr conseq) (parse-expr altern))]
;; Notice that application is now last…
[`{fun {,x} ,sexp1}
#:when (identifier? x)
(fun x (parse-expr sexp1))]
[`{fix ,f ,sexp1}
#:when (identifier? f)
(fix f (parse-expr sexp1))]
[`{fixFun ,f {,x} ,sexp1}
#:when (and (identifier? f) (identifier? x))
;; desugar to fix and fun
(fixFun f x (parse-expr sexp1))]
[`{seqn ,sexp1 ,sexp2} (seqn (parse-expr sexp1) (parse-expr sexp2))]
[`{,rator-exp ,arg-exp}
(app (parse-expr rator-exp) (parse-expr arg-exp))]
[_ (error ‘parse-expr “bad expression ~a” sexp)]))
;;
;; PUTTING IT ALL TOGETHER
;;
;; produce the result of interpreting an s-expression as an LMV program
;; EFFECT: signals an error if interpretation signals a runtime error.
(define (interp-sexp sexp)
(interp-lmv (parse-expr sexp)))
(define crash ‘{fix x x})
(test/exn (interp-sexp crash) “”)
;; Basic laziness test
(test (interp-sexp `{with {x ,crash} 0}) (numV 0))
;;Ensure that free variables are properly captured
;;in thunks
(test (interp-sexp
`{with {x 5}
{with {f {fun {x} {+ x x}}}
{f {+ x 1}}}})
(numV 12))
;;Ensure that seqn respects order
(test (interp-sexp
`{with {x 5}
{seqn {setvar x 6}
{seqn {setvar x 7}
x}}})
(numV 7))
;;Ensure that setvar evaluates expression to the right
(test (interp-sexp
`{with {x 5}
{seqn {setvar x x}
x}})
(numV 5))
(test (interp-sexp
`{with {x 5}
{seqn {setvar x {+ x x}}
{seqn {setvar x {+ x x}}
x}}})
(numV 20))
;; Ensure side-effect of thunk is run at use-time, not call time
(test (interp-sexp
`{with {y 0}
{with {f {fun {x} {seqn {setvar y 20}
{seqn x
{+ x y}}}}}
{f {seqn {setvar y 10}
1}}}})
(numV 11))
;; Ensure side-effect of thunk is run only once
(test (interp-sexp
`{with {y 5}
{with {f {fun {x} {seqn x
{+ x y}} }}
{f {seqn {setvar y {+ y y}}
1}}}})
(numV 11))
;; Ensure we don’t have aliasing
;; provided that we have already evaluated the value of a variable
(test (interp-sexp
`{with {x 5}
{with {y x}
{seqn y
{seqn {setvar x 10}
y}}}})
(numV 5))
;; Ensure that the named-expr of a with is not evaluated
;; until the body of the with is evaluated
(test (interp-sexp
`{with {x 5}
{with {y x}
{seqn {setvar x 10}
y}}})
(numV 10))
(test (interp-sexp
`{with {x 5}
{with {y 9}
{seqn {setvar x {seqn {setvar y 7}
x}}
{seqn {setvar x 6}
y}}}}) (numV 7))
;; The explosion!
;; Ensure that we actually cache the value of a lazy expression
;; We use a timeout so that failing this test does not contribute
;; too much too the warming of the planet.
(test/timeout
(numV?
(interp-sexp
`{with {f {fixFun f {x}
{if0 x 2
{with {v {f {- x 1}}}
{+ v {+ v {+ v {+ v {+ v v}}}}}}}}}
{f 1000}})) true)