forked from alex-eg/sex
read-time feature expressions
'#+' and '#-' introduce conditional compilation: the form that follows is kept only when the feature expression is true, and otherwise is read and thrown away. An expression is a feature name, or and / or / not of them. They are read time, not compile time. Default features are the host's software-version, software-type and machine-type as CHICKEN reports them, plus what --features flag adds.
This commit is contained in:
@@ -1,6 +1,14 @@
|
||||
(import (chicken port)
|
||||
reader)
|
||||
|
||||
(define-syntax feature-test
|
||||
(syntax-rules ()
|
||||
((feature-test result features string)
|
||||
(test result
|
||||
(parameterize ((current-features 'features))
|
||||
(with-input-from-string string
|
||||
(lambda () (read-raw-forms 'stdin))))))))
|
||||
|
||||
(define-syntax reader-test
|
||||
(syntax-rules ()
|
||||
((reader-test result string)
|
||||
@@ -38,4 +46,41 @@
|
||||
(reader-test '((a b) (comment " t")) "(a b) ; t")
|
||||
;; a `;' inside a string is not a comment
|
||||
(reader-test '("a;b") "\"a;b\"")
|
||||
|
||||
;; #+ / #- feature expressions. What does not apply is read and
|
||||
;; dropped, so it never reaches the compiler at all
|
||||
(feature-test '((a)) (linux) "#+linux (a)")
|
||||
(feature-test '() (macosx) "#+linux (a)")
|
||||
(feature-test '() (linux) "#-linux (a)")
|
||||
(feature-test '((a)) (macosx) "#-linux (a)")
|
||||
;; the guarded datum can be anything, not only a list
|
||||
(feature-test '(42) (x) "#+x 42")
|
||||
(feature-test '("s") (x) "#+x \"s\"")
|
||||
|
||||
;; and / or / not
|
||||
(feature-test '((a)) (unix linux) "#+(and unix linux) (a)")
|
||||
(feature-test '() (unix) "#+(and unix linux) (a)")
|
||||
(feature-test '((a)) (unix) "#+(or linux unix) (a)")
|
||||
(feature-test '() (bsd) "#+(or linux unix) (a)")
|
||||
(feature-test '((a)) (unix) "#+(and unix (not macosx)) (a)")
|
||||
(feature-test '() (unix macosx) "#+(and unix (not macosx)) (a)")
|
||||
;; (and) is true and (or) is false, as they are in CL
|
||||
(feature-test '((a)) () "#+(and) (a)")
|
||||
(feature-test '() () "#+(or) (a)")
|
||||
|
||||
;; a guard inside a form, including as the last element -- dropping
|
||||
;; continues with the next token, so the closing paren still arrives
|
||||
(feature-test '((f 1 3)) (a) "(f #+a 1 #-a 2 3)")
|
||||
(feature-test '((f 2 3)) (b) "(f #+a 1 #-a 2 3)")
|
||||
(feature-test '((f 1)) (a) "(f #+a 1 #+b 2)")
|
||||
(feature-test '((f)) (b) "(f #+a 1)")
|
||||
;; ...and as the last form in the file
|
||||
(feature-test '((a)) (x) "(a) #+y (b)")
|
||||
|
||||
;; guards nest
|
||||
(feature-test '((a)) (x y) "#+x #+y (a)")
|
||||
(feature-test '((b)) (x) "#+x #+y (a) (b)")
|
||||
|
||||
;; a feature the program was not given is simply absent
|
||||
(feature-test '() () "#+anything (a)")
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user