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

progress on 2d

Browse Source
This commit is contained in:
Robby Findler 2013-01-16 17:09:01 -06:00
parent 6349f85b08
commit 7df363c523
1 changed files with 304 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

463
collects/unstable/2d/reader.rkt
View File

@ -7,22 +7,32 @@
(for-syntax racket/base (for-syntax racket/base
racket/list)) racket/list))
(define all-line-of-interest (make-hash))
(define current-lines (make-parameter #f))
(define-syntax (line-of-interest stx)
(with-syntax ([line (syntax-line stx)])
(syntax-local-lift-expression #'(hash-set! all-line-of-interest line #t))
#'(visited line)))
(define (visited line)
(define t (current-lines))
(when t
(hash-remove! t line)))
(define rt (define rt
(make-readtable (make-readtable
#f #f
#\2 #\2
'dispatch-macro 'dispatch-macro
(λ (char port source _line _col _pos) (λ (char port source _line _col _pos)
(define pport (peeking-input-port port)) (define next-char (peek-char port))
(define dcond-count 5)
(define dcond (for/list ([i (in-range dcond-count)]) (read-char pport)))
(cond (cond
[(equal? dcond '(#\d #\c #\o #\n #\d)) [(equal? next-char #\d)
(define chars-read 0) (define chars-read 2) ;; account for the # and the 2
(define (rc) (define (rc)
(set! chars-read (+ chars-read 1)) (set! chars-read (+ chars-read 1))
(read-char port)) (read-char port))
(for ([i (in-range dcond-count)]) (rc)) (rc) ;; get the #\d
(define nl (rc)) (define nl (rc))
(cond (cond
[(equal? nl #\newline) (void)] [(equal? nl #\newline) (void)]
@ -30,10 +40,11 @@
(when (equal? #\newline (peek-char port)) (when (equal? #\newline (peek-char port))
(rc))] (rc))]
[else [else
(raise-read-error "expected a newline to follow #2dcond" (line-of-interest)
(raise-read-error "expected a newline to follow #2d"
(object-name port) (object-name port)
_line _col _pos _line _col _pos
6)]) 2)])
(parse-2dcond port source _line _col _pos chars-read)] (parse-2dcond port source _line _col _pos chars-read)]
[else [else
(read/recursive (read/recursive
@ -45,9 +56,11 @@
(define current-line-number _line) (define current-line-number _line)
(define current-line-start-position (+ _pos chars-read)) (define current-line-start-position (+ _pos chars-read))
(define current-line "") (define current-line "")
(define table-column-breaks '())
(define initial-space-count 0) (define initial-space-count 0)
(define initial-column-guide #f)
(define newline-char-count 0) (define newline-char-count 0)
(define table-column-breaks '())
(define table-column-guides '())
(define current-row 0) (define current-row 0)
(define cell-connections (make-hash)) (define cell-connections (make-hash))
@ -96,70 +109,93 @@
(define (process-first-line) (define (process-first-line)
(fetch-next-line) (fetch-next-line)
(cond (let loop ([pos 0])
[(eq? current-line 'terminator) (cond
(readerr "expected to find a table" port)] [(< pos (string-length current-line))
[else
(let loop ([pos 0])
(cond (cond
[(< pos (string-length current-line)) [(equal? #\space (string-ref current-line pos))
(cond (loop (+ pos 1))]
[(equal? #\space (string-ref current-line pos)) [(equal? #\╔ (string-ref current-line pos))
(loop (+ pos 1))] (set! initial-column-guide (make-a-guide pos))
[(equal? #\╔ (string-ref current-line pos)) (set! initial-space-count pos)]
(set! initial-space-count pos)]
[else
(readerr "expected the first character in the table to be ╔"
pos 1)])]
[else [else
(readerr "expected some non-whitespace characters in the first line of the table" (line-of-interest)
0 (readerr "expected the first character in the table to be ╔"
pos)])) pos)])]
(set! table-column-breaks [else
(let loop ([pos (+ initial-space-count 1)] (line-of-interest)
[current-column-width 0] (readerr "expected some non-whitespace characters in the first line of the table"
[column 0]) 0
(cond pos)]))
[(< pos (string-length current-line)) (let loop ([pos (+ initial-space-count 1)]
(case (string-ref current-line pos) [current-column-width 0]
[(#\╦) [column 0])
(add-node column 0) (cond
(cons current-column-width (loop (+ pos 1) 0 (+ column 1)))] [(< pos (string-length current-line))
[(#\═) (loop (+ pos 1) (+ current-column-width 1) column)] (case (string-ref current-line pos)
[(#\╗) [(#\╦)
(add-node column 0) (add-node column 0)
(let loop ([pos (+ pos 1)]) (cons current-column-width (loop (+ pos 1) 0 (+ column 1)))]
(when (< pos (string-length current-line)) [(#\═) (loop (+ pos 1) (+ current-column-width 1) column)]
(cond [(#\╗)
[(char-whitespace? (string-ref current-line pos)) (add-node column 0)
(loop (+ pos 1))] (let loop ([pos (+ pos 1)])
[else (when (< pos (string-length current-line))
(readerr "expected only whitespace to follow ╗ (on the same line)" pos)])) (cond
(list current-column-width))])] [(char-whitespace? (string-ref current-line pos))
[else (loop (+ pos 1))]
(readerr "expected ╗ to terminate the first line" pos)])))])) [else
(line-of-interest)
(readerr "expected only whitespace to follow ╗ (on the same line)" pos)]))
(list current-column-width))])]
[else
(line-of-interest)
(readerr "expected ╗ to terminate the first line" pos)]))
(let loop ([pos (+ initial-space-count 1)]
[current-column-width 0]
[column 0]
[column-breaks '()]
[column-guides '()])
(cond
[(< pos (string-length current-line))
(case (string-ref current-line pos)
[(#\╦)
(add-node column 0)
(loop (+ pos 1) 0 (+ column 1)
(cons current-column-width column-breaks)
(cons (make-a-guide pos) column-guides))]
[(#\═) (loop (+ pos 1) (+ current-column-width 1) column
column-breaks column-guides)]
[(#\╗)
(add-node column 0)
(whitespace-to-end (+ pos 1))
(set! table-column-breaks (reverse (cons current-column-width column-breaks)))
(set! table-column-guides (reverse (cons (make-a-guide pos) column-guides)))])]
[else
(line-of-interest)
(readerr "expected ╗ to terminate the first line" pos)])))
(define (process-a-line current-map) (define (process-a-line current-map)
(fetch-next-line) (fetch-next-line)
(cond ;; check leading space
[(eq? current-line 'terminator) (let loop ([n 0])
(readerr "incomplete table" port)] (cond
[else [(= n initial-space-count) (void)]
;; check leading space [(and (< n (string-length current-line))
(let loop ([n 0]) (equal? #\space (string-ref current-line n)))
(cond (loop (+ n 1))]
[(= n initial-space-count) (void)] [else
[(and (< n (string-length current-line)) (line-of-interest)
(equal? #\space (string-ref current-line n))) (readerr "expected leading space" n)]))
(loop (+ n 1))] (case (string-ref current-line initial-space-count)
[else [(#\║) (continue-line current-map)]
(readerr "expected leading space" n)])) [(#\╠) (start-new-block current-map)]
(case (string-ref current-line initial-space-count) [(#\╚) (finish-table current-map)]
[(#\║) (continue-line current-map)] [else
[(#\╠) (start-new-block current-map)] (line-of-interest)
[(#\╚) (finish-table current-map)] (readerr/expected '(#\║ #\╠ #\╚)
[else (readerr/expected '(#\║ #\╠ #\╚) initial-space-count
initial-space-count)])])) #:guides (list initial-column-guide))]))
(define (start-new-block previous-map) (define (start-new-block previous-map)
(set! current-row (+ current-row 1)) (set! current-row (+ current-row 1))
@ -172,6 +208,10 @@
;; we're currently traversing is there (or not) ;; we're currently traversing is there (or not)
[cell-wall-broken? #f] [cell-wall-broken? #f]
;; the srcloc of the spot that led us to the decision
;; of which boolean that cell-wall-broken? should be
[cell-wall-guide (make-a-guide initial-space-count)]
;; this is the result, being built up backwards ;; this is the result, being built up backwards
[map '()] [map '()]
@ -183,12 +223,15 @@
(cond (cond
[(zero? current-cell-size) [(zero? current-cell-size)
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(readerr "line ended too soon")) (line-of-interest)
(readerr "line ended too soon" pos))
(define sep (string-ref current-line pos)) (define sep (string-ref current-line pos))
(cond (cond
[(and cell-wall-broken? (not (car previous-map))) [(and cell-wall-broken? (not (car previous-map)))
(when (table-char? (string-ref current-line pos)) (unless (equal? sep #\╔)
(readerr "expected not to find a cell boundary character" pos))] (when (table-char? sep)
(line-of-interest)
(readerr "expected not to find a cell boundary character" pos)))]
[else [else
(define allowed-chars (define allowed-chars
(if (null? table-column-breaks) (if (null? table-column-breaks)
@ -200,6 +243,7 @@
(get-one (not cell-wall-broken?) (car previous-map) #t #t)))) (get-one (not cell-wall-broken?) (car previous-map) #t #t))))
(set! allowed-chars (filter values allowed-chars)) (set! allowed-chars (filter values allowed-chars))
(unless (member sep allowed-chars) (unless (member sep allowed-chars)
(line-of-interest)
(readerr/expected allowed-chars pos))]) (readerr/expected allowed-chars pos))])
(cond (cond
[(null? table-column-breaks) [(null? table-column-breaks)
@ -220,23 +264,32 @@
(cdr table-column-breaks) (cdr table-column-breaks)
(+ pos 1) (+ pos 1)
next-cell-wall-broken? next-cell-wall-broken?
(make-a-guide pos)
(cons edge-going-down? map) (cons edge-going-down? map)
(cdr previous-map) (cdr previous-map)
next-column)])] next-column)])]
[else [else
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(line-of-interest)
(readerr "line ended in the middle of a cell" pos)) (readerr "line ended in the middle of a cell" pos))
(cond (cond
[cell-wall-broken? [cell-wall-broken?
(when (table-char? (string-ref current-line pos)) (when (table-char? (string-ref current-line pos))
(readerr "expected not to find a cell boundary character" pos))] (line-of-interest)
(readerr
(format "expected not to find a cell boundary character (based on earlier ~a)"
(guide-char cell-wall-guide))
pos
#:guides (list cell-wall-guide)))]
[else [else
(unless (equal? (string-ref current-line pos) #\═) (unless (equal? (string-ref current-line pos) #\═)
(line-of-interest)
(readerr/expected '(#\═) pos))]) (readerr/expected '(#\═) pos))])
(loop (- current-cell-size 1) (loop (- current-cell-size 1)
table-column-breaks table-column-breaks
(+ pos 1) (+ pos 1)
cell-wall-broken? cell-wall-broken?
cell-wall-guide
map map
previous-map previous-map
current-column)]))) current-column)])))
@ -250,13 +303,16 @@
(cond (cond
[(zero? current-cell-size) [(zero? current-cell-size)
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(line-of-interest)
(readerr "line ended at the boundary of a cell, expected the edge of the cell" pos)) (readerr "line ended at the boundary of a cell, expected the edge of the cell" pos))
(cond (cond
[(car map) [(car map)
(unless (equal? (string-ref current-line pos) #\║) (unless (equal? (string-ref current-line pos) #\║)
(line-of-interest)
(readerr/expected '(#\║) pos))] (readerr/expected '(#\║) pos))]
[else [else
(when (table-char? (string-ref current-line pos)) (when (table-char? (string-ref current-line pos))
(line-of-interest)
(readerr "expected not to find a cell boundary character" pos))]) (readerr "expected not to find a cell boundary character" pos))])
(cond (cond
[(null? table-column-breaks) [(null? table-column-breaks)
@ -269,8 +325,10 @@
(+ column-number 1))])] (+ column-number 1))])]
[else [else
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(line-of-interest)
(readerr "line ended in the middle of a cell" pos)) (readerr "line ended in the middle of a cell" pos))
(when (table-char? (string-ref current-line pos)) (when (table-char? (string-ref current-line pos))
(line-of-interest)
(readerr "expected not to find a cell boundary character" pos)) (readerr "expected not to find a cell boundary character" pos))
(loop (- current-cell-size 1) (loop (- current-cell-size 1)
table-column-breaks table-column-breaks
@ -288,6 +346,7 @@
(cond (cond
[(zero? current-cell-size) [(zero? current-cell-size)
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(line-of-interest)
(readerr "line ended in the middle of a cell" pos)) (readerr "line ended in the middle of a cell" pos))
(define expected-char (define expected-char
(cond (cond
@ -295,6 +354,7 @@
[(car map) #\╩] [(car map) #\╩]
[else #\═])) [else #\═]))
(unless (equal? (string-ref current-line pos) expected-char) (unless (equal? (string-ref current-line pos) expected-char)
(line-of-interest)
(readerr/expected (list expected-char) pos)) (readerr/expected (list expected-char) pos))
(cond (cond
[(null? table-column-breaks) [(null? table-column-breaks)
@ -306,8 +366,10 @@
(+ pos 1))])] (+ pos 1))])]
[else [else
(unless (< pos (string-length current-line)) (unless (< pos (string-length current-line))
(line-of-interest)
(readerr "line ended in the middle of a cell" pos)) (readerr "line ended in the middle of a cell" pos))
(unless (equal? (string-ref current-line pos) #\═) (unless (equal? (string-ref current-line pos) #\═)
(line-of-interest)
(readerr/expected '(#\═) pos)) (readerr/expected '(#\═) pos))
(loop (- current-cell-size 1) (loop (- current-cell-size 1)
table-column-breaks table-column-breaks
@ -318,19 +380,41 @@
(let loop ([pos pos]) (let loop ([pos pos])
(when (< pos (string-length current-line)) (when (< pos (string-length current-line))
(unless (equal? #\space (string-ref current-line pos)) (unless (equal? #\space (string-ref current-line pos))
(line-of-interest)
(readerr "expected only whitespace outside of the table" pos)) (readerr "expected only whitespace outside of the table" pos))
(loop (+ pos 1))))) (loop (+ pos 1)))))
(define (readerr/expected chars pos-in-line)
(readerr (format "expected ~a" (chars->desc chars))
pos-in-line))
(define (readerr msg pos-in-line [span 1]) (struct guide (char srcloc))
(raise-read-error msg (object-name port)
(define (make-a-guide pos-in-line)
(guide (string-ref current-line pos-in-line)
(srcloc source current-line-number pos-in-line
(+ current-line-start-position pos-in-line)
1)))
(define (readerr/expected chars pos-in-line #:guides [guides '()])
(readerr (format "expected ~a~a~a"
(if (null? (cdr chars))
""
"one of ")
(chars->desc chars "or")
(if (null? guides)
""
(format " (based on earlier ~a)"
(chars->desc (map guide-char guides)
"and"))))
pos-in-line
#:guides guides))
(define (readerr msg pos-in-line [span 1] #:guides [guides '()])
(raise-read-error msg
source
current-line-number current-line-number
pos-in-line pos-in-line
(+ current-line-start-position pos-in-line) (+ current-line-start-position pos-in-line)
span)) span
#:extra-srclocs (map guide-srcloc guides)))
(process-first-line) (process-first-line)
(let loop ([map (map (λ (x) #t) table-column-breaks)]) (let loop ([map (map (λ (x) #t) table-column-breaks)])
@ -343,7 +427,7 @@
;; chars : non-empty-list-of-char -> string ;; chars : non-empty-list-of-char -> string
(define (chars->desc chars) (define (chars->desc chars sep)
(cond (cond
[(null? (cdr chars)) [(null? (cdr chars))
(format "~a" (car chars))] (format "~a" (car chars))]
@ -351,16 +435,20 @@
(define commas? (pair? (cddr chars))) (define commas? (pair? (cddr chars)))
(apply (apply
string-append string-append
"one of" (let loop ([chars chars]
(let loop ([chars chars]) [first? #t])
(cond (cond
[(null? (cdr chars)) [(null? (cdr chars))
(list (format " or ~a" (car chars)))] (list (format "~a~a ~a"
(if first? "" " ")
sep
(car chars)))]
[else [else
(cons (format " ~a~a" (cons (format "~a~a~a"
(if first? "" " ")
(car chars) (car chars)
(if commas? "," "")) (if commas? "," ""))
(loop (cdr chars)))])))])) (loop (cdr chars) #f))])))]))
(define table-chars '(#\═ #\║ #\╔ #\╦ #\╗ #\╠ #\╬ #\╣ #\╚ #\╩ #\╝)) (define table-chars '(#\═ #\║ #\╔ #\╦ #\╗ #\╠ #\╬ #\╣ #\╚ #\╩ #\╝))
(define (table-char? c) (member c table-chars)) (define (table-char? c) (member c table-chars))
@ -377,16 +465,18 @@
(module+ test (module+ test
(require rackunit) (require rackunit)
(check-equal? (chars->desc '(#\a)) (define touched-lines-table (make-hash))
(check-equal? (chars->desc '(#\a) "or")
"a") "a")
(check-equal? (chars->desc '(#\a #\b)) (check-equal? (chars->desc '(#\a #\b) "or")
"one of a or b") "a or b")
(check-equal? (chars->desc '(#\a #\b #\c)) (check-equal? (chars->desc '(#\a #\b #\c) "or")
"one of a, b, or c") "a, b, or c")
(check-equal? (chars->desc '(#\a #\b #\c #\d)) (check-equal? (chars->desc '(#\a #\b #\c #\d) "or")
"one of a, b, c, or d") "a, b, c, or d")
(check-equal? (chars->desc '(#\a #\b #\c #\d #\e)) (check-equal? (chars->desc '(#\a #\b #\c #\d #\e) "or")
"one of a, b, c, d, or e") "a, b, c, d, or e")
(check-equal? (read (open-input-string "#2(x)")) (check-equal? (read (open-input-string "#2(x)"))
(parameterize ([current-readtable rt]) (parameterize ([current-readtable rt])
@ -399,41 +489,44 @@
(check-regexp-match #rx"expected a newline" (check-regexp-match #rx"expected a newline"
(with-handlers ((exn:fail? exn-message)) (with-handlers ((exn:fail? exn-message))
(parameterize ([current-readtable rt]) (parameterize ([current-readtable rt])
(read (open-input-string "#2dcond"))))) (read (open-input-string "#2d")))))
(define (get-err-positions inputs) (define (get-err-locs inputs)
(with-handlers ((exn:fail:read? (with-handlers ([exn:fail:read?
(λ (exn) (λ (exn)
(map srcloc-position (exn:fail:read-srclocs exn))))) (for/list ([s (exn:fail:read-srclocs exn)])
(struct-copy srcloc s [source #f])))])
(define p (open-input-string (apply string-append inputs)))
(port-count-lines! p)
(parameterize ([current-readtable rt]) (parameterize ([current-readtable rt])
(read (open-input-string (apply string-append inputs)))) (read p))
#f)) #f))
(define (get-graph inputs) (define (get-graph inputs)
(define p (open-input-string (apply string-append inputs))) (define p (open-input-string (apply string-append inputs)))
(port-count-lines! p) (port-count-lines! p)
;; account for the "#2dcond" that was read from the first line ;; account for the "#2d" that was read from the first line
(parse-2dcond p "source" 1 0 1 6)) (parse-2dcond p "source" 1 0 1 2))
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
"╔══╦══╗\n" "╔══╦══╗\n"
"║1 ║2 ║\n" "║1 ║2 ║\n"
"╠══╬══╣\n" "╠══╬══╣\n"
"║4 ║3 ║\n" "║4 ║3 ║\n"
"╚══╩══╝\n")) "╚══╩══╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╗\n" " ╔══╦══╗\n"
" ║1 ║4 ║\n" " ║1 ║4 ║\n"
" ╠══╬══╣\n" " ╠══╬══╣\n"
" ║2 ║3 ║\n" " ║2 ║3 ║\n"
" ╚══╩══╝\n")) " ╚══╩══╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╦══╗\n" " ╔══╦══╦══╗\n"
" ║1 ║2 ║3 ║\n" " ║1 ║2 ║3 ║\n"
" ╠══╬══╬══╣\n" " ╠══╬══╬══╣\n"
@ -442,8 +535,8 @@
" ║7 ║8 ║9 ║\n" " ║7 ║8 ║9 ║\n"
" ╚══╩══╩══╝\n")) " ╚══╩══╩══╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╦══╗\n" " ╔══╦══╦══╗\n"
" ║ 1║ 2║ 3║\n" " ║ 1║ 2║ 3║\n"
" ╠══╬══╩══╣\n" " ╠══╬══╩══╣\n"
@ -452,8 +545,8 @@
" ║ 5║ ║\n" " ║ 5║ ║\n"
" ╚══╩═════╝\n")) " ╚══╩═════╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╦══╗\n" " ╔══╦══╦══╗\n"
" ║ 1║ 2║ 3║\n" " ║ 1║ 2║ 3║\n"
" ╠══╬══╩══╣\n" " ╠══╬══╩══╣\n"
@ -462,16 +555,16 @@
" ║ 6║7 ║\n" " ║ 6║7 ║\n"
" ╚══╩═════╝\n")) " ╚══╩═════╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╦══╦══╗\n" " ╔══╦══╦══╦══╗\n"
" ║ 1║ 2║ 3║ 4║\n" " ║ 1║ 2║ 3║ 4║\n"
" ╠══╬══╬══╩══╣\n" " ╠══╬══╬══╩══╣\n"
" ║ 4║ 5║ 6 ║\n" " ║ 4║ 5║ 6 ║\n"
" ╚══╩══╩═════╝\n")) " ╚══╩══╩═════╝\n"))
#f) #f)
(check-equal? (get-err-positions (check-equal? (get-err-locs
'("#2dcond\n" '("#2d\n"
" ╔══╦══╦══╗\n" " ╔══╦══╦══╗\n"
" ║1 ║2 ║3 ║\n" " ║1 ║2 ║3 ║\n"
" ╠══╬══╬══╣\n" " ╠══╬══╬══╣\n"
@ -480,30 +573,31 @@
" ║5 ║6 ║7 ║\n" " ║5 ║6 ║7 ║\n"
" ╚══╩══╩══╝\n")) " ╚══╩══╩══╝\n"))
#f) #f)
(check-equal? (get-err-positions
'("#2dcond\n" (define lines-table (hash-copy all-line-of-interest))
" ╔══╦══╗\n" (parameterize ([current-lines lines-table])
" ║ ║ ║\n" (check-equal? (get-err-locs
" ╠══╣ ║\n" '("#2d\n"
" ║ ║ ║\n" " ╔══╦══╗\n"
" ╚══╩══╝\n")) " ║ ║\n"
'(something)) ;; that first ═ line has to go all the way across " ╠══╬══╣\n"
(check-equal? (get-err-positions " ║ ║ ║\n"
'("#2dcond\n" " ╚══╩══╝\n"))
" ╔══╦══╗\n" (list (srcloc #f 3 2 17 1)
" ║ ║\n" (srcloc #f 2 2 7 1)))
" ╠══╬══╣\n" (check-equal? (get-err-locs
" ║ ║ ║\n" '("#2d\n"
" ╚══╩══╝\n")) " ╔══╦══╗\n"
'(12 2)) " ║ ═║ ║\n"
(check-equal? (get-err-positions " ╠══╬══╣\n"
'("#2dcond\n" " ║ ║ ║\n"
" ╔══╦══╗\n" " ╚══╩══╝\n"))
" ║ ═║ ║\n" (list (srcloc #f 3 4 19 1)
" ╠══╬══╣\n" (srcloc #f 2 4 9 1))))
" ║ ║ ║\n" (let ([lines (hash-map lines-table (λ (x y) x))])
" ╚══╩══╝\n")) (unless (null? lines)
'(14 4)) (eprintf "no test case for errors on lines: ~s\n"
(sort lines <))))
(check-equal? (get-graph (check-equal? (get-graph
@ -543,34 +637,85 @@
(cons (list 1 2) (set)) (cons (list 1 2) (set))
(cons (list 2 0) (set)) (cons (list 2 0) (set))
(cons (list 2 1) (set)) (cons (list 2 1) (set))
(cons (list 2 2) (set)))))) (cons (list 2 2) (set)))))
(check-equal? (get-graph
'(" ╔══╦══╦══╦══╗\n"
" ║1 ║2 ║3 ║4 ║\n"
" ╠══╬══╩══╩══╣\n"
" ║6 ║5 ║\n"
" ╠══╣ ╔══╗ ║\n"
" ║7 ║ ║10║ ║\n"
" ╠══╣ ╚══╝ ║\n"
" ║7 ║ ║\n"
" ╚══╩════════╝\n"))
(make-hash
(list (cons (list 0 0) (set))
(cons (list 0 1) (set))
(cons (list 0 2) (set))
(cons (list 0 3) (set))
(cons (list 1 0) (set))
(cons (list 1 1) (set (list 1 2) (list 2 1)))
(cons (list 1 2) (set (list 1 1) (list 1 3)))
(cons (list 1 3) (set (list 1 2) (list 2 3)))
(cons (list 2 0) (set))
(cons (list 2 1) (set (list 1 1) (list 3 1)))
(cons (list 2 2) (set))
(cons (list 2 3) (set (list 1 3) (list 3 3)))
(cons (list 3 0) (set))
(cons (list 3 1) (set (list 2 1) (list 3 2)))
(cons (list 3 2) (set (list 3 1) (list 3 3)))
(cons (list 3 3) (set (list 3 2) (list 2 3))))))
#|
;; need to figure out what to do
;; with these examples
(check-equal? (get-err-positions
'("#2d\n"
" ╔══╦══╗\n"
" ║ ║ ║\n"
" ╠══╣ ║\n"
" ║ ║ ║\n"
" ╚══╩══╝\n"))
'(something)) ;; that first ═ line has to go all the way across
(check-equal? (get-err-positions
'("#2d\n"
" ╔══╦══╗\n"
" ║ ║ ║\n"
" ╠══╩══╣\n"
" ║ ║\n"
" ╚═════╝\n"))
'(something)) ;; that first ║ line has to go all the way down
|#
)
#; #;
(module+ main (module+ main
(define s (string-append (define s (string-append
" ╔══╦══╦══╗\n" "#2d\n"
" ║ 1║ 2║ 3║\n" " ╔══╦══╗\n"
" ╠══╬══╩══╣\n" " ║ ║\n"
" ║ 4║ ║\n" " ╠══╬══╣\n"
" ╠══╣ 6 ║\n" " ║ ║ ║\n"
" ║ 5║ ║\n" " ╚══╩══╝\n"))
" ╚══╩═════╝\n"))
#;
(define s (string-append
" ╔══╦══╦══╗\n"
" ║1 ║2 ║3 ║\n"
" ╠══╬══╬══╣\n"
" ║6 ║5 ║4 ║\n"
" ╠══╬══╬══╣\n"
" ║7 ║8 ║9 ║\n"
" ╚══╩══╩══╝\n"))
(define p (open-input-string s)) (define p (open-input-string s))
(port-count-lines! p) (port-count-lines! p)
;; account for the "#2dcond" that was read from the first line (with-handlers ((exn:fail:read? exn:fail:read-srclocs))
(parse-2dcond p "source" 1 0 1 6)) (parameterize ([current-readtable rt])
(read p)))
;; account for the "#2d" that was read from the first line
;; (parse-2dcond p "source" 1 0 1 2)
)
#| #|
╔══╦══╗ ╔══╦══╗
║ ║ ║ ║ ║ ║