From dccc1337a25fe463e47152c4b96ba6de03379e00 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Fri, 25 Jul 2008 13:59:19 +0000 Subject: [PATCH] Keeping more potential errors svn: r10912 --- .../private-combinator/combinator.scm | 33 +++++-- .../private-combinator/structs.scm | 6 +- collects/profj/comb-parsers/parser-units.scm | 88 ++++++++++--------- 3 files changed, 78 insertions(+), 49 deletions(-) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index 7f1fef505f..4f93ad3004 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -222,6 +222,7 @@ (map (lambda (rst) (next-res old-answer new-id old-used tok rst)) (flatten (correct-list rsts)))] [(choice-res? rsts) + #;(printf "next call, tail-end is choice ~a~n" rsts) (map (lambda (rst) (next-res old-answer new-id old-used tok (update-possible-fail rst rsts))) (flatten (correct-list (choice-res-matches rsts))))] @@ -388,6 +389,19 @@ (rank-choice (map fail-type-may-use fails)) fails)) + (define (add-to-choice-fails choice fail) + (let ([fails (choice-fail-messages choice)]) + (make-choice-fail + (rank-choice (cons (fail-type-chance fail) (map fail-type-chance fails))) + (fail-type-src choice) + (fail-type-name choice) + (rank-choice (cons (fail-type-used fail) (map fail-type-used fails))) + (rank-choice (cons (fail-type-may-use fail) (map fail-type-may-use fails))) + (choice-fail-options choice) + (choice-fail-names choice) + (choice-fail-ended? choice) + (cons fail fails)))) + ;update-possible-rail result result -> result (define (update-possible-fail res back) #;(printf "update-possible-fail ~a, ~a~n" res back) @@ -401,6 +415,15 @@ (make-res (res-a res) (res-rest res) (res-msg res) (res-id res) (res-used res) (choice-res-errors back) (res-first-tok res))] [else res])] + [(choice-res? res) + (cond + [(and (choice-res? back) (choice-res-errors back) (choice-res-errors res)) + (make-choice-res (choice-res-name res) + (choice-res-matches res) + (add-to-choice-fails (choice-res-errors res) + (choice-res-errors back)))] + + [else res])] [else res])) ;build-sequence-error: result boolean result string int [U #f string] [listof string] int int -> result @@ -459,7 +482,7 @@ #;(printf "finished on pairs of res for ~a~n" name #;old-res) (map (lambda (r) (repeat->res r look-back)) (flatten old-res))] [else - #;(printf "There actually was an error for ~a~n" name) + #;(printf "There was an error for ~a~n" name) #;(printf "length seen ~a length rest ~a~n" (length seen) (length (res-rest old-res))) (fail-res (res-rest old-res) (let*-values ([(fail) (res-msg old-res)] @@ -467,17 +490,17 @@ (cond [(and (repeat-res? look-back) (fail-type? (repeat-res-stop look-back)) - (> (fail-type-chance (repeat-res-stop look-back)) + (>= (fail-type-chance (repeat-res-stop look-back)) (fail-type-chance fail))) (repeat-res-stop look-back)] [(and (choice-res? look-back) (choice-res-errors look-back) - (> (fail-type-chance (choice-res-errors look-back)) + (>= (fail-type-chance (choice-res-errors look-back)) (fail-type-chance fail))) (choice-res-errors look-back)] [(and (res? look-back) (fail-type? (res-possible-error look-back)) - (> (fail-type-chance (res-possible-error look-back)) + (>= (fail-type-chance (res-possible-error look-back)) (fail-type-chance fail))) (res-possible-error look-back)] [else #f])] @@ -727,7 +750,7 @@ [(eq? input return-name) name] [else #;(printf "choice ~a~n" name) - #;(printf "possible options are ~a~n" choice-names) + #;(printf "possible options are ~a~n" (choice-names)) (let*-values ([(options) (map (lambda (term) (term input last-src sub-opts)) opt-list)] #;[a (printf "choice-options ~a ~n ~a ~n~n~n" choice-names options)] diff --git a/collects/combinator-parser/private-combinator/structs.scm b/collects/combinator-parser/private-combinator/structs.scm index c69894a66e..b1ad940e1a 100644 --- a/collects/combinator-parser/private-combinator/structs.scm +++ b/collects/combinator-parser/private-combinator/structs.scm @@ -18,12 +18,12 @@ (define-struct fail-type (chance src name used may-use) #:transparent #:mutable) ;(make-terminal-fail float fail-src string symbol 'a) (define-struct (terminal-fail fail-type) (kind found)) - ;(make-sequence-fail float fail-src string symbol (list string) string 'a boolean string) - (define-struct (sequence-fail fail-type) (id kind correct expected found repeat? last-seen)) + ;(make-sequence-fail float fail-src string symbol (list string) string 'a (-> boolean) string) + (define-struct (sequence-fail fail-type) (id kind correct expected found repeat? last-seen) #:transparent) ;(make-choice-fail float fail-src string int (list string) (list fail-type) boolean) (define-struct (choice-fail fail-type) (options names ended? (messages #:mutable)) #:transparent) ;(make-options-fail float #f #f (list fail-type)) - (define-struct (options-fail fail-type) ((opts #:mutable))) + (define-struct (options-fail fail-type) ((opts #:mutable)) #:transparent) ;result = res | choice-res | repeat-res | (listof (U res choice-res)) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index 7b2e06a2fb..d69e58183e 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -24,44 +24,46 @@ (when (position-token? x) (set! x (position-token-token x))) (case (token-name x) - [(PIPE) "|"] - [(OR) "||"] - [(OREQUAL) "|="] - [(EQUAL) "="] - [(GT) ">"] - [(LT) "<"] - [(LTEQ) "<="] - [(GTEQ) ">="] - [(PLUS) "+"] - [(MINUS) "-"] - [(TIMES) "*"] - [(DIVIDE) "/"] - [(^T) "^"] - [(O_PAREN) "("] - [(C_PAREN) ")"] - [(O_BRACE) "{"] - [(C_BRACE) "}"] - [(O_BRACKET) "["] - [(C_BRACKET) "]"] - [(SEMI_COLON) ";"] - [(PERIOD) "."] - [(COMMA) ","] - [(NULL_LIT) "null"] - [(TRUE_LIT) "true"] - [(FALSE_LIT) "false"] - [(EOF) "end of input"] - [(caseT) "case"] - [(doT) "do"] - [(elseT) "else"] - [(ifT) "if"] - [(voidT) "void"] - [(STRING_LIT) (format "\"~a\"" (token-value x))] - [(CHAR_LIT) (format "'~a'" (token-value x))] - [(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT - HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)] - [(IDENTIFIER) (format "identifier ~a" (token-value x))] - [(STRING_ERROR) (format "misformatted string ~a" (token-value x))] - [else (token-name x)])) + [(PIPE) "|"] + [(OR) "||"] + [(OREQUAL) "|="] + [(EQUAL) "="] + [(GT) ">"] + [(LT) "<"] + [(LTEQ) "<="] + [(GTEQ) ">="] + [(PLUS) "+"] + [(MINUS) "-"] + [(TIMES) "*"] + [(DIVIDE) "/"] + [(^T) "^"] + [(O_PAREN) "("] + [(C_PAREN) ")"] + [(O_BRACE) "{"] + [(C_BRACE) "}"] + [(O_BRACKET) "["] + [(C_BRACKET) "]"] + [(SEMI_COLON) ";"] + [(PERIOD) "."] + [(COMMA) ","] + [(NULL_LIT) "null"] + [(TRUE_LIT) "true"] + [(FALSE_LIT) "false"] + [(EOF) "end of input"] + [(caseT) "case"] + [(doT) "do"] + [(elseT) "else"] + [(ifT) "if"] + [(voidT) "void"] + [(STRING_LIT) (format "\"~a\"" (token-value x))] + [(CHAR_LIT) (format "'~a'" (token-value x))] + [(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT) (token-value x)] + + [(HEX_LIT HEXL_LIT) (format "hex formatted number ~a" (token-value x))] + [(OCT_LIT OCTL_LIT) (format "octal formatted number ~a" (token-value x))] + [(IDENTIFIER) (format "identifier ~a" (token-value x))] + [(STRING_ERROR) (format "misformatted string ~a" (token-value x))] + [else (token-name x)])) (define (java-keyword? t) (memq t `(? this super new instanceof while try throw synchronized switch return ifT goto for finally @@ -99,7 +101,7 @@ (implements "mplements" "iplements" "impements" "implments" "impleents" "implemnts" "implemets" "implemens" "implement") - (void "oid" "vid" "voi" "viod") + (void "oid" "vid" "voi" "viod" "vod") (for "fo" "fore" "fro") (super "uper" "sper" "supr" "supe" "supper") (public "ublic" "pblic" "pulic" "pubic" "publc" "publi" "pubilc") @@ -372,7 +374,11 @@ "method invocation")) (define method-call-end - (choose + (sequence (PERIOD (^ identifier) O_PAREN (choose (C_PAREN + (sequence ((comma-sep (eta expression) "arguments") C_PAREN) id)))) + id "method invocation") + + #;(choose ((sequence (PERIOD (^ identifier) O_PAREN C_PAREN) id) (sequence (PERIOD (^ identifier) O_PAREN (comma-sep (eta expression) "arguments") C_PAREN) id)) "method invocation")) @@ -652,7 +658,7 @@ "expression")) (define expression - (sequence (unique-base (repeat-greedy unique-end)) id "expression")) + (sequence (unique-base (repeat unique-end)) id "expression")) (define statement (choose ((return-s #f) (if-s (block #f) #f)) "statement"))