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

Additions to error messages and flexibility of combinator parser

Browse Source 
svn: r6953
This commit is contained in:
Kathy Gray 2007-07-24 22:59:46 +00:00
parent b8f38ee186
commit d9664a6e9b
6 changed files with 85 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12,7 +12,8 @@
(export parser^)
(define (sort-used reses)
(sort reses (lambda (a b) (> (res-used a) (res-used b)))))
(sort reses
(lambda (a b) (!!! (> (res-used a) (res-used b))))))
(define (parser start)
(lambda (input file)
@ -29,7 +30,8 @@
(!!! (res-msg result))
(input->output-name (!!! (car (res-rest result)))) input-type)
(and src?
(make-src-lst (position-token-start-pos (!!! (car (res-rest result)))))))]
(make-src-lst (position-token-start-pos (!!! (car (res-rest result))))
(position-token-end-pos (!!! (car (res-rest result)))))))]
[(res? result)
(fail-type->message (res-msg (!!! result)))]
[(or (choice-res? result) (pair? result))
@ -50,12 +52,15 @@
(res-possible-error (!!! (car (sort-used possible-errors))))))]
[else
(let ([used-sort (sort-used options)])
#;(!!! (printf "~a~n" used-sort))
(make-err
(format "Found additional content after ~a, begining with ~a."
(format "Found additional content after ~a, begining with '~a'."
(!!! (res-msg (car used-sort)))
(input->output-name (!!! (car (res-rest (car used-sort))))))
(and src?
(make-src-lst (position-token-start-pos
(!!! (car (res-rest (car used-sort)))))
(position-token-end-pos
(!!! (car (res-rest (car used-sort)))))))))]))]
[(and (repeat-res? result) (eq? 'out-of-input (repeat-res-stop (!!! result))))
(res-a (repeat-res-a result))]

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

@ -177,7 +177,10 @@
[(pair? rsts)
(map (lambda (rst) (next-res old-answer new-id old-used tok rst))
(correct-list rsts))]
[else (error 'here2)])))])
[(choice-res? rsts)
(map (lambda (rst) (next-res old-answer new-id old-used tok rst))
(correct-list (choice-res-matches rsts)))]
[else (printf "~a~n" rsts) (error 'here2)])))])
(cond
[(null? next-preds)
(build-error (curr-pred input last-src)
@ -359,8 +362,8 @@
revised-expectation probability-with-sub probability-without-sub expected-sub expected-no-sub)
probability))
;repeat: (list 'a) -> result -> (list 'a) -> result
(define (repeat sub)
;greedy-repeat: (list 'a) -> result -> (list 'a) -> result
(define (repeat-greedy sub)
(letrec ([repeat-name (string-append "any number of " (sub return-name))]
[memo-table (make-hash-table 'weak)]
[process-rest
@ -432,6 +435,7 @@
[choice-names (map (lambda (o) (o return-name)) opt-list)])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
#;(!!! (printf "choice ~a~n" name))
#;(!!! (printf "possible options are ~a~n" choice-names))
(let ([sub-opts (sub1 (+ alts num-choices))])
(cond
[(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
@ -456,7 +460,9 @@
name
(rank-choice (map fail-type-used fails))
(rank-choice (map fail-type-may-use fails))
num-choices choice-names fails))]
num-choices choice-names
(null? input)
fails))]
[(null? (cdr corrects)) (car corrects)]
[else (make-choice-res name corrects)])])
#;(!!! (printf "choice ~a is returning ~a options were ~a ~n" name ans choice-names))
@ -491,5 +497,15 @@
(list (first src) (second src) (third src)
(- (position-offset new-end) (third src))))
(define (repeat op)
(letrec ([name (string-append "any number of "(op return-name))]
[r* (choice (list op
(seq (list op r*)
(lambda (list-args) (cons (car list-args) (cadr list-args)))
name)
(seq null (lambda (x) null) return-name))
name)])
r*))
)
)

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

@ -133,6 +133,12 @@
[top-name (car top-names)]
[no-dup-names (remove-dups (choice-fail-names fail-type) name)])
(cond
[(and (choice-fail-ended? fail-type)
(> (length winners) 1))
(combine-message
(msg (format "Expected a ~a, possible forms are ~a.")
(nice-list (first-n max-choice-depth no-dup-names)))
message-to-date)]
[(and (<= (choice-fail-options fail-type) max-choice-depth)
(> (length no-dup-names) 1)
(> (length winners) 1)

2
collects/combinator-parser/private-combinator/parser-sigs.ss
View File

@ -23,7 +23,7 @@
(define-signature language-dictionary^ (misspelled misscap missclass))
(define-signature combinator-parser-forms^
(terminal choice seq repeat
(terminal choice seq repeat repeat-greedy
(define-syntaxes (define-simple-terminals)
(values
(lambda (stx)

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

@ -21,8 +21,8 @@
(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-choice-fail float fail-src string int (list string) (list fail-type))
(define-struct (choice-fail fail-type) (options names messages) (make-inspector))
;(make-choice-fail float fail-src string int (list string) (list fail-type) boolean)
(define-struct (choice-fail fail-type) (options names messages ended?) (make-inspector))
;(make-options-fail float #f #f (list fail-type))
(define-struct (options-fail fail-type) (opts))
@ -53,7 +53,8 @@
(make-choice-fail chance src name used may-use
(!!! (choice-fail-options fail))
(!!! (choice-fail-names fail))
(map !!!-fail (!!! (choice-fail-messages fail))))]
(map !!!-fail (!!! (choice-fail-messages fail)))
(!!! (choice-fail-ended? fail)))]
[(options-fail? fail)
(make-options-fail chance src name used may-use
(map !!!-fail (!!! (options-fail-opts fail))))]

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

@ -206,7 +206,8 @@
(choice (list base-t voidT) "method return"))
(define (array-type base-t)
(choice (base-t (sequence (base-t O_BRACKET C_BRACKET (repeat (sequence (O_BRACKET C_BRACKET) id))) id
(choice (base-t (sequence (base-t O_BRACKET C_BRACKET
(repeat (sequence (O_BRACKET C_BRACKET) id))) id
"array type")) "type"))
)
@ -264,7 +265,7 @@
(export general-productions^)
(define (comma-sep term name)
(sequence (term (repeat (sequence (COMMA term) id))) id (string-append "list of " 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"))]
@ -370,13 +371,13 @@
(define simple-method-call
(choose
((sequence ((^ identifier) O_PAREN C_PAREN) id)
(sequence ((^ identifier) O_PAREN (comma-sep expression "argument list") C_PAREN) id))
(sequence ((^ identifier) O_PAREN (comma-sep expression "arguments") C_PAREN) id))
"method invocation"))
(define method-call-end
(choose
((sequence (PERIOD (^ identifier) O_PAREN C_PAREN) id)
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep expression "argument list") C_PAREN) id))
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep expression "arguments") C_PAREN) id))
"method invocation"))
(define (assignment asignee op)
@ -441,7 +442,7 @@
(sequence (super O_PAREN (comma-sep expression "arguments") C_PAREN SEMI_COLON) id)) "super constructor call"))
(define (block repeat?)
(sequence (O_BRACE (if repeat? (repeat (eta statement)) (eta statement)) C_BRACE)
(sequence (O_BRACE (if repeat? (repeat-greedy (eta statement)) (eta statement)) C_BRACE)
id "block statement"))
(define expression-stmt
@ -503,13 +504,13 @@
(define (make-field mods type expr share-types?)
(cond
[mods (sequence ((repeat mods) (variable-declaration type expr share-types? "field"))
[mods (sequence ((repeat-greedy mods) (variable-declaration type expr share-types? "field"))
id "field definition")]
[else (variable-declaration type expr share-types? "field")]))
(define arg (sequence ((value+name-type prim-type) identifier) id "argument"))
(define args (comma-sep arg "parameter list"))
(define args (comma-sep arg "parameters"))
;method-signature: {U parser #f} [U parser #f] [U parser #f] bool bool parser -> parser
(define (method-signature m ret a t? n)
@ -517,9 +518,9 @@
(choose ((sequence (O_PAREN C_PAREN) id)
(sequence (O_PAREN a C_PAREN) id)) "method parameter list")
(sequence (O_PAREN C_PAREN) id "method parameter list"))]
[full (sequence ((repeat m) ret (^ identifier) method-parms throws (comma-sep n "thrown type")) id "method signature")]
[full (sequence ((repeat m) ret (^ identifier) method-parms throws (comma-sep n "thrown types")) id "method signature")]
[full-no-t (sequence ((repeat m) ret (^ identifier) method-parms) id "method signature")]
[no-mods-t (sequence (ret (^ identifier) method-parms throws (comma-sep n "thrown type")) id "method signature")]
[no-mods-t (sequence (ret (^ identifier) method-parms throws (comma-sep n "thrown types")) id "method signature")]
[no-mods (sequence (ret (^ identifier) method-parms) id "method signature")])
(cond
[(and m t?) (choose (full full-no-t) "method signature")]
@ -549,7 +550,7 @@
(export interfaces^)
(define (interface-body members)
(repeat (choice members "interface member")))
(repeat-greedy (choice members "interface member")))
(define (interface-def modifier extends body)
(let ([m&e (sequence ((repeat modifier) interface (^ IDENTIFIER) extends O_BRACE body C_BRACE)
@ -658,7 +659,7 @@
"expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(sequence (unique-base (repeat-greedy unique-end)) id "expression"))
(define statement
(choose ((if-s (block #f) #f) (return-s #f)) "statement"))
@ -670,17 +671,18 @@
(define method (make-method method-sig statement))
(define constructor (make-constructor #f (repeat init)))
(define constructor (make-constructor #f (repeat-greedy init)))
(define interface (interface-def #f #f
(repeat (sequence (method-sig SEMI_COLON) id "method signature"))))
(repeat-greedy
(sequence (method-sig SEMI_COLON) id "method signature"))))
(define class
(class-def #f #f (implements-dec identifier)
(repeat (class-body (list field method constructor)))))
(repeat-greedy (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec) (repeat (top-member (list class interface)))))
(make-program #f (repeat import-dec) (repeat-greedy (top-member (list class interface)))))
)
(define-unit intermediate-grammar@
@ -711,15 +713,15 @@
instanceof-back) "expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(sequence (unique-base (repeat-greedy unique-end)) id "expression"))
(define stmt-expr
(choose (#;new-class
#;super-call
#;(sequence (unique-base method-call-end) id "method call")
super-call
(sequence (unique-base (repeat unique-end) method-call-end) id "method call")
(assignment
(choose (identifier
(sequence (unique-base field-access-end) id))
(sequence (unique-base (repeat unique-end) field-access-end) id))
"assignee")
EQUAL)) "expression"))
@ -743,23 +745,23 @@
(define constructor
(make-constructor #f
(choose ((sequence (super-ctor-call (repeat statement)) id)
(repeat statement)) "constructor body")))
(choose ((sequence (super-ctor-call (repeat-greedy statement)) id)
(repeat-greedy statement)) "constructor body")))
(define interface
(interface-def
#f
(sequence (tok:extends (comma-sep identifier "interfaces")) id "extends")
(repeat (sequence (method-sig-no-abs SEMI_COLON) id "method signature"))))
(repeat-greedy (sequence (method-sig-no-abs SEMI_COLON) id "method signature"))))
(define class
(class-def tok:abstract (extend-dec identifier)
(implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list field method constructor)))))
(repeat-greedy (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec) (repeat (top-member (list class interface)))))
(make-program #f (repeat import-dec) (repeat-greedy (top-member (list class interface)))))
)
@ -791,15 +793,15 @@
instanceof-back) "expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(sequence (unique-base (repeat-greedy unique-end)) id "expression"))
(define stmt-expr
(choose (new-class
(choose (#;new-class
super-call
(sequence (expression method-call-end) id "method call")
(sequence (unique-base (repeat unique-end) method-call-end) id "method call")
(assignment
(choose (identifier
(sequence (unique-base field-access-end) id))
(sequence (unique-base (repeat unique-end) field-access-end) id))
"assignee")
EQUAL)) "expression"))
@ -824,23 +826,23 @@
(define constructor
(make-constructor access-mods
(choose ((sequence (super-ctor-call (repeat statement)) id)
(sequence (this-call (repeat statement)) id)
(repeat statement)) "constructor body")))
(choose ((sequence (super-ctor-call (repeat-greedy statement)) id)
(sequence (this-call (repeat-greedy statement)) id)
(repeat-greedy statement)) "constructor body")))
(define interface
(interface-def
#f
(sequence (tok:extends (comma-sep identifier "interfaces")) id "extends")
(repeat (sequence (method-sig-no-abs SEMI_COLON) id "method signature"))))
(repeat-greedy (sequence (method-sig-no-abs SEMI_COLON) id "method signature"))))
(define class
(class-def tok:abstract (extend-dec identifier) (implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list field method constructor)))))
(repeat-greedy (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec)
(repeat (top-member (list class interface)))))
(repeat-greedy (top-member (list class interface)))))
)
@ -878,16 +880,16 @@
"expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(sequence (unique-base (repeat-greedy unique-end)) id "expression"))
(define stmt-expr
(choose (new-class
super-call
(sequence (expression method-call-end) id "method call")
(sequence (unique-base (repeat unique-end) method-call-end) id "method call")
(assignment
(choose (identifier
(sequence (expression field-access-end) id)
(sequence (expression array-access-end) id))
(sequence (unique-base (repeat unique-end) field-access-end) id)
(sequence (unique-base (repeat unique-end) array-access-end) id))
"asignee")
assignment-ops expression)
(sequence (expression ++) id "unary mutation")
@ -925,28 +927,28 @@
(define constructor
(make-constructor access-mods
(choose ((sequence (super-ctor-call (repeat statement)) id)
(sequence (this-call (repeat statement)) id)
(repeat statement)) "constructor body")))
(choose ((sequence (super-ctor-call (repeat-greedy statement)) id)
(sequence (this-call (repeat-greedy statement)) id)
(repeat-greedy statement)) "constructor body")))
(define interface
(interface-def
#f
(sequence (tok:extends (comma-sep IDENTIFIER "interfaces")) id "extends")
(repeat (choose (method-sig-no-abs
(repeat-greedy (choose (method-sig-no-abs
(make-field (global-mods access-mods) (value+name-type prim-type) expression #t))
"interface member definition"))))
(define class
(class-def (choose (tok:abstract tok:public) "class modifier")
(extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces"))
(repeat (class-body (list field method constructor
(repeat-greedy (class-body (list field method constructor
(method-header method-sig-abs))))))
(define program
(make-program (sequence (tok:package name SEMI_COLON) id "package specification")
(repeat import-dec)
(repeat (top-member (list class interface)))))
(repeat-greedy (top-member (list class interface)))))
)
(define-unit token@