From b91939f5aa15c4112a0643db22091b9cc7253575 Mon Sep 17 00:00:00 2001 From: zeptometer Date: Wed, 6 Aug 2014 20:11:59 +0900 Subject: [PATCH 1/3] fix bug when syntax-rules expand rules including vector --- piclib/scheme/base.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index d08650b2..7f5368d5 100644 --- a/piclib/scheme/base.scm +++ b/piclib/scheme/base.scm @@ -517,7 +517,7 @@ (compile-match-vector (lambda (pattern) - (let-values (((match vars) (compile-match-list (vector->list pattern)))) + (let-values (((match vars) (compile-match-base (vector->list pattern)))) (values `(,_let ((expr (,_vector->list expr))) ,match) @@ -588,9 +588,10 @@ (compile-expand-vector (lambda (template ellipsis-valid) (let-values (((expand1 vars1) - (compile-expand-list (vector->list template) ellipsis-valid))) - `(,_list->vector ,expand1) - vars1)))) + (compile-expand-base (vector->list template) ellipsis-valid))) + (values + `(,_list->vector ,expand1) + vars1))))) (compile-expand-base template ellipsis))) From 4f59e07539e954c2373b7ff2b355a67fe7b19dcc Mon Sep 17 00:00:00 2001 From: zeptometer Date: Wed, 6 Aug 2014 21:05:20 +0900 Subject: [PATCH 2/3] fix bug that errors when matching vector rule with non-vector expression --- piclib/scheme/base.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index 7f5368d5..b9d7ffb5 100644 --- a/piclib/scheme/base.scm +++ b/piclib/scheme/base.scm @@ -383,6 +383,7 @@ (define _pair? (r 'pair?)) (define _null? (r 'null?)) (define _symbol? (r 'symbol?)) + (define _vector? (r 'vector?)) (define _eqv? (r 'eqv?)) (define _string=? (r 'string=?)) (define _map (r 'map)) @@ -519,8 +520,10 @@ (lambda (pattern) (let-values (((match vars) (compile-match-base (vector->list pattern)))) (values - `(,_let ((expr (,_vector->list expr))) - ,match) + `(,_if (,_vector? expr) + (,_let ((expr (,_vector->list expr))) + ,match) + (exit #f)) vars))))) (let-values (((match vars) (compile-match-base (cdr pattern)))) From a35dd8463cdc4d8fa2649ca22a1eceaa68a1078f Mon Sep 17 00:00:00 2001 From: zeptometer Date: Wed, 6 Aug 2014 21:47:21 +0900 Subject: [PATCH 3/3] in syntax-rules, literals is prior to underscore --- piclib/scheme/base.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/piclib/scheme/base.scm b/piclib/scheme/base.scm index b9d7ffb5..02f3c9e2 100644 --- a/piclib/scheme/base.scm +++ b/piclib/scheme/base.scm @@ -410,13 +410,13 @@ (define (compile-match ellipsis literals pattern) (letrec ((compile-match-base (lambda (pattern) - (cond ((compare pattern (r '_)) (values #f '())) - ((member pattern literals compare) + (cond ((member pattern literals compare) (values `(,_if (,_and (,_symbol? expr) (cmp expr (rename ',pattern))) #f (exit #f)) '())) + ((compare pattern (r '_)) (values #f '())) ((and ellipsis (compare pattern ellipsis)) (values `(,_syntax-error "invalid pattern") '())) ((symbol? pattern)