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

Modify cfg-parser's treatment of error function so it can consume both arity-3 and arity-5 error functions.

Browse Source 
Meant to match the interface provided by parser-tools/yacc's parser.
This commit is contained in:
Danny Yoo 2013-01-15 15:19:28 -07:00
parent 7ab7d97f01
commit 3d1f8b4406
1 changed files with 72 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
collects/parser-tools/cfg-parser.rkt
View File

@ -744,14 +744,20 @@
val val
(next success-k fail-k max-depth tasks)))] (next success-k fail-k max-depth tasks)))]
[fail-k (lambda (max-depth tasks) [fail-k (lambda (max-depth tasks)
(define (call-error-proc tok-ok? tok-name tok-value start-pos end-pos)
(cond
[(procedure-arity-includes? error-proc 5)
(error-proc tok-ok? tok-name tok-value start-pos end-pos)]
[else
(error-proc tok-ok? tok-name tok-value)]))
(cond (cond
[(null? tok-list) [(null? tok-list)
(if error-proc (if error-proc
(error-proc #t (call-error-proc #t
'no-tokens 'no-tokens
#f #f
(make-position #f #f #f) (make-position #f #f #f)
(make-position #f #f #f)) (make-position #f #f #f))
(error (error
'cfg-parse 'cfg-parse
"no tokens"))] "no tokens"))]
@ -760,11 +766,11 @@
(min (sub1 (length tok-list)) (min (sub1 (length tok-list))
max-depth))]) max-depth))])
(if error-proc (if error-proc
(error-proc #t (call-error-proc #t
(tok-orig-name bad-tok) (tok-orig-name bad-tok)
(tok-val bad-tok) (tok-val bad-tok)
(tok-start bad-tok) (tok-start bad-tok)
(tok-end bad-tok)) (tok-end bad-tok))
(error (error
'cfg-parse 'cfg-parse
"failed at ~a" "failed at ~a"
@ -799,6 +805,7 @@
(require (submod "..") (require (submod "..")
parser-tools/lex parser-tools/lex
racket/block racket/block
racket/generator
rackunit) rackunit)
;; Test: parsing regular expressions. ;; Test: parsing regular expressions.
@ -847,7 +854,61 @@
1 13) 1 13)
1 13))) 1 13)))
;; Check that cfg-parser can accept error functions of 3 arguments:
(block
(define-tokens non-terminals (ONE ZERO EOF))
(define parse
(cfg-parser (tokens non-terminals)
(start ones)
(end EOF)
(error (lambda (tok-ok tok-name tok-val)
(error (format "~a ~a ~a" tok-ok tok-name tok-val))))
(grammar [ones [() null]
[(ONE ones) (cons $1 $2)]])))
(define (sequence->tokenizer s)
(define-values (more? next) (sequence-generate s))
(lambda ()
(cond [(more?) (next)]
[else (token-EOF 'eof)])))
(check-exn #rx"#t ZERO zero"
(lambda () (parse (sequence->tokenizer (list (token-ZERO "zero")))))))
;; Check that cfg-parser can accept error functions of 5 arguments:
(block
(define-tokens non-terminals (ONE ZERO EOF))
(define parse
(cfg-parser (tokens non-terminals)
(start ones)
(src-pos)
(end EOF)
(error (lambda (tok-ok tok-name tok-val start-pos end-pos)
(error (format "~a ~a ~a ~a ~a"
tok-ok tok-name tok-val
(position-offset start-pos)
(position-offset end-pos)))))
(grammar [ones [() null]
[(ONE ones) (cons $1 $2)]])))
(define (sequence->tokenizer s)
(define-values (more? next) (sequence-generate s))
(lambda ()
(cond [(more?) (next)]
[else (position-token (token-EOF 'eof)
(position #f #f #f)
(position #f #f #f))])))
(check-exn #rx"#t ZERO zero 2 3"
(lambda ()
(parse
(sequence->tokenizer
(list (position-token
(token-ZERO "zero")
(position 2 2 5)
(position 3 2 6))))))))