From 1e39817605173d39023e6bc0cd52f59b493290eb Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Fri, 21 Sep 2007 14:28:43 +0000 Subject: [PATCH] Correction to grammar for advanced; Correction to throwing away valuable information in combinator svn: r7394 --- .../private-combinator/combinator.scm | 8 ++- .../private-combinator/errors.scm | 4 +- collects/profj/comb-parsers/parser-units.scm | 60 +++++++++---------- 3 files changed, 34 insertions(+), 38 deletions(-) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index d1ab06f361..9f2cd0d143 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -285,6 +285,7 @@ seq-name (length seen) lst) (cond [(null? correct-rsts) + #;(printf "correct-rsts null for ~a ~a ~n" seq-name (length seen)) (let ([fails (map (lambda (rst) @@ -442,12 +443,13 @@ (printf "look-back choice: ~a vs ~a : ~a > ~a~n" (choice-res-name look-back) (fail-type-name (res-msg old-res)) - (when (choice-res-errors look-back) - (fail-type-chance (choice-res-errors look-back))) + (and (choice-res-errors look-back) + (fail-type-chance (choice-res-errors look-back))) (fail-type-chance (res-msg old-res))) (printf "look-back choice and useds: ~a vs ~a -- ~a ~n" used (and (res? look-back-ref) (res-used look-back-ref)) - (fail-type-used (choice-res-errors look-back)))) + (and (choice-res-errors look-back) + (fail-type-used (choice-res-errors look-back))))) #;(when (pair? look-back) (printf "look-back is a pair~n")) #;(when (res? look-back) diff --git a/collects/combinator-parser/private-combinator/errors.scm b/collects/combinator-parser/private-combinator/errors.scm index ba70f995ab..11d6b80955 100644 --- a/collects/combinator-parser/private-combinator/errors.scm +++ b/collects/combinator-parser/private-combinator/errors.scm @@ -99,10 +99,10 @@ (let ([sorted-opts (sort (options-fail-opts (sequence-fail-found fail-type)) (lambda (a b) (>= (fail-type-chance a) (fail-type-chance b))))]) (if (null? show-sequence) - (fail-type->message (car sorted-opts) + (fail-type->message (sequence-fail-found fail-type) #;(car sorted-opts) (add-to-message (msg (format "This ~a did not begin as expected." id-name)) name (sequence-fail-id fail-type) message-to-date)) - (fail-type->message (car sorted-opts) + (fail-type->message (sequence-fail-found fail-type) #;(car sorted-opts) (add-to-message (msg (format "There is an error in this ~a after ~a, the program resembles a(n) ~a here.~n" id-name (car (reverse show-sequence)) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index 8439f8b255..5f476bc494 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -265,18 +265,6 @@ (define (comma-sep term name) (sequence (term (repeat (sequence (COMMA term) id))) id (string-append "a list of " name))) - (define (variable-declaration type expr share-type? name) - (let* ([f (choose (IDENTIFIER (sequence ((^ IDENTIFIER) EQUAL expr) id)) (string-append name " declaration"))] - [s&e (sequence (type (comma-sep f name) SEMI_COLON) id (string-append name " definition"))] - [s (sequence (type (comma-sep IDENTIFIER name) SEMI_COLON) id (string-append name " definition"))] - [e (sequence (type (^ IDENTIFIER) EQUAL expr SEMI_COLON) id (string-append name " definition"))] - [base (sequence (type (^ IDENTIFIER) SEMI_COLON) id (string-append name " definition"))]) - (cond - [(and expr share-type?) s&e] - [share-type? s] - [expr (choose (e base) (string-append name " definition"))] - [else base]))) - (define name (sequence (IDENTIFIER (repeat (sequence (PERIOD IDENTIFIER) id))) id "name")) @@ -289,17 +277,23 @@ (define name IDENTIFIER) (define identifier IDENTIFIER) - (define (variable-declaration type expr share-type? name) - (let* ([f (choose (identifier (sequence ((^ identifier) EQUAL expr) id)) (string-append name " declaration"))] - [s&e (sequence (type (comma-sep f name) SEMI_COLON) id (string-append name " definition"))] - [s (sequence (type (comma-sep identifier name) SEMI_COLON) id (string-append name " definition"))] - [e (sequence (type (^ identifier) EQUAL expr SEMI_COLON) id (string-append name " definition"))] - [base (sequence (type (^ identifier) SEMI_COLON) id (string-append name " definition"))]) + (define (variable-declaration type expr share-type? end? name) + (let* ([var-name (string-append name " declaration")] + [init (sequence ((^ identifier) EQUAL expr) id var-name)] + [f (choose (identifier init) var-name)] + [s&e (sequence (type (comma-sep f name)) id var-name)] + [s (sequence (type (comma-sep identifier name)) id var-name)] + [e (sequence (type init) id var-name)] + [base (sequence (type (^ identifier)) id var-name)] + [decl + (cond + [(and expr share-type?) (choose (s&e e base) var-name)] + [share-type? s] + [expr (choose (e base) var-name)] + [else base])]) (cond - [(and expr share-type?) s&e] - [share-type? s] - [expr (choose (e base) (string-append name " definition"))] - [else base]))) + [end? (sequence (decl SEMI_COLON) id (string-append name " definition"))] + [else decl]))) ) (define-unit expressions@ @@ -502,9 +496,9 @@ (define (make-field mods type expr share-types?) (cond - [mods (sequence ((repeat-greedy mods) (variable-declaration type expr share-types? "field")) + [mods (sequence ((repeat-greedy mods) (variable-declaration type expr share-types? #t "field")) id "field definition")] - [else (variable-declaration type expr share-types? "field")])) + [else (variable-declaration type expr share-types? #t "field")])) (define (arg type) (sequence (type identifier) id "argument")) @@ -742,7 +736,7 @@ (choose ((return-s #t) (if-s (block #t) #f) (block #t) - (variable-declaration (value+name-type prim-type) expression #f "local variable") + (variable-declaration (value+name-type prim-type) expression #f #t "local variable") (sequence (stmt-expr SEMI_COLON) id)) "statement"))) (define statement (statement-c #f)) @@ -839,7 +833,7 @@ (if (not interact?) (choose ((return-s #t) (if-s (block #t) #f) - (variable-declaration (value+name-type prim-type) expression #f "local variable") + (variable-declaration (value+name-type prim-type) expression #f #t "local variable") (block #t) (assignment (choose (identifier @@ -864,7 +858,7 @@ (args (value+name-type prim-type)) #f identifier)) (define method - (choose ((make-method method-sig-no-abs statement) + (choose ((make-method method-sig-no-abs (repeat-greedy statement)) (method-header method-sig-abs)) "method definition")) (define constructor @@ -948,9 +942,9 @@ (choose ((return-s #t) (if-s #t (eta statement)) (block #t) - (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t "for loop variable") + (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t #f "for loop variable") (comma-sep stmt-expr "initializations")) "for loop initialization") - #t #t + #t #f (comma-sep stmt-expr "for loop increments") #t (block #t)) (while-l (block #t)) (do-while (block #t)) @@ -966,12 +960,12 @@ (choose ((return-s #t) (if-s #t (eta statement)) (variable-declaration (array-type (value+name-type prim-type)) - (choose (expression array-init) "variable initialization") #t "local variable") + (choose (expression array-init) "variable initialization") #t #t "local variable") (block #t) (sequence (stmt-expr SEMI_COLON) id) - (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t "for loop variable") + (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t #f "for loop variable") (comma-sep stmt-expr "initializations")) "for loop initialization") - #t #t + #t #f (comma-sep stmt-expr "for loop increments") #t (block #t)) (while-l (block #t)) (do-while (block #t)) @@ -994,7 +988,7 @@ (args (array-type (value+name-type prim-type))) #f IDENTIFIER)) (define method - (choose ((make-method method-sig-no-abs statement) + (choose ((make-method method-sig-no-abs (repeat-greedy statement)) (method-header method-sig-abs)) "method definition")) (define constructor