suzanne.soy/2d
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add annotations to 2dmatch to help typecheck.

Browse Source 
Also use `match*/derived` to get the right error message name.

original commit: a9428728c56a15ad4bd63399c79070e07ef8ad24
This commit is contained in:
Sam Tobin-Hochstadt 2014-03-28 10:03:52 -04:00
commit 08dff62620
1 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/unstable-2d/unstable/2d/match.rkt
View File

@ -100,20 +100,18 @@
(for ([cell (in-list cells)]) (for ([cell (in-list cells)])
(hash-set! coord-to-content cell app)) (hash-set! coord-to-content cell app))
(set! let-bindings (set! let-bindings
(cons #`[id (λ (#,@horizontal-vars #,@vertical-vars) #,@rhses)] (cons #`[id #,(syntax-property
#`(λ (#,@horizontal-vars #,@vertical-vars) #,@rhses)
'typechecker:called-in-tail-position
#t)]
let-bindings))))) let-bindings)))))
(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)))
#`(let #,(reverse let-bindings) #`(let #,(reverse let-bindings)
(match* #,main-args (match*/derived #,main-args #,stx
#,@(for*/list ([x (in-range 1 num-of-cols)] #,@(for*/list ([x (in-range 1 num-of-cols)]
[y (in-range 1 num-of-rows)]) [y (in-range 1 num-of-rows)])
#`[(#,(hash-ref coord-to-content (list x 0)) #`[(#,(hash-ref coord-to-content (list x 0))
#,(hash-ref coord-to-content (list 0 y))) #,(hash-ref coord-to-content (list 0 y)))
#,(hash-ref coord-to-content (list x y))]) #,(hash-ref coord-to-content (list x y))]))))]))
[(_ _)
(2dmatch-error #,@main-args)])))]))
(define (2dmatch-error a b)
(error '2dmatch "no matching clauses for ~e and ~e" a b))