From a2fcd9acc260cbe05d66549a5ea0c8a4f3e65119 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 17 Mar 2016 10:48:53 -0700 Subject: [PATCH] make `cases` work with positional args --- br/eopl.rkt | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/br/eopl.rkt b/br/eopl.rkt index 6152e8a..4562039 100644 --- a/br/eopl.rkt +++ b/br/eopl.rkt @@ -1,6 +1,6 @@ #lang br -(require rackunit (for-syntax br/datum sugar/debug)) -(provide define-datatype occurs-free?) +(require rackunit racket/struct (for-syntax br/datum sugar/debug)) +(provide define-datatype cases occurs-free?) #;(begin (struct lc-exp () #:transparent) @@ -59,17 +59,22 @@ (occurs-free? search-var rator) (occurs-free? search-var rand)))])) +(define-syntax (cases stx) + (syntax-case stx (else) + [(_ + [ ( ...) ...] ... + [else ...]) + (inject-syntax ([#'( ...) (map-syntax (λ(s) (format-datum '~a? s)) #'( ...))]) + #'(cond + [( ) (match-let ([(list ...) (struct->list )]) + ...)] ... + [else ...]))] + [(_ + ...) + #'(cases + ... + [else (void)])])) -(define #'(cases-let ( ...) ...) - (inject-syntax ([#'( ...) (map-syntax (λ(field) (format-datum '~a-~a #' field)) #'( ...))]) - #'(let ([ ( )] ...) - ...))) - - -(define #'(cases [ ( ...) ...] ...) - (inject-syntax ([#'( ...) (map-syntax (λ(s) (format-datum '~a? s)) #'( ...))]) - #'(cond - [( ) (cases-let ( ...) ...)] ...))) (define (occurs-free? search-var exp) (cases lc-exp exp