[FrontPage] [TitleIndex] [WordIndex

This is the code buffer from class, with small comments added. A better exposition -- but less suitable for cutting and pasting into your scheme buffer -- is at NotesSeptember7. There's also a second example here (not presented in class) which is a slightly more refined stack ADT implementation.

;; Defining the stack abstraction.
;; We'll use a simple representation in terms of lists.


;; Is the stack empty?

(define empty?
  (lambda (stack)
    (null? stack)))

;; The same procedure rewritten to use the
;; syntactically sugared form of define
;; (with a hidden lambda)

(define (empty? stack)
  (null? stack))

;; An alternative definition.
;; This works the same way in our examples,
;; but doesn't create a new procedure (lambda).

(define empty? null?)



;; Add an element to the stack; return the new stack

(define push
  (lambda (elt stac)     ;; note that it doesn't matter how we spell stac(k)
    (cons elt stac)))    ;; as long as the parameter matches the body


;; Remove an element from the stack; return the new stack

(define pop
  (lambda (stack)
    (cdr stack)))


;; Return the top element on the stack; don't change the stack

(define top
  (lambda (stack)
    (car stack)))


;; Some code to help us test the stack implementation
;; Reads from input, pushing each item onto the stack,
;; until it encounters the symbol end.
;; Returns the stack containing the input (in reverse order!)

(define stack-eg
    (lambda (stack)

      (let (( tmp (read)))    ;; In the body of the let, tmp will refer to whatever's returned by (read)

        (display stack)       ;; The results of these two expressions are discarded
        (newline)             ;; (lambda and let bodies contain implicit begins -- sequences --
                              ;; and return the value of their final expressions

        (if (eq? tmp 'end)    ;; This one's the final expression; keep pushing until 'end
            stack
            (stack-eg (push tmp stack))))))

Here is some additional code that we didn't get to. It uses a nicer form of data abstraction -- marking the stacks as such, etc -- but this complicates the implementation somewhat. Note also that we've added three new pieces of the stack contract -- make-stack, make-empty-stack, and stack? -- to help maintain the abstraction barrier.

The full set of changes::

The complete abstraction:

And the complete code (using implicit-lambda syntactically sugared define notation):

;; Create one.
;; See also make-empty-stack, towards the end of this code

(define (make-stack lst)
  (cons 'stack lst))


;; Internal (not part of the data abstraction) helper function

(define (stack-contents stack)
  (cdr stack))


;; Add element to stack; return this new stack

(define (stack-push elt stack)
  (make-stack (cons elt (stack-contents stack))))  ;; Note use of make-stack and stack-contents here


;; Return top element on stack; leave stack unchanged

(define (stack-top stack)
  (car (stack-contents stack)))


;; Remove top element from stack; return this new stack

(define (stack-pop stack)
  (make-stack (cdr (stack-contents stack))))  ;; Note use of make-stack and stack-contents here


;; Is this stack emtpy?

(define (stack-empty? stack)
  (null? (stack-contents stack)))


;; Return a brand new empty stack

(define (make-empty-stack)
  (make-stack '()))


;; Check whether something is a stack (according to this data abstraction)
;; Note that what it *really* checks is whether these procedures will work,
;; i.e., whether it has the right structure.

(define (stack? object)
  (and (pair? object)              ;; and returns true if all its arguments are true.  It is a short circuit special form.
       (eq? (car object) 'stack)   ;; pair? returns true if given any cons cell, false otherwise
       (list? (cdr object))))      ;; list? returns true if given the empty list or a cons cell whose cdr contains a list

You could run this code with stack-eg, too, provided that you modify it to use stack-push instead of push and call it with the result of (make-empty-stack).


2013-07-17 10:42