From 291cf1f171758db67e9beeb0bd3bd105a0911f76 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 5 Jan 2016 10:52:17 -0600
Subject: [PATCH] 2dmatch: more flexible scrutinee parsing.

---
 2d-doc/scribblings/2d.scrbl  | 20 +++++++++++++++
 2d-lib/match.rkt             | 26 +++++++++++++++++---
 2d-test/tests/match-test.rkt | 47 ++++++++++++++++++++++++++++++++++++
 3 files changed, 89 insertions(+), 4 deletions(-)

diff --git a/2d-doc/scribblings/2d.scrbl b/2d-doc/scribblings/2d.scrbl
index 0f2df25..fd65fcb 100644
--- a/2d-doc/scribblings/2d.scrbl
+++ b/2d-doc/scribblings/2d.scrbl
@@ -205,6 +205,26 @@ See @seclink["Keyboard Shortcuts" #:doc '(lib "scribblings/drracket/drracket.scr
   against each of the patterns in the row row, and then evaluates
   the corresponding @racket[exprs-cell], returning the value of the 
   last expression in that cell.
+
+  Within the top-left cell, the leftmost expression will count as
+  @racket[col-expr], and the rightmost as @racket[row-expr]. In case of a tie
+  (i.e., both expressions start at the same column, but on different lines),
+  the bottommost one will count as @racket[col-expr]. For example, all of
+  these are valid:
+
+  @racketblock[╔═════════════════╗
+               ║col-expr row-expr║
+               ╚═════════════════╝]
+  @racketblock[╔═════════════════╗
+               ║         row-expr║
+               ║col-expr         ║
+               ╚═════════════════╝]
+  @racketblock[╔════════╗
+               ║row-expr║
+               ║col-expr║
+               ╚════════╝]
+
+  @history[#:changed "6.4"]{Made scrutinee parsing more flexible.}
 }
 
 @section{2D Tabular}
diff --git a/2d-lib/match.rkt b/2d-lib/match.rkt
index 4111e66..d414404 100644
--- a/2d-lib/match.rkt
+++ b/2d-lib/match.rkt
@@ -44,11 +44,29 @@
               (raise-syntax-error '2dmatch "cell at 0,0 must contain two expressions"
                                   (cell-stx-object (car cells))))
             (with-syntax ([(left-x right-x) (generate-temporaries rhses)]
-                          [(left-arg right-arg) rhses])
-              (set! let-bindings (list* #`[right-x right-arg]
-                                        #`[left-x left-arg]
+                          [(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)]))
+              (set! let-bindings (list* #`[row-x #,row-arg]
+                                        #`[col-x #,col-arg]
                                         let-bindings))
-              (set! main-args #'(left-x right-x)))]
+              (set! main-args #'(row-x col-x)))]
            [(on-boundary? cells)
             (unless (and rhses-lst (= 1 (length rhses-lst)))
               (raise-syntax-error '2dmatch 
diff --git a/2d-test/tests/match-test.rkt b/2d-test/tests/match-test.rkt
index 7b36786..a30e794 100644
--- a/2d-test/tests/match-test.rkt
+++ b/2d-test/tests/match-test.rkt
@@ -71,3 +71,50 @@
  ║   y    ║       ║
  ╚════════╩═══════╝
  4)
+
+(check-equal? ; test that leftmost scrutinee is column
+ #2dmatch
+ ╔══════╦═══╦═══╗
+ ║ 1  3 ║ 3 ║ 4 ║
+ ╠══════╬═══╬═══╣
+ ║ 1    ║'a ║'b ║
+ ╠══════╬═══╬═══╣
+ ║ 2    ║'c ║'d ║
+ ╚══════╩═══╩═══╝
+ 'a)
+
+(check-equal? ; test that bottommost scrutinee is column
+ #2dmatch
+ ╔═══╦═══╦═══╗
+ ║ 3 ║ 3 ║ 4 ║
+ ║ 1 ║   ║   ║
+ ╠═══╬═══╬═══╣
+ ║ 1 ║'a ║'b ║
+ ╠═══╬═══╬═══╣
+ ║ 2 ║'c ║'d ║
+ ╚═══╩═══╩═══╝
+ 'a)
+
+(check-equal?
+ #2dmatch
+ ╔══════╦═══╦═══╗
+ ║    3 ║ 3 ║ 4 ║
+ ║ 1    ║   ║   ║
+ ╠══════╬═══╬═══╣
+ ║ 1    ║'a ║'b ║
+ ╠══════╬═══╬═══╣
+ ║ 2    ║'c ║'d ║
+ ╚══════╩═══╩═══╝
+ 'a)
+
+(check-equal?
+ #2dmatch
+ ╔══════╦═══╦═══╗
+ ║ 1    ║ 3 ║ 4 ║
+ ║    3 ║   ║   ║
+ ╠══════╬═══╬═══╣
+ ║ 1    ║'a ║'b ║
+ ╠══════╬═══╬═══╣
+ ║ 2    ║'c ║'d ║
+ ╚══════╩═══╩═══╝
+ 'a)