; David Golombek
; 6.821 Pset #1 Programming Exercises
; 9/16/96
; Problem 3
; To handle the parsing of the pair, left, right, and dup commands we
; needed to add:
; In (define-datatype command ...
; add
($pair)
($left)
($right)
($add)
; In (define (pf-command sexp) ...
; add
( 'dup ($dup) )
( 'pair ($pair) )
( 'left ($left) )
( 'right ($right) )
; Although the dup was already there
; I decided to implement pairs simply as lists because of the
; ease this lent to extending beyond simple left and right (were this
; too be required). Thus,
; In (define-datatype den-val ...
; add
(list->den-val list)
; and in (define (unparse-value value) ...
((list->den-val l) (list->sexp l))
; and a proc
(define (with-list proc)
(with-value
(lambda (v)
(match v
((list->den-val t) (proc t))
(_ (error "Non-list where list expected"))))))
; so that these list/pairs are valid to leave on a stack, and can
; be matched.
; Problem 3 continued
; Then the commands pair/left/right can easily be implemented
; as:
; In (define (eval-command cmd) ...
; add
( ($pair) (with-value
(lambda (v1)
(with-value
(lambda (v2)
(push (list->den-val (list v1 v2))))))))
( ($left) (with-list
(lambda (top)
(push (car (cdr top))))))
( ($right) (with-list
(lambda (top)
(push (car top)))))
; dup had no real connection to the other parts of the problem, and
; was implemented without using any of the introduced functionality
( ($dup) (with-value
(lambda (v1)
(o (push v1) (push v1)))))
; Testing was rather straightforward, with
(1 2 pair left) -> 1
(1 2 pair right) -> 2
(5 dup 1 sub pop) -> 4
((dup exec) dup exec) -> non terminating
; Problem 4a
; The three functions are simply defined as
(define (dict-empty)
(lambda (i)
(error "No Match")))
(define (dict-bind symbol val dict)
(lambda (entry)
(if (eq? entry symbol)
val
(dict-lookup entry dict))))
(define (dict-lookup name dict)
(dict name))
; Problem 4b)
; Besides the given
(define-datatype state
(make-state stack dict))
; we need to define the make-state proc:
(define (make-state stack dict)
(make-constructor
(cons stack dict)))
; We then need to go through all of postfix.scm and fix any
; places that deal directly with the stack. This is
; luckily very few places (these are all listed as changes, with
; only the new form listed) :
; In (define-datatype den-val ...
(xform->den-val (-> (state) state))
; In (define (eval-program pgm) ..
(($prog seq) (top ((eval-commands seq) (empty-state))))
; Where the proc empty-state is
(define (empty-state) (make-state (empty-stack) (dict-empty)))
; Push must be redefined to deal with the new state concept
(define (push val)
(lambda (state)
(cons val (car state))))
; We must also modify with-value for the same reason
(define (with-value proc)
(lambda (state)
(match state
((make-state stack dict)
(match stack
((null) (error "Empty state"))
((cons v s) ((proc v) s)))))))
; Problem 4c)
; To handle I, get, and def, we are doing the parsing of new
; commands, as well as the extraction of the dictionary that
; is stored in state, and then calling the dictionary functions
; we created in 4a) with these parameters
; In (define-datatype command ...
; add
($def)
($get)
($symbol symbol)
; In (define (pf-command sexp) ...
; add
( 'def ($def) )
( 'get ($get) )
( (symbol->sexp s) ($symbol s) )
; The symbol matcher should come last, because otherwise it will
; match everything else. Given the wide variety of what is allowed
; to be a symbol, this must be the case. Only when you try to look
; up a non-added symbol in a dictionary will you get error messages
; about strange symbols in code.
; I, get, and def are then implemented as:
( ($symbol s) (push (symbol->den-val s)))
( ($def) (with-value
(lambda (v1)
(with-symbol
(lambda (symbol)
(lambda (state)
(match state
((make-state stack dict)
(make-state stack
(dict-bind symbol v1 dict))))
))))))
( ($get) (with-symbol
(lambda (symbol)
(lambda (state)
(match state
((make-state stack dict)
(make-state (cons (dict-lookup symbol dict)
stack) dict)))))))
; For test cases,
((dup exec) dup exec ; goes, and goes, and goes
(x 9 def x get) ; => 9
; Problem 5a)
(1 swap ; a n
(dup ; a n
(pair pair ; (a ( n))
dup right ; (a ( n)) ( n)
swap dup ; ( n) (a ( n)) (a ( n))
left swap ; ( n) a (a ( n))
right right mul ; ( n) (a*n)
swap dup ; (a*n) ( n) ( n)
left swap ; (a*n) ( n)
right 1 sub ; (a*n) (n-1)
swap ; (a*n) (n-1)
(dup exec)) ;
(pop pop (dup)) ; a
swap sel ; on stack: a n (big thing) (mul)
exec exec) ; leaves: (a*n) (n-1) or
; a
dup exec) ; then run it all
; Problem 5b)
(
(dup x swap def ; x = top of stack
(1)
(x get dup 1 sub ; x x-1
me get ; load this code
exec ; and exec
mul) ; multiply back up the tree
sel ; on x; (1) or (big section)
exec) ; exec which is appropriate
dup me swap def ; me = that block of code
exec) ; exec me