diff --git a/collects/algol60/cfg-parser.rkt b/collects/algol60/cfg-parser.rkt deleted file mode 100644 index 6473583..0000000 --- a/collects/algol60/cfg-parser.rkt +++ /dev/null @@ -1,7 +0,0 @@ -#lang racket/base - -;; Legacy module. cfg-parser used to live in the algol60 collection. -;; This module re-exports its contents for backwards compatibility. - -(require parser-tools/cfg-parser) -(provide (all-from-out parser-tools/cfg-parser)) \ No newline at end of file diff --git a/collects/parser-tools/cfg-parser.rkt b/collects/parser-tools/cfg-parser.rkt index 0d56f8e..07da911 100644 --- a/collects/parser-tools/cfg-parser.rkt +++ b/collects/parser-tools/cfg-parser.rkt @@ -744,14 +744,20 @@ val (next success-k fail-k 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 [(null? tok-list) (if error-proc - (error-proc #t - 'no-tokens - #f - (make-position #f #f #f) - (make-position #f #f #f)) + (call-error-proc #t + 'no-tokens + #f + (make-position #f #f #f) + (make-position #f #f #f)) (error 'cfg-parse "no tokens"))] @@ -760,11 +766,11 @@ (min (sub1 (length tok-list)) max-depth))]) (if error-proc - (error-proc #t - (tok-orig-name bad-tok) - (tok-val bad-tok) - (tok-start bad-tok) - (tok-end bad-tok)) + (call-error-proc #t + (tok-orig-name bad-tok) + (tok-val bad-tok) + (tok-start bad-tok) + (tok-end bad-tok)) (error 'cfg-parse "failed at ~a" @@ -799,6 +805,7 @@ (require (submod "..") parser-tools/lex racket/block + racket/generator rackunit) ;; Test: parsing regular expressions. @@ -847,7 +854,61 @@ 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)))))))) + +