Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6312
Modified Files: read.lisp Log Message: Fixed un-backquote for non-proper lists, like `(a b . c).
Date: Wed Jul 21 15:35:15 2004 Author: ffjeld
Index: movitz/losp/muerte/read.lisp diff -u movitz/losp/muerte/read.lisp:1.6 movitz/losp/muerte/read.lisp:1.7 --- movitz/losp/muerte/read.lisp:1.6 Wed Jul 21 07:15:43 2004 +++ movitz/losp/muerte/read.lisp Wed Jul 21 15:35:15 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Oct 17 21:50:42 2001 ;;;; -;;;; $Id: read.lisp,v 1.6 2004/07/21 14:15:43 ffjeld Exp $ +;;;; $Id: read.lisp,v 1.7 2004/07/21 22:35:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -19,6 +19,9 @@
(in-package muerte)
+(defvar *read-suppress*) +(defvar *readtable*) + (defun substring (string start end) (if (and (zerop start) (= end (length string))) string @@ -302,19 +305,6 @@ (t (return-from simple-read-from-string (simple-read-token string :start i :end end))))))
-;;;(defun read-char (&optional input-stream eof-error-p eof-value recursive-p) -;;; " => char" -;;; (declare (ignore recursive-p)) -;;; (let* ((stream (input-stream-designator input-stream)) -;;; (char (stream-read-char stream))) -;;; (cond -;;; ((not (eq :eof char)) -;;; char) -;;; (eof-error-p -;;; (error 'end-of-file :stream stream)) -;;; (t eof-value)))) - - (defun un-backquote (form level) "Dont ask.." (declare (notinline un-backquote)) @@ -340,7 +330,7 @@ (muerte::movitz-backquote (list 'list (list 'list (list 'quote 'muerte::movitz-backquote) - (un-backquote-xxx (cadr sub-form) (1+ level))))) + (un-backquote (cadr sub-form) (1+ level))))) (backquote-comma (cond ((= 0 level) @@ -354,15 +344,19 @@ (t (list 'list (list 'list (list 'quote 'backquote-comma) - (un-backquote-xxx (cadr sub-form) (1- level))))))) + (un-backquote (cadr sub-form) (1- level))))))) (backquote-comma-at (if (= 0 level) (cadr sub-form) (list 'list (list 'list (list 'quote 'backquote-comma-at) - (un-backquote-xxx (cadr sub-form) (1- level)))))) - (t (list 'list (un-backquote-xxx sub-form level))))))))))) + (un-backquote (cadr sub-form) (1- level)))))) + (t (list 'list (un-backquote sub-form level)))))) + when (not (listp (cdr sub-form-head))) + collect (list 'quote (cdr sub-form-head))) + )))) (array (error "Array backquote not implemented.")) (t (list 'quote form))))) +