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 |
|
|
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)))) |