/[gcl]/gcl/lsp/gcl_autoload.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_autoload.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by camm, Sat Jul 23 08:50:49 2005 UTC revision 1.13 by camm, Fri Oct 14 00:33:00 2005 UTC
# Line 25  Line 25 
25  ;;; Go into LISP.  ;;; Go into LISP.
26  (in-package 'lisp)  (in-package 'lisp)
27    
28    (defconstant +keyword-package+ (find-package 'keyword))
29  ;(defvar *features*)  ;(defvar *features*)
30    
31  (defun eval-feature (x)  (defun eval-feature (x)
32    (cond ((atom x)    (cond ((atom x)
33           (member x *features*           (member x *features*))
34                   :test #'(lambda (a b)          ((eq (car x) :and)
                            (cond ((symbolp a)  
                                   (and (symbolp b)  
                                        (string-equal (symbol-name a)  
                                                      (symbol-name b))))  
                                  (t (eql a b))))))  
         ((eq (car x) 'and)  
35           (dolist (x (cdr x) t) (unless (eval-feature x) (return nil))))           (dolist (x (cdr x) t) (unless (eval-feature x) (return nil))))
36          ((eq (car x) 'or)          ((eq (car x) :or)
37           (dolist (x (cdr x) nil) (when (eval-feature x) (return t))))           (dolist (x (cdr x) nil) (when (eval-feature x) (return t))))
38          ((eq (car x) 'not)          ((eq (car x) :not)
39           (not (eval-feature (cadr x))))           (not (eval-feature (cadr x))))
40          (t (error "~S is not a feature expression." x))))          (t (error "~S is not a feature expression." x))))
41    
42  ;;; Revised by Marc Rinfret.  ;;; Revised by Marc Rinfret.
43  (defun sharp-+-reader (stream subchar arg)  (defun sharp-+-reader (stream subchar arg)
44    (if (eval-feature (let ((*read-suppress* nil) (*read-base* 10.))    (if (eval-feature (let ((*read-suppress* nil)
45                           (read stream t nil t)))                            (*read-base* 10.)
46                              (*package* +keyword-package+))
47                          (read stream t nil t)))
48        (values (read stream t nil t))        (values (read stream t nil t))
49        (let ((*read-suppress* t)) (read stream t nil t) (values))))        (let ((*read-suppress* t)) (read stream t nil t) (values))))
50    
# Line 56  Line 53 
53                                (si::standard-readtable))                                (si::standard-readtable))
54    
55  (defun sharp---reader (stream subchar arg)  (defun sharp---reader (stream subchar arg)
56    (if (eval-feature (let ((*read-suppress* nil) (*read-base* 10.))    (if (eval-feature (let ((*read-suppress* nil)
57                              (*read-base* 10.)
58                              (*package* +keyword-package+))
59                           (read stream t nil t)))                           (read stream t nil t)))
60        (let ((*read-suppress* t)) (read stream t nil t) (values))        (let ((*read-suppress* t)) (read stream t nil t) (values))
61        (values (read stream t nil t))))        (values (read stream t nil t))))

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26