adjust 2dmatch so that it copies more code

but this also means that multi-column cells can
refer to variables in the column header (ditto
for multi-row cells)

the code duplication can be fixed with a little
more smarts at the match level, I believe
(see comment in source)

original commit: 5cc2ec0ccaefc5150722e0651ef7c41da30d408f
This commit is contained in:
Robby Findler 2013-08-14 07:16:58 -05:00
parent a5cb5a74b7
commit 3eae0d34bd

View File

@ -5,8 +5,7 @@
(provide 2dmatch) (provide 2dmatch)
(define-syntax (2dmatch stx) (define-syntax (2dmatch stx)
(syntax-case stx () (syntax-case stx ()
[(_ widths heights [(_ widths heights [(cell ...) rhs ...] ...)
[(cell ...) rhs ...] ...)
(let () (let ()
;; coord-to-content : hash[(list num num) -o> (listof syntax)] ;; coord-to-content : hash[(list num num) -o> (listof syntax)]
@ -36,7 +35,10 @@
[on-boundary? [on-boundary?
(unless (and rhses-lst (= 1 (length rhses-lst))) (unless (and rhses-lst (= 1 (length rhses-lst)))
(raise-syntax-error '2dmatch (raise-syntax-error '2dmatch
(format "cell at ~a,~a must contain exactly one match pattern") (format
"cell at ~a,~a must contain exactly one match pattern, found ~a"
(list-ref (car cells) 0) (list-ref (car cells) 1)
(length rhses-lst))
stx)) stx))
(hash-set! coord-to-content (car cells) (car (syntax->list rhses)))] (hash-set! coord-to-content (car cells) (car (syntax->list rhses)))]
[else [else
@ -46,21 +48,16 @@
(list-ref (car cells) 0) (list-ref (car cells) 0)
(list-ref (car cells) 1)) (list-ref (car cells) 1))
stx)) stx))
(cond ;; this code will duplicate the rhses expressions
[(null? (cdr cells)) ;; only one cell: ;; in the case that there are multiple cells in `cells'
;; => we don't need a let binding ;; it would be better to analyze the corresponding
(hash-set! coord-to-content ;; match patterns and then stick the code in a function
(car cells) ;; whose arguments are the intersection of the bound variables
(syntax->list rhses))] ;; (supplying the arguments in a call in the cell)
[else (for ([cell (in-list cells)])
(for ([cell (in-list cells)]) (hash-set! coord-to-content
(define x (list-ref cell 0)) cell
(define y (list-ref cell 1)) (syntax->list rhses)))]))
(with-syntax ([(id) (generate-temporaries (list (format "2dmatch~a-~a" x y)))]
[(rhs ...) rhses])
(set! let-bindings (cons #`[id (λ () rhs ...)]
let-bindings))
(hash-set! coord-to-content cell (list #'(id)))))])]))
(define num-of-cols (length (syntax->list #'widths))) (define num-of-cols (length (syntax->list #'widths)))
(define num-of-rows (length (syntax->list #'heights))) (define num-of-rows (length (syntax->list #'heights)))