Corrections to the combinator parsers

svn: r6801
This commit is contained in:
Kathy Gray 2007-07-02 22:26:01 +00:00
parent 9119ec8d10
commit 3a65433b20
4 changed files with 213 additions and 125 deletions

View File

@ -107,7 +107,7 @@
[my-error (sequence-error-gen name sequence-length)]
[my-walker (seq-walker id-position name my-error)])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
#;(printf "seq ~a~n" name)
#;(!!! (printf "seq ~a~n" name))
(cond
[(eq? input return-name) name]
[(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
@ -121,7 +121,7 @@
[(pair? pre-build-ans) (map builder pre-build-ans)]
[else pre-build-ans])])
(hash-table-put! memo-table input ans)
#;(printf "sequence ~a returning ~n" name)
#;(!!! (printf "sequence ~a returning ~n" name))
ans)])))))
;seq-walker: int string error-gen -> [(list parser) (list alpha) parser result (U bool string) (list string) int int -> result
@ -171,21 +171,22 @@
(previous? input) (previous? return-name) #f
look-back used curr-id seen alts last-src)]
[else
#;(printf "seq-walker called: else case, ~a case of ~a~n"
seq-name (curr-pred return-name))
(let ([fst (curr-pred input last-src)])
#;(printf "seq-walker predicate returned~n")
(cond
#;(printf "seq-walker called: else case, ~a case of ~a ~ath case ~n"
seq-name (curr-pred return-name) (length seen))
(let ([fst (curr-pred input last-src)])
#;(printf "seq-walker predicate returned~n")
(cond
[(res? fst)
(cond
[(res-a fst) (next-call fst fst (res-msg fst) (and id-spot? (res-id fst))
(res-first-tok fst) alts)]
[else
#;(printf "error situation~n")
(build-error fst (previous? input) (previous? return-name)
(car next-preds) look-back used curr-id
seen alts last-src)])]
[(repeat-res? fst)
#;(printf "repeat-res: ~a~n" fst)
#;(printf "repeat-res: ~a~n" fst)
(next-call (repeat-res-a fst) fst
(res-msg (repeat-res-a fst)) #f
(res-first-tok (repeat-res-a fst)) alts)]
@ -402,7 +403,7 @@
this-res))]
[else (error 'here5)]))]))])
(hash-table-put! memo-table input ans)
#;(printf "repeat of ~a ended with ans ~a~n" repeat-name ans)
#;(!!! (printf "repeat of ~a ended with ans ~a~n" repeat-name ans))
ans)]))))
;choice: [list [[list 'a ] -> result]] name -> result
@ -411,7 +412,7 @@
[num-choices (length opt-list)]
[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 "choice ~a~n" name))
(let ([sub-opts (sub1 (+ alts num-choices))])
(cond
[(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
@ -431,7 +432,7 @@
num-choices choice-names 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)
#;(!!! (printf "choice ~a is returning ~a options were ~a ~n" name ans choice-names))
(hash-table-put! memo-table input ans) ans)])))))
;correct-list: (list result) -> (list result)

View File

@ -126,7 +126,8 @@
[pos 0]
[id-pos 0]
[terms null])
(syntax-case term (sequence choose ^)
(syntax-case* term (sequence choose ^)
(lambda (a b) (eq? (syntax-e a) (syntax-e b)))
[((sequence a b) . rest)
(loop (syntax rest) (add1 pos) id-pos
(cons (quasisyntax (sequence a b #,name)) terms))]

View File

@ -8,7 +8,7 @@
(lib "string.ss"))
(define-signature language-forms^ (program statement expression field))
(define-signature language-forms^ (program statement expression field)) ;value-type method-type))
(define-signature token-proc^ (old-tokens->new))
@ -336,74 +336,74 @@
(choose (NULL_LIT boolean-lits textual-lits prim-numeric-lits double-lits numeric-lits)
"literal expression"))
(define (new-class expr)
(choose ((sequence (new name O_PAREN C_PAREN) id "class instantiation")
(sequence (new name O_PAREN (comma-sep expression "arguments") C_PAREN) id "class instantiation"))
(define new-class
(choose ((sequence (new name O_PAREN C_PAREN) id)
(sequence (new name O_PAREN (comma-sep expression "arguments") C_PAREN) id))
"class instantiation"))
(define (new-array type-name expr)
(sequence (new type-name O_BRACKET expr C_BRACKET (repeat (sequence (O_BRACKET expr C_BRACKET) id)))
(define (new-array type-name)
(sequence (new type-name O_BRACKET expression C_BRACKET (repeat (sequence (O_BRACKET expression C_BRACKET) id)))
id "array instantiation"))
(define field-access-end
(sequence (PERIOD identifier) id "field access"))
(define (array-access-end expr)
(sequence (O_BRACKET expr C_BRACKET) id "array access"))
(define array-access-end
(sequence (O_BRACKET (eta expression) C_BRACKET) id "array access"))
(define (array-init-maker contents)
(sequence (O_BRACE (comma-sep contents "array elements") C_BRACE) id "array initializations"))
(define (array-init type-name expr)
(letrec ([base-init (array-init-maker expr)]
[simple-init (array-init-maker (choose (expr base-init (eta init)) "array initializations"))]
[init (array-init-maker (choose (expr simple-init) "array initializations"))])
(define (array-init type-name)
(letrec ([base-init (array-init-maker expression)]
[simple-init (array-init-maker (choose (expression base-init (eta init)) "array initializations"))]
[init (array-init-maker (choose (expression simple-init) "array initializations"))])
(sequence (new type-name init) "array initialization")))
(define (binary-expression-end op expr)
(sequence ((^ op) expr) id "binary expression"))
(define (binary-expression-end op)
(sequence ((^ op) expression) id "binary expression"))
(define (if-expr-end expr)
(sequence (? expr : expr) id "conditional expression"))
(define if-expr-end
(sequence (? (eta expression) : (eta expression)) id "conditional expression"))
(define (simple-method-call expr)
(define simple-method-call
(choose
((sequence ((^ identifier) O_PAREN C_PAREN) id "method invocation")
(sequence ((^ identifier) O_PAREN (comma-sep expr "argument list") C_PAREN) id "method invocation"))
((sequence ((^ identifier) O_PAREN C_PAREN) id)
(sequence ((^ identifier) O_PAREN (comma-sep expression "argument list") C_PAREN) id))
"method invocation"))
(define (method-call-end expr)
(define method-call-end
(choose
((sequence (PERIOD (^ identifier) O_PAREN C_PAREN) id "method invocation")
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep expr "argument list") C_PAREN) id "method invocation"))
((sequence (PERIOD (^ identifier) O_PAREN C_PAREN) id)
(sequence (PERIOD (^ identifier) O_PAREN (comma-sep expression "argument list") C_PAREN) id))
"method invocation"))
(define (assignment asignee op expr)
(sequence ((^ asignee) op expr) id "assignment"))
(define (assignment asignee op)
(sequence ((^ asignee) op expression) id "assignment"))
(define (unary-assignment-front expr)
(choose ((sequence (++ expr) id "unary modification")
(sequence (-- expr) id "unary modification")) "unary modification"))
(define unary-assignment-front
(choose ((sequence (++ expression) id)
(sequence (-- expression) id)) "unary modification"))
(define (unary-assignment-back base)
(choose ((sequence (base ++) id "unary modification")
(sequence (base --) id "unary modification")) "unary modification"))
(choose ((sequence (base ++) id)
(sequence (base --) id)) "unary modification"))
(define (cast type expr)
(sequence (O_PAREN type C_PAREN expr) "cast expression"))
(define (cast type)
(sequence (O_PAREN type C_PAREN expression) "cast expression"))
(define instanceof-back
(sequence (instanceof name) "instanceof expression"))
(define (super-call expr)
(choose ((sequence (super PERIOD identifier O_PAREN C_PAREN) id "super method invocation")
(sequence (super PERIOD identifier O_PAREN (comma-sep expr "arguments") C_PAREN) id "super method invocation"))
(define super-call
(choose ((sequence (super PERIOD identifier O_PAREN C_PAREN) id)
(sequence (super PERIOD identifier O_PAREN (comma-sep expression "arguments") C_PAREN) id))
"super method invocation"))
(define (checks expr)
(define checks
(choose
((sequence (check expr expect expr) id "check expression")
(sequence (check expr expect expr within expr) id "check expression"))
((sequence (check (eta expression) expect (eta expression)) id)
(sequence (check (eta expression) expect (eta expression) within (eta expression)) id))
"check expression"))
)
@ -422,8 +422,8 @@
(define (return-s expr opt?)
(cond
[opt? (choose ((sequence (return expr SEMI_COLON) id "return statement")
(sequence (return SEMI_COLON) id "return statement")) "return statement")]
[opt? (choose ((sequence (return expr SEMI_COLON) id)
(sequence (return SEMI_COLON) id)) "return statement")]
[else (sequence (return expr SEMI_COLON) id "return statement")]))
(define (this-call expr)
@ -634,23 +634,22 @@
(export language-forms^)
(define unique-base
(simple-expression
(list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
this
identifier
(new-class (eta expression))
(simple-method-call (eta expression))
(sequence (O_PAREN (eta expression) C_PAREN) id "expression")
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
(checks (eta expression)))))
(choose
((literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
this
identifier
new-class
simple-method-call
(sequence (O_PAREN (eta expression) C_PAREN) id)
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
checks) "expression"))
(define unique-end
(simple-expression
(list field-access-end
(method-call-end (eta expression))
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))
(eta expression)))))
(choose (field-access-end
method-call-end
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))))
"expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
@ -679,51 +678,46 @@
(make-program #f (repeat import-dec) (repeat (top-member (list class interface)))))
)
(define-signature int+acc^ (intermediate+access-prog))
(define-unit intermediate-grammar@
(import combinator-parser^ java-operators^ java-separators^ (prefix tok: java-definition-keywords^)
java-statement-keywords^ java-type-keywords^ java-ids^
java-types^ java-access^ java-ops^ general-productions^ java-variables^
expression-maker^ expr-lits^ expr-terms+^ expr-tails^ statements^
fields^ methods^ ctors^ interfaces^ classes^ top-forms^ id^)
(export language-forms^ int+acc^)
(export language-forms^)
(define unique-base
(simple-expression
(list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this
identifier
(new-class (eta expression))
(simple-method-call (eta expression))
(sequence (O_PAREN (eta expression) C_PAREN) id "expression")
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
(cast (value+name-type prim-type) (eta expression))
(super-call (eta expression))
(checks (eta expression)))))
(choose ((literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this
identifier
new-class
simple-method-call
(sequence (O_PAREN (eta expression) C_PAREN) id)
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
(cast (value+name-type prim-type))
super-call
checks) "expression"))
(define unique-end
(simple-expression
(list field-access-end
(method-call-end (eta expression))
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops))
(eta expression))
instanceof-back)))
(choose (field-access-end
method-call-end
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops)))
instanceof-back) "expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(define stmt-expr
(simple-expression (list (new-class expression)
(super-call expression)
(sequence (expression (method-call-end expression))
id "method call")
(assignment
(choose (identifier
(sequence (unique-base field-access-end) id))
"assignee")
EQUAL expression))))
(choose (new-class
super-call
(sequence (expression (method-call-end expression))
id "method call")
(assignment
(choose (identifier
(sequence (unique-base field-access-end) id))
"assignee")
EQUAL)) "expression"))
(define statement
(make-statement
@ -734,39 +728,22 @@
(sequence (stmt-expr SEMI_COLON) id "statement"))))
(define field (make-field #f (value+name-type prim-type) expression #t))
(define intermediate+access-field (make-field access-mods (value+name-type prim-type) expression #t))
(define method-sig-no-abs
(method-signature #f (method-type (value+name-type prim-type)) args #f identifier))
(define method-sig-abs
(method-signature tok:abstract (method-type (value+name-type prim-type)) args #f identifier))
(define intermediate+access-method-sig-no-abs
(method-signature access-mods (method-type (value+name-type prim-type)) args #f identifier))
(define intermediate+access-method-sig-abs
(method-signature (method-mods access-mods)
(method-type (value+name-type prim-type)) args #f identifier))
(define method
(choose ((make-method method-sig-no-abs statement)
(method-header method-sig-abs)) "method definition"))
(define intermediate+access-method
(choose ((make-method intermediate+access-method-sig-no-abs statement)
(method-header intermediate+access-method-sig-abs)) "method definition"))
(define constructor
(make-constructor #f
(choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call expression) (repeat statement)) id)
(repeat statement)) "constructor body")))
(define intermediate+access-constructor
(make-constructor access-mods
(choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call expression) (repeat statement)) id)
(repeat statement)) "constructor body")))
(define interface
(interface-def
#f
@ -778,21 +755,95 @@
(implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list field method constructor)))))
(define intermediate+access-class
(class-def tok:abstract (extend-dec identifier) (implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list intermediate+access-field
intermediate+access-method
intermediate+access-constructor)))))
(define program
(make-program #f (repeat import-dec) (repeat (top-member (list class interface)))))
(define intermediate+access-prog
(make-program #f (repeat import-dec)
(repeat (top-member (list intermediate+access-class interface)))))
)
(define-unit intermediate+access-grammar@
(import combinator-parser^ java-operators^ java-separators^ (prefix tok: java-definition-keywords^)
java-statement-keywords^ java-type-keywords^ java-ids^
java-types^ java-access^ java-ops^ general-productions^ java-variables^
expression-maker^ expr-lits^ expr-terms+^ expr-tails^ statements^
fields^ methods^ ctors^ interfaces^ classes^ top-forms^ id^)
(export language-forms^)
(define unique-base
(choose ((literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this
identifier
new-class
simple-method-call
(sequence (O_PAREN (eta expression) C_PAREN) id)
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
(cast (value+name-type prim-type))
super-call
checks) "expression"))
(define unique-end
(choose (field-access-end
method-call-end
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops)))
instanceof-back) "expression"))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(define stmt-expr
(choose (new-class
super-call
(sequence (expression (method-call-end expression))
id "method call")
(assignment
(choose (identifier
(sequence (unique-base field-access-end) id))
"assignee")
EQUAL)) "expression"))
(define statement
(make-statement
(list (if-s expression (eta statement) #f)
(return-s expression #t)
(variable-declaration (value+name-type prim-type) expression #f "local variable")
(block (repeat (eta statement)))
(sequence (stmt-expr SEMI_COLON) id "statement"))))
(define field (make-field access-mods (value+name-type prim-type) expression #t))
(define method-sig-no-abs
(method-signature access-mods (method-type (value+name-type prim-type)) args #f identifier))
(define method-sig-abs
(method-signature (method-mods access-mods)
(method-type (value+name-type prim-type)) args #f identifier))
(define method
(choose ((make-method method-sig-no-abs statement)
(method-header method-sig-abs)) "method definition"))
(define constructor
(make-constructor access-mods
(choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call expression) (repeat statement)) id)
(repeat 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"))))
(define class
(class-def tok:abstract (extend-dec identifier) (implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec)
(repeat (top-member (list class interface)))))
)
(define-unit advanced-grammar@
(import combinator-parser^ java-operators^ java-separators^ (prefix tok: java-definition-keywords^)
java-statement-keywords^ java-type-keywords^ java-ids^
@ -807,7 +858,7 @@
(list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this
IDENTIFIER
(new-class (eta expression))
new-class
(simple-method-call (eta expression))
(new-array (value+name-type prim-type) (eta expression))
(sequence (O_PAREN (eta expression) C_PAREN) id "expression")
@ -831,7 +882,7 @@
(sequence (unique-base (repeat unique-end)) id "expression"))
(define stmt-expr
(simple-expression (list (new-class expression)
(simple-expression (list new-class
(super-call expression)
(sequence (expression
(method-call-end expression)) id "method call")
@ -1056,6 +1107,31 @@
java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@
intermediate-grammar@ token@ interactions-parsers@))
(define-compound-unit/infer intermediate+access-file-parser@
(import)
(export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ file-constants@ id@
java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@
intermediate+access-grammar@ token@ definition-parsers@))
(define-compound-unit/infer intermediate+access-definitions-parser@
(import)
(export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ de-constants@ id@
java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@
intermediate+access-grammar@ token@ definition-parsers@))
(define-compound-unit/infer intermediate+access-interactions-parsers@
(import)
(export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ interact-constants@ id@
java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@
intermediate+access-grammar@ token@ interactions-parsers@))
(define-compound-unit/infer advanced-file-parser@
(import)
@ -1084,6 +1160,7 @@
;
(provide advanced-file-parser@ advanced-definitions-parser@ advanced-interactions-parsers@
intermediate+access-file-parser@ intermediate+access-definitions-parser@ intermediate+access-interactions-parsers@
intermediate-file-parser@ intermediate-definitions-parser@ intermediate-interactions-parsers@
beginner-file-parser@ beginner-definitions-parser@ beginner-interactions-parsers@
parsers^ token-proc^)

View File

@ -344,6 +344,14 @@
(define-values/invoke-unit intermediate-interactions-parsers@
(import)
(export (prefix intermediate-int: parsers^) (prefix intermediate-int: err^)))
(define-values/invoke-unit intermediate+access-definitions-parser@
(import)
(export (prefix intermediate+acc-def: parsers^) (prefix intermediate+acc-def: err^)))
(define-values/invoke-unit intermediate+access-interactions-parsers@
(import)
(export (prefix intermediate+acc-int: parsers^) (prefix intermediate+acc-int: err^)))
(define-values/invoke-unit advanced-definitions-parser@
(import)
@ -367,7 +375,8 @@
beginner-def:err? beginner-def:err-msg beginner-def:err-src))
(define parse-intermediate (parse intermediate-def:parse-program
intermediate-def:err? intermediate-def:err-msg intermediate-def:err-src))
(define parse-intermediate+access null #;(parse def:parse-intermediate+access def:err? def:err-msg def:err-src))
(define parse-intermediate+access (parse intermediate+acc-def:parse-program
intermediate+acc-def:err? intermediate+acc-def:err-msg intermediate+acc-def:err-src))
(define parse-advanced (parse advanced-def:parse-program
advanced-def:err? advanced-def:err-msg advanced-def:err-src))
(define parse-beginner-interact (parse beginner-int:parse-program