commit a075b9b4f846e07ec863f6d83b02329a1eb96f94 parent a56250b26e9ef4056223279e9984b73e09158f66 Author: AlexKnauth <alexander@knauth.org> Date: Fri, 2 Sep 2016 10:57:46 -0400 fix ~?Some pattern expander Diffstat:
| M | turnstile/examples/infer.rkt | | | 19 | ++++++++++++++----- |
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/turnstile/examples/infer.rkt b/turnstile/examples/infer.rkt @@ -30,6 +30,12 @@ (syntax-parse cs [([a b] ...) #'(Constraints (Constraint a b) ...)])) + (define-syntax-class ?Some-form + #:attributes (Xs τ Cs) + [pattern (~Some Xs τ Cs)] + [pattern (~and τ (~not (~Some _ _ _))) + #:with Xs #'[] + #:with Cs ((current-type-eval) #'(Cs))]) (define-syntax ~?∀ (pattern-expander (syntax-parser @@ -42,11 +48,14 @@ (pattern-expander (syntax-parser [(?Some Xs-pat τ-pat Cs-pat) - #'(~or (~Some Xs-pat τ-pat Cs-pat) - (~and (~not (~Some _ _ _)) - (~parse Xs-pat #'[]) - (~parse Cs-pat ((current-type-eval) #'(Cs))) - τ-pat))]))) + #:with tmp (generate-temporary 'Some-form) + #:with tmp.Xs (format-id #'tmp "~a.Xs" #'tmp) + #:with tmp.τ (format-id #'tmp "~a.τ" #'tmp) + #:with tmp.Cs (format-id #'tmp "~a.Cs" #'tmp) + #'(~and (~var tmp ?Some-form) + (~parse Xs-pat #'tmp.Xs) + (~parse τ-pat #'tmp.τ) + (~parse Cs-pat #'tmp.Cs))]))) (define-syntax ~Cs (pattern-expander (syntax-parser #:literals (...)