diff --git a/qi-lib/macro.rkt b/qi-lib/macro.rkt index a9bb44c2..e2bc5390 100644 --- a/qi-lib/macro.rkt +++ b/qi-lib/macro.rkt @@ -92,10 +92,12 @@ (define-syntax define-qi-syntax-rule (syntax-parser - [(_ (name . pat) template) + [(_ (name . pat) dirs ... tmpl) #'(define-dsl-syntax name qi-macro (syntax-parser - [(_ . pat) #'template]))])) + [(_ . pat) + dirs ... + #'tmpl]))])) (define-syntax define-qi-syntax-parser (syntax-parser diff --git a/qi-test/tests/macro.rkt b/qi-test/tests/macro.rkt index 4dcf76e2..4689b2f8 100644 --- a/qi-test/tests/macro.rkt +++ b/qi-test/tests/macro.rkt @@ -12,12 +12,32 @@ syntax/macro-testing "private/util.rkt") -(define-qi-syntax-rule (square flo:expr) +(define-qi-syntax-rule (square flo) (feedback 2 flo)) (define-qi-syntax-rule (pare car-flo cdr-flo) (group 1 car-flo cdr-flo)) +(define-qi-syntax-rule (ensure-number n:number) + (gen n)) + +(define-qi-syntax-rule (repeat-3 f) + #:with g #'(~> f f f) + g) + +(define-qi-syntax-parser repeat + [(_ 2 f) + #:with g #'(~> f f) + #'g] + [(_ 3 f) + #:with g #'(~> f f f) + #'g]) + +(define-qi-syntax-parser calc + #:datum-literals (plus minus) + [(_ plus) #'+] + [(_ minus) #'-]) + (define-qi-syntax-parser cube [(_ flo) #'(feedback 3 flo)]) @@ -54,6 +74,11 @@ "base" (check-equal? ((☯ (square sqr)) 2) 16) (check-equal? ((☯ (~> (pare sqr +) ▽)) 3 6 9) (list 9 15)) + (check-equal? ((☯ (ensure-number 5))) 5 "single-clause macros can use syntax classes") + (check-equal? ((☯ (repeat-3 add1)) 5) 8 "single-clause macros can include pattern directives") + (check-equal? ((☯ (repeat 2 add1)) 5) 7 "multi-clause macros can include pattern directives") + (check-equal? ((☯ (calc plus)) 5 3) 8 "multi-clause macros can include parse options") + (check-equal? ((☯ (calc minus)) 5 3) 2 "multi-clause macros can include parse options") (check-equal? ((☯ (cube sqr)) 2) 256) (check-equal? ((☯ (fanout 5)) 2) 'hello "extensions can override built-in forms") (check-equal? ((☯ kazam) 2) 'hello "extensions can add identifier macros"))