syntax-rules: literal support

This commit is contained in:
Yuichi Nishiwaki 2015-06-15 02:53:39 +09:00
parent dfcf8c73bd
commit 691d0ad698
1 changed files with 12 additions and 1 deletions

View File

@ -40,7 +40,6 @@
(map (lambda (s) `(,(car s) . ,(f (cdr s)))) assoc))
;; TODO
;; - literals
;; - splicing
;; - placeholder
;; - vector
@ -56,6 +55,10 @@
(and (not (pair? obj))
(not (variable? obj))))
(define (literal? obj)
(and (variable? obj)
(memq obj literals)))
(define (many? pat)
(and (pair? pat)
(pair? (cdr pat))
@ -70,6 +73,8 @@
(cond
((constant? pat)
#`(equal? '#,pat #,form))
((literal? pat)
#`(variable=? #'#,pat #,form))
((variable? pat)
#t)
((many? pat)
@ -88,6 +93,8 @@
(cond
((constant? pat)
'())
((literal? pat)
'())
((variable? pat)
`(,pat))
((many? pat)
@ -100,6 +107,8 @@
(cond
((constant? pat)
'())
((literal? pat)
'())
((variable? pat)
`((,pat . 0)))
((many? pat)
@ -115,6 +124,8 @@
(cond
((constant? pat)
'())
((literal? pat)
'())
((variable? pat)
`((,pat . ,form)))
((many? pat)