This is now in SVN available in scheme/match with tests and documentation. Jay
On Tue, Jun 2, 2009 at 8:49 PM, Jay McCarthy<jay.mccar...@gmail.com> wrote: > The structure patterns in scheme/match have always bugged me that they > didn't let you put the fields in any order and you had to put in _ for > the fields you didn't care about. > > I've remedied this with a new match expander, struct*. I'd like to put > in the tree. Do people agree? > > -- Use cases -- > > (define-struct super-tree (left right extra)) > > (define example1 > (make-super-tree 1 2 "And a pony!")) > > (match example1 > [(struct* super-tree > ([left (? number? l)] > [right (? number? r)])) > (printf "All numbers! ~a ~a~n" l r)]) > > (match example1 > [(struct* super-tree > ([right (? number? r)] > [left (? number? l)])) > (printf "Look ma, any order! ~a ~a~n" l r)]) > > (define-struct (even-better-tree super-tree) (more-extra-good)) > > (define example2 > (make-even-better-tree 1 2 "And a pony!" "And a giraffe!")) > > (match example2 > [(struct* super-tree > ([left (? number? l)] > [right (? number? r)])) > (printf "All numbers! ~a ~a~n" l r)]) > > (match example2 > [(struct* even-better-tree > ([more-extra-good (? string? m)])) > (printf "~a~n" m)]) > > -- Code & Test Cases -- > > #lang scheme > (require (for-syntax scheme/struct-info > syntax/boundmap > scheme/list)) > > (define-match-expander > struct* > (lambda (stx) > (syntax-case stx () > [(_ struct-name (field+pat ...)) > (let* ([fail (lambda () > (raise-syntax-error > 'struct* "not a structure definition" > stx #'struct-name))] > [v (syntax-local-value #'struct-name fail)] > [field-acc->pattern (make-free-identifier-mapping)]) > (unless (struct-info? v) (fail)) > ; Check each pattern and capture the field-accessor name > (for-each (lambda (an) > (syntax-case an () > [(field pat) > (unless (identifier? #'field) > (raise-syntax-error > 'struct* "not an identifier for field name" > stx #'field)) > (let ([field-acc > (datum->syntax #'field > (string->symbol > (format "~a-~a" > (syntax-e #'struct-name) > (syntax-e #'field))) > #'field)]) > (when (free-identifier-mapping-get > field-acc->pattern field-acc (lambda () #f)) > (raise-syntax-error 'struct* "Field name > appears twice" stx #'field)) > (free-identifier-mapping-put! > field-acc->pattern field-acc #'pat))] > [_ > (raise-syntax-error > 'struct* "expected a field pattern of the > form (<field-id> <pat>)" > stx an)])) > (syntax->list #'(field+pat ...))) > (let* (; Get the structure info > [acc (fourth (extract-struct-info v))] > ;; the accessors come in reverse order > [acc (reverse acc)] > ;; remove the first element, if it's #f > [acc (cond [(empty? acc) acc] > [(not (first acc)) (rest acc)] > [else acc])] > ; Order the patterns in the order of the accessors > [pats-in-order > (for/list ([field-acc (in-list acc)]) > (begin0 > (free-identifier-mapping-get > field-acc->pattern field-acc > (lambda () (syntax/loc stx _))) > ; Use up pattern > (free-identifier-mapping-put! > field-acc->pattern field-acc #f)))]) > ; Check that all patterns were used > (free-identifier-mapping-for-each > field-acc->pattern > (lambda (field-acc pat) > (when pat > (raise-syntax-error 'struct* "field name not > associated with given structure type" > stx field-acc)))) > (quasisyntax/loc stx > (struct struct-name #,pats-in-order))))]))) > > ; Comment out to test syntax errors > > ; Bad struct info id > #;(match example1 > [(struct* some-tree > ([left (? number? l)] > [right (? number? r)])) > (printf "Just the facts: ~a ~a~n" > l r)]) > > ; Bad struct info > (define-for-syntax uncool-tree #f) > #;(match example1 > [(struct* uncool-tree > ([left (? number? l)] > [right (? number? r)])) > (printf "Just the facts: ~a ~a~n" > l r)]) > > ; Bad syntax form > #;(match example1 > [(struct* super-tree > ([foo] > [right (? number? r)])) > (printf "Just the facts: ~a ~a~n" > l r)]) > > ; Not an id for field > #;(match example1 > [(struct* super-tree > ([(+ 1 1) (? number? l)] > [right (? number? r)])) > (printf "Just the facts: ~a ~a~n" > l r)]) > > ; Field appears twice > #;(match example1 > [(struct* super-tree > ([right _] > [right (? number? r)])) > (printf "Just the facts: ~a~n" > r)]) > > ; Not a field id > #;(match example1 > [(struct* super-tree > ([feet (? number?)] > [right (? number? r)])) > (printf "Just the facts: ~a~n" > r)]) > > ; Super structs don't work > #;(match example2 > [(struct* even-better-tree > ([left (? number? l)] > [right (? number? r)] > [more-extra-good (? string? s)])) > (printf "All numbers (+ 1 string)! ~a ~a ~a~n" l r s)]) > > ; Super structs don't work > #;(match example2 > [(struct* even-better-tree > ([left (? number? l)] > [extra (? string? e)] > [right (? number? r)] > [more-extra-good (? string? m)])) > (printf "All numbers (+ 2 strings)! ~a ~a ~a ~a~n" l e r m)]) > > -- > Jay McCarthy <j...@cs.byu.edu> > Assistant Professor / Brigham Young University > http://teammccarthy.org/jay > > "The glory of God is Intelligence" - D&C 93 > -- Jay McCarthy <j...@cs.byu.edu> Assistant Professor / Brigham Young University http://teammccarthy.org/jay "The glory of God is Intelligence" - D&C 93 _________________________________________________ For list-related administrative tasks: http://list.cs.brown.edu/mailman/listinfo/plt-dev
