improve source location reporting in 2dmatch for empty cells
to make this happen, change the 2d reader so that it puts more specific source location information into the read form
This commit is contained in:
parent
afb99f1e0d
commit
ffd4ea5b6c
|
@ -27,6 +27,9 @@
|
|||
(= 0 (list-ref lst 1))))
|
||||
cells))
|
||||
|
||||
(define (cell-stx-object cell)
|
||||
(datum->syntax #f " " cell))
|
||||
|
||||
;; build up the coord-to-content mapping for the
|
||||
;; boundary cells and build up the pattern-vars table
|
||||
(for ([cells-stx (in-list (syntax->list #'((cell ...) ...)))]
|
||||
|
@ -36,7 +39,8 @@
|
|||
(cond
|
||||
[(member (list 0 0) cells)
|
||||
(unless (and rhses-lst (= 2 (length rhses-lst)))
|
||||
(raise-syntax-error '2dmatch "cell at 0,0 must contain two expressions"))
|
||||
(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]
|
||||
|
@ -50,7 +54,8 @@
|
|||
"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
|
||||
(cell-stx-object (car (syntax-e cells-stx)))))
|
||||
(define pat (car (syntax->list rhses)))
|
||||
(hash-set! pattern-vars (car cells) (bound-vars (parse pat)))
|
||||
(hash-set! coord-to-content (car cells) pat)]))
|
||||
|
@ -68,7 +73,8 @@
|
|||
(format "cell at ~a,~a should not be empty"
|
||||
(list-ref (car cells) 0)
|
||||
(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 vertical-vars (hash-ref pattern-vars (list 0 (list-ref (car cells) 1))))
|
||||
|
||||
|
|
|
@ -214,7 +214,8 @@ example uses:
|
|||
(pending-row '())
|
||||
(rows '())
|
||||
(current-row 0)
|
||||
(cell-connections (make-hash)))))
|
||||
(cell-connections (make-hash))
|
||||
(position-of-first-cell (hash)))))
|
||||
|
||||
(define-syntax (setup-state stx)
|
||||
(syntax-case stx ()
|
||||
|
@ -263,12 +264,13 @@ example uses:
|
|||
(values cell-connections
|
||||
(apply vector (reverse rows))
|
||||
table-column-breaks
|
||||
initial-space-count)])))
|
||||
initial-space-count
|
||||
position-of-first-cell)])))
|
||||
|
||||
(struct guide (char srcloc) #:transparent)
|
||||
|
||||
|
||||
;; parse-2dcond returns three values:
|
||||
;; parse-2dcond returns four values:
|
||||
;; - a hash table encoding a graph that shows where the
|
||||
;; broken walls are in the 2d
|
||||
;; - a vector of lists of strings containing the all of the line
|
||||
|
@ -390,7 +392,7 @@ example uses:
|
|||
(line-of-interest)
|
||||
(readerr "expected ╗ to terminate the first line" pos)])))
|
||||
|
||||
(define (process-a-line current-map)
|
||||
(define (process-a-line current-map previous-line-separator?)
|
||||
(fetch-next-line)
|
||||
;; check leading space
|
||||
(let loop ([n 0])
|
||||
|
@ -403,7 +405,7 @@ example uses:
|
|||
(line-of-interest)
|
||||
(readerr "expected leading space" n)]))
|
||||
(case (string-ref current-line initial-space-count)
|
||||
[(#\║) (values (continue-line current-map) #t)]
|
||||
[(#\║) (values (continue-line current-map previous-line-separator?) #t)]
|
||||
[(#\╠) (values (start-new-block current-map) #f)]
|
||||
[(#\╚) (values (finish-table current-map) #f)]
|
||||
[else
|
||||
|
@ -512,12 +514,13 @@ example uses:
|
|||
previous-map
|
||||
current-column)])))
|
||||
|
||||
(define (continue-line map)
|
||||
(define (continue-line map previous-line-separator?)
|
||||
(let loop ([current-cell-size (car table-column-breaks)]
|
||||
[table-column-breaks (cdr table-column-breaks)]
|
||||
[map map]
|
||||
[pos (+ initial-space-count 1)]
|
||||
[column-number 0])
|
||||
[column-number 0]
|
||||
[starting-a-new-cell? #t])
|
||||
(cond
|
||||
[(zero? current-cell-size)
|
||||
(unless (< pos current-line-length)
|
||||
|
@ -540,7 +543,8 @@ example uses:
|
|||
(cdr table-column-breaks)
|
||||
(cdr map)
|
||||
(+ pos 1)
|
||||
(+ column-number 1))])]
|
||||
(+ column-number 1)
|
||||
#t)])]
|
||||
[else
|
||||
(unless (< pos current-line-length)
|
||||
(line-of-interest)
|
||||
|
@ -548,11 +552,19 @@ example uses:
|
|||
(when (double-barred-char? (string-ref current-line pos))
|
||||
(line-of-interest)
|
||||
(readerr "expected not to find a cell boundary character" pos))
|
||||
(when previous-line-separator?
|
||||
(when starting-a-new-cell?
|
||||
(set! position-of-first-cell
|
||||
(hash-set
|
||||
position-of-first-cell
|
||||
(list column-number current-row)
|
||||
(guide-srcloc (make-a-guide pos))))))
|
||||
(loop (- current-cell-size 1)
|
||||
table-column-breaks
|
||||
map
|
||||
(+ pos 1)
|
||||
column-number)]))
|
||||
column-number
|
||||
#f)]))
|
||||
map)
|
||||
|
||||
|
||||
|
@ -640,10 +652,11 @@ example uses:
|
|||
(let loop ([map (or last-left-map
|
||||
(begin
|
||||
(process-first-line)
|
||||
(map (λ (x) #t) table-column-breaks)))])
|
||||
(define-values (next-map continue?) (process-a-line map))
|
||||
(map (λ (x) #t) table-column-breaks)))]
|
||||
[previous-line-separator? #t])
|
||||
(define-values (next-map continue?) (process-a-line map previous-line-separator?))
|
||||
(cond
|
||||
[continue? (loop next-map)]
|
||||
[continue? (loop next-map #f)]
|
||||
[next-map next-map]
|
||||
[else #f])))
|
||||
|
||||
|
|
|
@ -71,9 +71,15 @@ example uses:
|
|||
'()]
|
||||
[else (cons c (loop))])))
|
||||
(define-values (post-2d-line post-2d-col post-2d-span) (port-next-location port))
|
||||
(define-values (cell-connections lines table-column-breaks initial-space-count)
|
||||
(define-values (cell-connections
|
||||
lines
|
||||
table-column-breaks
|
||||
initial-space-count
|
||||
position-of-first-cell)
|
||||
(parse-2dcond port source _line _col _pos chars-read))
|
||||
(define lhses (close-cell-graph cell-connections (length table-column-breaks) (vector-length lines)))
|
||||
(define lhses (close-cell-graph cell-connections
|
||||
(length table-column-breaks)
|
||||
(vector-length lines)))
|
||||
(define scratch-string (make-string (for/sum ([ss (in-vector lines)])
|
||||
(for/sum ([s (in-list ss)])
|
||||
(string-length s)))
|
||||
|
@ -89,6 +95,21 @@ example uses:
|
|||
(set-port-next-location! kwd-port _line (and _col (+ _col 1)) (and _pos (+ _pos 1)))
|
||||
(define kwd-stx (read-syntax source kwd-port))
|
||||
|
||||
(define line-width (+ initial-space-count
|
||||
(apply + table-column-breaks)
|
||||
(max 0 (- (length table-column-breaks) 1))))
|
||||
|
||||
(define (add-srclocs indicies)
|
||||
(for/list ([index (in-list indicies)])
|
||||
(define srcloc (hash-ref position-of-first-cell index))
|
||||
(datum->syntax #f
|
||||
index
|
||||
(vector (srcloc-source srcloc)
|
||||
#f ;; line
|
||||
#f ;; col
|
||||
(srcloc-position srcloc)
|
||||
1))))
|
||||
|
||||
`(,kwd-stx
|
||||
|
||||
,table-column-breaks
|
||||
|
@ -104,7 +125,7 @@ example uses:
|
|||
(define scratch-port (open-input-string scratch-string))
|
||||
(when post-2d-line (port-count-lines! scratch-port))
|
||||
(set-port-next-location! scratch-port post-2d-line post-2d-col post-2d-span)
|
||||
`[,(sort (set->list set-of-indicies) compare/xy)
|
||||
`[,(add-srclocs (sort (set->list set-of-indicies) compare/xy))
|
||||
,@(read-subparts source scratch-port
|
||||
initial-space-count table-column-breaks heights set-of-indicies
|
||||
/recursive)]))]
|
||||
|
|
|
@ -85,6 +85,58 @@ well-formed @litchar{#2d} expression. In this case, the @racket[2dmatch]
|
|||
treats any of the situations that fall into the larger regions as
|
||||
the same.
|
||||
|
||||
In general, a @litchar{#2d} expression, when read, turns into an expression
|
||||
with at least two sub-pieces (not counting the initial name). The first is
|
||||
a sequence of numbers giving the widths of the top row of cells;
|
||||
the second is also a sequence of numbers, this time giving the heights
|
||||
of the leftmost column of cells. The remaining sequence describe the cells
|
||||
content. The first element of each is itself a sequence of coordinates,
|
||||
one for each of the cells that are connected together. The remaining elements
|
||||
are the subexpressions in the given cells.
|
||||
|
||||
For example, this:
|
||||
|
||||
@codeblock{
|
||||
#lang unstable/2d racket
|
||||
'#2dex
|
||||
╔══════════╦══════════╗
|
||||
║ 0 ║ 1 ║
|
||||
╠══════════╬══════════╣
|
||||
║ 2 ║ 3 ║
|
||||
╚══════════╩══════════╝
|
||||
}
|
||||
|
||||
evaluates to
|
||||
@racketblock['(2dex (10 10)
|
||||
(2 2)
|
||||
(((0 0)) 0)
|
||||
(((0 1)) 2)
|
||||
(((1 0)) 1)
|
||||
(((1 1)) 3))]
|
||||
|
||||
and this
|
||||
@codeblock{
|
||||
#lang unstable/2d racket
|
||||
'#2dex
|
||||
╔══════════╦══════════╦══════════╗
|
||||
║ 0 ║ 1 2 ║ 3 4 ║
|
||||
╠══════════╬══════════╩══════════╣
|
||||
║ 5 ║ 6 ║
|
||||
╚══════════╩═════════════════════╝
|
||||
}
|
||||
evaluates to
|
||||
@racketblock['(2dex (10 10 10)
|
||||
(2 2)
|
||||
(((0 0)) 0)
|
||||
(((0 1)) 5)
|
||||
(((1 0)) 1 2)
|
||||
(((1 1) (2 1)) 6)
|
||||
(((2 0)) 3 4))]
|
||||
|
||||
In addition, the cells coordinates pairs have source locations of the first
|
||||
character that is inside the corresponding cell. (Currently the span
|
||||
is always @racket[1], but that may change.)
|
||||
|
||||
@section{2D Cond}
|
||||
|
||||
@defmodule[unstable/2d/cond]
|
||||
|
|
Loading…
Reference in New Issue
Block a user