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

Simplify scrutinee parsing.

Browse Source
This commit is contained in:
Vincent St-Amour 2016-01-05 10:53:51 -06:00
parent 291cf1f171
commit 4d8a7c27ff
1 changed files with 9 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
2d-lib/match.rkt
View File

@ -46,23 +46,15 @@
(with-syntax ([(left-x right-x) (generate-temporaries rhses)]
[(first-arg second-arg) rhses])
(define-values (col-arg row-arg)
(cond [(< (syntax-column #'first-arg)
(syntax-column #'second-arg))
;; first argument is to the left, first is column
(values #'first-arg #'second-arg)]
[(= (syntax-column #'first-arg)
(syntax-column #'second-arg))
;; the two are aligned. second has to be below
;; (otherwise it wouldn't be second), second is column
(unless (> (syntax-line #'second-arg)
(syntax-line #'first-arg))
(error (format "2dmatch internal error: second is not below first: ~a ~a"
#'second-arg #'first-arg)))
(values #'second-arg #'first-arg)]
[else
;; first to the right of second, whatever the line
;; second is column
(values #'second-arg #'first-arg)]))
(if (< (syntax-column #'first-arg)
(syntax-column #'second-arg))
;; first argument is to the left of second, first is column
(values #'first-arg #'second-arg)
;; otherwise, second argument is either aligned with first
;; (in which case it's below, otherwise it wouldn't be second)
;; or second is to the left of first
;; either way, second is column
(values #'second-arg #'first-arg)))
(set! let-bindings (list* #`[row-x #,row-arg]
#`[col-x #,col-arg]
let-bindings))