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

Keeping more potential errors

Browse Source 
svn: r10912
This commit is contained in:
Kathy Gray 2008-07-25 13:59:19 +00:00
parent e7184d8d29
commit dccc1337a2
3 changed files with 78 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/combinator-parser/private-combinator/combinator.scm
View File

@ -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)]

6
collects/combinator-parser/private-combinator/structs.scm
View File

@ -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))

88
collects/profj/comb-parsers/parser-units.scm
View File

@ -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"))