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)) (map (lambda (rst) (next-res old-answer new-id old-used tok rst))
(flatten (correct-list rsts)))] (flatten (correct-list rsts)))]
[(choice-res? 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 (map (lambda (rst) (next-res old-answer new-id old-used tok
(update-possible-fail rst rsts))) (update-possible-fail rst rsts)))
(flatten (correct-list (choice-res-matches rsts))))] (flatten (correct-list (choice-res-matches rsts))))]
@ -388,6 +389,19 @@
(rank-choice (map fail-type-may-use fails)) (rank-choice (map fail-type-may-use fails))
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 ;update-possible-rail result result -> result
(define (update-possible-fail res back) (define (update-possible-fail res back)
#;(printf "update-possible-fail ~a, ~a~n" 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) (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))] (choice-res-errors back) (res-first-tok res))]
[else 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])) [else res]))
;build-sequence-error: result boolean result string int [U #f string] [listof string] int int -> result ;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) #;(printf "finished on pairs of res for ~a~n" name #;old-res)
(map (lambda (r) (repeat->res r look-back)) (flatten old-res))] (map (lambda (r) (repeat->res r look-back)) (flatten old-res))]
[else [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))) #;(printf "length seen ~a length rest ~a~n" (length seen) (length (res-rest old-res)))
(fail-res (res-rest old-res) (fail-res (res-rest old-res)
(let*-values ([(fail) (res-msg old-res)] (let*-values ([(fail) (res-msg old-res)]
@ -467,17 +490,17 @@
(cond (cond
[(and (repeat-res? look-back) [(and (repeat-res? look-back)
(fail-type? (repeat-res-stop 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))) (fail-type-chance fail)))
(repeat-res-stop look-back)] (repeat-res-stop look-back)]
[(and (choice-res? look-back) [(and (choice-res? look-back)
(choice-res-errors 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))) (fail-type-chance fail)))
(choice-res-errors look-back)] (choice-res-errors look-back)]
[(and (res? look-back) [(and (res? look-back)
(fail-type? (res-possible-error 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))) (fail-type-chance fail)))
(res-possible-error look-back)] (res-possible-error look-back)]
[else #f])] [else #f])]
@ -727,7 +750,7 @@
[(eq? input return-name) name] [(eq? input return-name) name]
[else [else
#;(printf "choice ~a~n" name) #;(printf "choice ~a~n" name)
#;(printf "possible options are ~a~n" choice-names) #;(printf "possible options are ~a~n" (choice-names))
(let*-values (let*-values
([(options) (map (lambda (term) (term input last-src sub-opts)) opt-list)] ([(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)] #;[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) (define-struct fail-type (chance src name used may-use) #:transparent #:mutable)
;(make-terminal-fail float fail-src string symbol 'a) ;(make-terminal-fail float fail-src string symbol 'a)
(define-struct (terminal-fail fail-type) (kind found)) (define-struct (terminal-fail fail-type) (kind found))
;(make-sequence-fail float fail-src string symbol (list string) string 'a boolean string) ;(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)) (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) ;(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) (define-struct (choice-fail fail-type) (options names ended? (messages #:mutable)) #:transparent)
;(make-options-fail float #f #f (list fail-type)) ;(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)) ;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) (when (position-token? x)
(set! x (position-token-token x))) (set! x (position-token-token x)))
(case (token-name x) (case (token-name x)
[(PIPE) "|"] [(PIPE) "|"]
[(OR) "||"] [(OR) "||"]
[(OREQUAL) "|="] [(OREQUAL) "|="]
[(EQUAL) "="] [(EQUAL) "="]
[(GT) ">"] [(GT) ">"]
[(LT) "<"] [(LT) "<"]
[(LTEQ) "<="] [(LTEQ) "<="]
[(GTEQ) ">="] [(GTEQ) ">="]
[(PLUS) "+"] [(PLUS) "+"]
[(MINUS) "-"] [(MINUS) "-"]
[(TIMES) "*"] [(TIMES) "*"]
[(DIVIDE) "/"] [(DIVIDE) "/"]
[(^T) "^"] [(^T) "^"]
[(O_PAREN) "("] [(O_PAREN) "("]
[(C_PAREN) ")"] [(C_PAREN) ")"]
[(O_BRACE) "{"] [(O_BRACE) "{"]
[(C_BRACE) "}"] [(C_BRACE) "}"]
[(O_BRACKET) "["] [(O_BRACKET) "["]
[(C_BRACKET) "]"] [(C_BRACKET) "]"]
[(SEMI_COLON) ";"] [(SEMI_COLON) ";"]
[(PERIOD) "."] [(PERIOD) "."]
[(COMMA) ","] [(COMMA) ","]
[(NULL_LIT) "null"] [(NULL_LIT) "null"]
[(TRUE_LIT) "true"] [(TRUE_LIT) "true"]
[(FALSE_LIT) "false"] [(FALSE_LIT) "false"]
[(EOF) "end of input"] [(EOF) "end of input"]
[(caseT) "case"] [(caseT) "case"]
[(doT) "do"] [(doT) "do"]
[(elseT) "else"] [(elseT) "else"]
[(ifT) "if"] [(ifT) "if"]
[(voidT) "void"] [(voidT) "void"]
[(STRING_LIT) (format "\"~a\"" (token-value x))] [(STRING_LIT) (format "\"~a\"" (token-value x))]
[(CHAR_LIT) (format "'~a'" (token-value x))] [(CHAR_LIT) (format "'~a'" (token-value x))]
[(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT [(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT) (token-value x)]
HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)]
[(IDENTIFIER) (format "identifier ~a" (token-value x))] [(HEX_LIT HEXL_LIT) (format "hex formatted number ~a" (token-value x))]
[(STRING_ERROR) (format "misformatted string ~a" (token-value x))] [(OCT_LIT OCTL_LIT) (format "octal formatted number ~a" (token-value x))]
[else (token-name 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) (define (java-keyword? t)
(memq t `(? this super new instanceof while try throw synchronized switch return ifT goto for finally (memq t `(? this super new instanceof while try throw synchronized switch return ifT goto for finally
@ -99,7 +101,7 @@
(implements (implements
"mplements" "iplements" "impements" "implments" "impleents" "implemnts" "implemets" "implemens" "mplements" "iplements" "impements" "implments" "impleents" "implemnts" "implemets" "implemens"
"implement") "implement")
(void "oid" "vid" "voi" "viod") (void "oid" "vid" "voi" "viod" "vod")
(for "fo" "fore" "fro") (for "fo" "fore" "fro")
(super "uper" "sper" "supr" "supe" "supper") (super "uper" "sper" "supr" "supe" "supper")
(public "ublic" "pblic" "pulic" "pubic" "publc" "publi" "pubilc") (public "ublic" "pblic" "pulic" "pubic" "publc" "publi" "pubilc")
@ -372,7 +374,11 @@
"method invocation")) "method invocation"))
(define method-call-end (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 C_PAREN) id)
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep (eta expression) "arguments") C_PAREN) id)) (sequence (PERIOD (^ identifier) O_PAREN (comma-sep (eta expression) "arguments") C_PAREN) id))
"method invocation")) "method invocation"))
@ -652,7 +658,7 @@
"expression")) "expression"))
(define expression (define expression
(sequence (unique-base (repeat-greedy unique-end)) id "expression")) (sequence (unique-base (repeat unique-end)) id "expression"))
(define statement (define statement
(choose ((return-s #f) (if-s (block #f) #f)) "statement")) (choose ((return-s #f) (if-s (block #f) #f)) "statement"))