conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

<literal> superiors to <ellipsis>, when there is conflict

This commit is contained in:
Yuito Murase 2014-04-03 02:10:35 +09:00
parent cf8bf2c32b
commit 8c2e69336e
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
piclib/syntax-rules.scm
View File

@ -84,7 +84,7 @@
#f #f
(exit #f)) (exit #f))
'())) '()))
((compare pattern ellipsis) ((and ellipsis (compare pattern ellipsis))
(values `(,_syntax-error "invalid pattern") '())) (values `(,_syntax-error "invalid pattern") '()))
((symbol? pattern) ((symbol? pattern)
(values `(,_set! ,(var->sym pattern) expr) (list pattern))) (values `(,_set! ,(var->sym pattern) expr) (list pattern)))
@ -124,7 +124,7 @@
(exit #f))) (exit #f)))
(append vars (append vars1 vars2))))) (append vars (append vars1 vars2)))))
;; (hoge ... rest args) ;; (hoge ... rest args)
((compare (cadr pattern) ellipsis) ((and ellipsis (compare (cadr pattern) ellipsis))
(let-values (((match-r vars-r) (compile-match-list-reverse pattern))) (let-values (((match-r vars-r) (compile-match-list-reverse pattern)))
(values (values
`(,_begin ,@(reverse matches) `(,_begin ,@(reverse matches)
@ -152,7 +152,7 @@
(matches '()) (matches '())
(vars '()) (vars '())
(accessor 'expr)) (accessor 'expr))
(cond ((compare (car pattern) ellipsis) (cond ((and ellipsis (compare (car pattern) ellipsis))
(let-values (((match1 vars1) (compile-match-ellipsis (cadr pattern)))) (let-values (((match1 vars1) (compile-match-ellipsis (cadr pattern))))
(values (values
`(,_begin ,@(reverse matches) `(,_begin ,@(reverse matches)
@ -260,7 +260,7 @@
`(,_list->vector ,expand1) `(,_list->vector ,expand1)
vars1)))) vars1))))
(compile-expand-base template #t))) (compile-expand-base template ellipsis)))
(define (check-vars vars-pattern vars-template) (define (check-vars vars-pattern vars-template)
;;fixme ;;fixme
@ -308,7 +308,9 @@
(every? symbol? literals) (every? symbol? literals)
(list? rules) (list? rules)
(every? (lambda (l) (and (list? l) (= (length l) 2))) rules)) (every? (lambda (l) (and (list? l) (= (length l) 2))) rules))
`(syntax-rules ,ellipsis ,literals ,@rules) (if (member ellipsis literals compare)
`(syntax-rules #f ,literals ,@rules)
`(syntax-rules ,ellipsis ,literals ,@rules))
#f)) #f))
#f)) #f))