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

fix syntax error message generation code

Browse Source
This commit is contained in:
Robby Findler 2015-02-12 17:13:38 -06:00
parent ac4a3865d3
commit db9d93c7cc
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
unstable/2d/match.rkt
View File

@ -9,7 +9,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ widths heights [(cell ...) rhs ...] ...) [(_ widths heights [(cell ...) rhs ...] ...)
(let () (let ()
;; coord-to-content : hash[(list num num) -o> (listof syntax)] ;; coord-to-content : hash[(list num num) -o> (listof syntax)]
(define coord-to-content (make-hash)) (define coord-to-content (make-hash))
@ -28,7 +28,9 @@
cells)) cells))
(define (cell-stx-object cell) (define (cell-stx-object cell)
(datum->syntax #f " " cell)) (if (hash-has-key? coord-to-content cell)
(datum->syntax #f " " (hash-ref coord-to-content cell))
#f))
;; build up the coord-to-content mapping for the ;; build up the coord-to-content mapping for the
;; boundary cells and build up the pattern-vars table ;; boundary cells and build up the pattern-vars table
@ -56,9 +58,11 @@
(length rhses-lst)) (length rhses-lst))
stx stx
(cell-stx-object (car (syntax-e cells-stx))))) (cell-stx-object (car (syntax-e cells-stx)))))
(define pat (car (syntax->list rhses))) (define pat (car rhses-lst))
(hash-set! pattern-vars (car cells) (bound-vars (parse pat))) (hash-set! pattern-vars (car cells) (bound-vars (parse pat)))])
(hash-set! coord-to-content (car cells) pat)])) (when (pair? rhses-lst)
(define pat (car rhses-lst))
(hash-set! coord-to-content (car cells) pat)))
;; build up the coord-to-content mapping for the non-boundary cells ;; build up the coord-to-content mapping for the non-boundary cells
;; use the pattern-vars table to build up the let-bindings that ;; use the pattern-vars table to build up the let-bindings that
@ -73,8 +77,7 @@
(format "cell at ~a,~a should not be empty" (format "cell at ~a,~a should not be empty"
(list-ref (car cells) 0) (list-ref (car cells) 0)
(list-ref (car cells) 1)) (list-ref (car cells) 1))
stx stx))
(cell-stx-object (car cells))))
(define horizontal-vars (hash-ref pattern-vars (list (list-ref (car cells) 0) 0))) (define horizontal-vars (hash-ref pattern-vars (list (list-ref (car cells) 0) 0)))
(define vertical-vars (hash-ref pattern-vars (list 0 (list-ref (car cells) 1)))) (define vertical-vars (hash-ref pattern-vars (list 0 (list-ref (car cells) 1))))