Start with store-with.rkt.(provided below). Use #plait In the starting program, the representation of the store grows every time that a boxs content is modified with set-box! Change the implementation of set-box! so that the old value of the box is dropped (i.e., replaced with the new value) instead of merely hidden by the outside-in search order of fetch. Example: (test (interp (parse `{let {[b {box 1}]} {begin {set-box! b 2} {unbox b}}}) mt-env mt-store) (v*s (numV 2) (override-store (cell 1 (numV 2)) mt-store))) 

#lang plait

(define-type-alias Location Number)

(define-type Value (numV [n : Number]) (closV [arg : Symbol] [body : Exp] [env : Env]) (boxV [l : Location]))

(define-type Exp (numE [n : Number]) (idE [s : Symbol]) (plusE [l : Exp] [r : Exp]) (multE [l : Exp] [r : Exp]) (letE [n : Symbol] [rhs : Exp] [body : Exp]) (lamE [n : Symbol] [body : Exp]) (appE [fun : Exp] [arg : Exp]) (boxE [arg : Exp]) (unboxE [arg : Exp]) (setboxE [bx : Exp] [val : Exp]) (beginE [l : Exp] [r : Exp]))

(define-type Binding (bind [name : Symbol] [val : Value]))

(define-type-alias Env (Listof Binding))

(define mt-env empty) (define extend-env cons)

(define-type Storage (cell [location : Location] [val : Value]))

(define-type-alias Store (Listof Storage)) (define mt-store empty) (define override-store cons)

(define-type Result (v*s [v : Value] [s : Store]))

;; parse ---------------------------------------- (define (parse [s : S-Exp]) : Exp (cond [(s-exp-match? `NUMBER s) (numE (s-exp->number s))] [(s-exp-match? `SYMBOL s) (idE (s-exp->symbol s))] [(s-exp-match? `{+ ANY ANY} s) (plusE (parse (second (s-exp->list s))) (parse (third (s-exp->list s))))] [(s-exp-match? `{* ANY ANY} s) (multE (parse (second (s-exp->list s))) (parse (third (s-exp->list s))))] [(s-exp-match? `{let {[SYMBOL ANY]} ANY} s) (let ([bs (s-exp->list (first (s-exp->list (second (s-exp->list s)))))]) (letE (s-exp->symbol (first bs)) (parse (second bs)) (parse (third (s-exp->list s)))))] [(s-exp-match? `{lambda {SYMBOL} ANY} s) (lamE (s-exp->symbol (first (s-exp->list (second (s-exp->list s))))) (parse (third (s-exp->list s))))] [(s-exp-match? `{box ANY} s) (boxE (parse (second (s-exp->list s))))] [(s-exp-match? `{unbox ANY} s) (unboxE (parse (second (s-exp->list s))))] [(s-exp-match? `{set-box! ANY ANY} s) (setboxE (parse (second (s-exp->list s))) (parse (third (s-exp->list s))))] [(s-exp-match? `{begin ANY ANY} s) (beginE (parse (second (s-exp->list s))) (parse (third (s-exp->list s))))] [(s-exp-match? `{ANY ANY} s) (appE (parse (first (s-exp->list s))) (parse (second (s-exp->list s))))] [else (error 'parse "invalid input")]))

;; with form ---------------------------------------- (define-syntax-rule (with [(v-id sto-id) call] body) (type-case Result call [(v*s v-id sto-id) body])) ;; interp ---------------------------------------- (define (interp [a : Exp] [env : Env] [sto : Store]) : Result (type-case Exp a [(numE n) (v*s (numV n) sto)] [(idE s) (v*s (lookup s env) sto)] [(plusE l r) (with [(v-l sto-l) (interp l env sto)] (with [(v-r sto-r) (interp r env sto-l)] (v*s (num+ v-l v-r) sto-r)))] [(multE l r) (with [(v-l sto-l) (interp l env sto)] (with [(v-r sto-r) (interp r env sto-l)] (v*s (num* v-l v-r) sto-r)))] [(letE n rhs body) (with [(v-rhs sto-rhs) (interp rhs env sto)] (interp body (extend-env (bind n v-rhs) env) sto-rhs))] [(lamE n body) (v*s (closV n body env) sto)] [(appE fun arg) (with [(v-f sto-f) (interp fun env sto)] (with [(v-a sto-a) (interp arg env sto-f)] (type-case Value v-f [(closV n body c-env) (interp body (extend-env (bind n v-a) c-env) sto-a)] [else (error 'interp "not a function")])))] [(boxE a) (with [(v sto-v) (interp a env sto)] (let ([l (new-loc sto-v)]) (v*s (boxV l) (override-store (cell l v) sto-v))))] [(unboxE a) (with [(v sto-v) (interp a env sto)] (type-case Value v [(boxV l) (v*s (fetch l sto-v) sto-v)] [else (error 'interp "not a box")]))] [(setboxE bx val) (with [(v-b sto-b) (interp bx env sto)] (with [(v-v sto-v) (interp val env sto-b)] (type-case Value v-b [(boxV l) (v*s v-v (override-store (cell l v-v) sto-v))] [else (error 'interp "not a box")])))] [(beginE l r) (with [(v-l sto-l) (interp l env sto)] (interp r env sto-l))]))

;; num+ and num* ---------------------------------------- (define (num-op [op : (Number Number -> Number)] [l : Value] [r : Value]) : Value (cond [(and (numV? l) (numV? r)) (numV (op (numV-n l) (numV-n r)))] [else (error 'interp "not a number")])) (define (num+ [l : Value] [r : Value]) : Value (num-op + l r)) (define (num* [l : Value] [r : Value]) : Value (num-op * l r))

(module+ test (test (num+ (numV 1) (numV 2)) (numV 3)) (test (num* (numV 2) (numV 3)) (numV 6)))

;; lookup ---------------------------------------- (define (lookup [n : Symbol] [env : Env]) : Value (type-case (Listof Binding) env [empty (error 'lookup "free variable")] [(cons b rst-env) (cond [(symbol=? n (bind-name b)) (bind-val b)] [else (lookup n rst-env)])]))

;; store operations ----------------------------------------

(define (new-loc [sto : Store]) : Location (+ 1 (max-address sto)))

(define (max-address [sto : Store]) : Location (type-case (Listof Storage) sto [empty 0] [(cons c rst-sto) (max (cell-location c) (max-address rst-sto))]))

(define (fetch [l : Location] [sto : Store]) : Value (type-case (Listof Storage) sto [empty (error 'interp "unallocated location")] [(cons c rst-sto) (if (equal? l (cell-location c)) (cell-val c) (fetch l rst-sto))]))