diff options
| author | dos-reis <gdr@axiomatics.org> | 2007-08-23 20:54:39 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2007-08-23 20:54:39 +0000 |
| commit | 54f6b055f7f15716bba29f5de8230057f1e44493 (patch) | |
| tree | 84090dbfe93f97eb158f626b73079c3f8c792942 | |
| parent | cb7a1ad2b02e7d0dbcc096889439a935c3a8e418 (diff) | |
| download | open-axiom-54f6b055f7f15716bba29f5de8230057f1e44493.tar.gz | |
* vmlisp.lisp.pamphlet (getl): Rewrite to accept list of symbols
of lists too.
| -rw-r--r-- | src/interp/ChangeLog | 5 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp.pamphlet | 29 |
2 files changed, 27 insertions, 7 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index cb827526..1b969f79 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,8 @@ +2007-08-23 Gabriel Dos Reis <gdr@cs.tamu,edu> + + * vmlisp.lisp.pamphlet (getl): Rewrite to accept list of symbols + of lists too. + 2007-08-22 Gabriel Dos Reis <gdr@cs.tamu.edu> * bootfuns.lisp.pamphlet (|$algebraList|): Remove unused variable. diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 837ef55f..49cbcb7e 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -1975,13 +1975,28 @@ can be restored. ; A version of GET that works with lists -; (defun getl (sym key ) -; (cond ((consp sym) (cdr (assoc key sym :test #'eq))) -; ((symbolp sym) (get sym key)))) -(defun getl (sym key ) - (cond ((consp sym) (cdr (assq key sym))) - ((symbolp sym) (get sym key)))) - +;; GETL(SYM, KEY) +;; KEY: a SYMBOL +;; SYM: a SYMBOL or a LIST whose elements are SYMBOLs or LISTs. +;; Returns: +;; when SYM is a SYMBOL, returns the KEY-property of SYM. +;; when SYM is a LIST, returns the either the KEY-property of the +;; first SYMBOL of SYM that has the KEY-property, or the CDR of the +;; first cons-cell whose CAR is EQ KEY. +(defun getl (sym key) + (cond ((symbolp sym) + (get sym key)) + ((null sym) nil) + ((consp sym) + (let ((sym-1 (car sym))) + (cond ((symbolp sym-1) + (get sym-1 key)) + ((and (consp sym-1) + (symbolp (car sym-1))) + (if (eq (car sym-1) key) + (cdr sym-1) + (getl (cdr sym) key)))))))) + ; The following should actually position the cursor at the sint'th line of the screen: (defun $showline (cvec sint) (terpri) sint (princ cvec)) |