Path: utzoo!attcan!uunet!lll-winken!sun-barr!cs.utexas.edu!samsung!sdd.hp.com!zaphod.mps.ohio-state.edu!ub!boulder!andreasg
From: andreasg@boulder.Colorado.EDU (Andreas Girgensohn)
Newsgroups: comp.lang.lisp
Subject: Re: Lisp 1.5 functional values as objects
Message-ID: <27867@boulder.Colorado.EDU>
Date: 10 Oct 90 19:32:22 GMT
References: <1950001@hpgnd.HP.COM> <raja.655569550@copper>
Sender: news@boulder.Colorado.EDU
Reply-To: andreasg@boulder.Colorado.EDU (Andreas Girgensohn)
Organization: University of Colorado at Boulder
Lines: 58

In article <raja.655569550@copper> raja@copper.ucs.indiana.edu (Raja Sooriamurthi) writes:
>dave@hpgnd.HP.COM (Dave PENKLER) writes:
>>[...]
>>Is there any way to do this sort of thing in  newer dialects of lisp ?
>                                               ^^^^^^^^^^^^^^^^^^^^^^
>This might be out of place in this news-group, but Scheme can handle
>these sort of objects very elegantly. For instance a stack could be
>defined as:
>
>(define make-stack
>  (lambda () ; if desired initial values could be passed here
>    (let ([stack 'any-initial-value])
>      (lambda msg  ; the function (object) that is returned
>	(case (car msg)
>	  [push (set! stack (cons (cadr msg) stack))]
>	  [pop (set! stack (cdr stack))]
>	  [top (car stack)]
>	  [show stack]
>	  [flush (set! stack 'any-initial-value)]
>	  [else (error 'stack "unknown method name")])))))
>
>(define send
>  (lambda args
>    (apply (car args) (cdr args))))
>
>You would create stacks as:
>(define s1 (make-stack))
>
>and manipulate it as:
>(send s1 'push 'apple)
>
>[...]

That example works as well in Common Lisp or any other Lisp dialect that
provides lexical closures.

(defun make-stack () ; if desired initial values could be passed here
  (let ((stack 'any-initial-value))
    #'(lambda (&rest msg)  ; the function (object) that is returned
        (case (car msg)
          (push (setq stack (cons (cadr msg) stack)))
          (pop (setq stack (cdr stack)))
          (top (car stack))
          (show stack)
          (flush (setq stack 'any-initial-value))
          (otherwise (error "unknown method name"))))))

(defun send (&rest args)
  (apply (car args) (cdr args)))

(setq s1 (make-stack))

(send s1 'push 'apple)
(send s1 'push 'orange)
(send s1 'show)

Andreas Girgensohn
andreasg@boulder.colorado.edu