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

Corrected options selection bug

Browse Source 
svn: r6728
This commit is contained in:
Kathy Gray 2007-06-24 15:41:53 +00:00
parent 8f4b436101
commit 1069f4d774
6 changed files with 472 additions and 310 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -68,11 +68,13 @@
[(err? out) [(err? out)
;(printf "returning error") ;(printf "returning error")
(make-err (!!! (err-msg out)) (make-err (!!! (err-msg out))
(if (err-src out)
(list (!!! file) (list (!!! file)
(!!! (first (err-src out))) (!!! (first (err-src out)))
(!!! (second (err-src out))) (!!! (second (err-src out)))
(!!! (third (err-src out))) (!!! (third (err-src out)))
(!!! (fourth (err-src out)))))] (!!! (fourth (err-src out))))
(list (!!! file) 1 0 1 0)))]
[else (!!! out)])))) [else (!!! out)]))))
) )

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

@ -24,7 +24,7 @@
[name (fail-type-name fail-type)] [name (fail-type-name fail-type)]
[a (a/an name)] [a (a/an name)]
[msg (lambda (m) (make-err m (fail-type-src fail-type)))]) [msg (lambda (m) (make-err m (fail-type-src fail-type)))])
;(printf "fail-type->message ~a~n" fail-type) #;(printf "fail-type->message ~a~n" fail-type)
(cond (cond
[(terminal-fail? fail-type) [(terminal-fail? fail-type)
(combine-message (combine-message
@ -52,7 +52,8 @@
[(end) [(end)
(combine-message (combine-message
(msg (format "Expected ~a to contain ~a ~a to complete the ~a. ~nFound ~a before ~a ended." (msg (format "Expected ~a to contain ~a ~a to complete the ~a. ~nFound ~a before ~a ended."
input-type a2 expected id-name (format-seen show-sequence) input-type)) message-to-date)] input-type a2 expected id-name (format-seen show-sequence) input-type))
message-to-date)]
[(wrong) [(wrong)
(combine-message (combine-message
(msg (msg
@ -116,38 +117,44 @@
(format ", it is likely you intended ~a ~a here" (a/an top-name) top-name)))])) (format ", it is likely you intended ~a ~a here" (a/an top-name) top-name)))]))
name #f message-to-date)))] name #f message-to-date)))]
[(choice-fail? fail-type) [(choice-fail? fail-type)
#;(printf "selecting for ~a~n" name) #;(printf "selecting for ~a~n message-to-date ~a~n" name message-to-date)
(let* ([winners (select-errors (choice-fail-messages fail-type))] (let* ([winners (select-errors (choice-fail-messages fail-type))]
[top-names (map fail-type-name winners)] [top-names (map fail-type-name winners)]
[top-name (car top-names)] [top-name (car top-names)]
[no-dup-names (remove-dups (choice-fail-names fail-type) name)]) [no-dup-names (remove-dups (choice-fail-names fail-type) name)])
(fail-type->message (cond
(car winners)
(add-to-message
(msg (cond
[(and (<= (choice-fail-options fail-type) max-choice-depth) [(and (<= (choice-fail-options fail-type) max-choice-depth)
(> (length no-dup-names) 1) (> (length no-dup-names) 1)
(> (length winners) 1) (> (length winners) 1)
(equal? top-names no-dup-names)) (equal? top-names no-dup-names))
(format "An error occured in this ~a, one of ~a is expected here." (combine-message
name (nice-list no-dup-names))] (msg (format "An error occured in this ~a, one of ~a is expected here."
name (nice-list no-dup-names)))
message-to-date)]
[(and (<= (choice-fail-options fail-type) max-choice-depth) [(and (<= (choice-fail-options fail-type) max-choice-depth)
(> (length no-dup-names) 1) (> (length no-dup-names) 1)
(> (length winners) 1)) (> (length winners) 1))
(format "An error occured in this ~a, one of ~a is expected here. Input is close to one of ~a.~n" (combine-message
name (nice-list no-dup-names) (nice-list top-names))] (msg (format "An error occured in this ~a, one of ~a is expected here. Input is close to one of ~a.~n"
[(and (<= (choice-fail-options fail-type) max-choice-depth) name (nice-list no-dup-names) (nice-list top-names)))
message-to-date)]
#;[(and (<= (choice-fail-options fail-type) max-choice-depth)
(> (length no-dup-names) 1)) (> (length no-dup-names) 1))
(format "An error occured in this ~a, one of ~a is expected here. Current input is close to ~a.~a~n" (combine-message
(msg (format "An error occured in this ~a, one of ~a is expected here. Current input is close to ~a.~a~n"
name (nice-list no-dup-names) top-name name (nice-list no-dup-names) top-name
(if show-options " To see all options click here." ""))] ;Add support for formatting and passing up all options (if show-options " To see all options click here." "")))
message-to-date)] ;Add support for formatting and passing up all options
[else [else
(format "An error occured in this ~a~a.~a~n" (fail-type->message
(car winners)
(add-to-message
(msg (format "An error occured in this ~a~a.~a~n"
name name
(if (equal? name top-name) "" (format ", it is likely that you intended ~a ~a here" (if (equal? name top-name) "" (format ", it is likely that you intended ~a ~a here"
(a/an top-name) top-name)) (a/an top-name) top-name))
(if show-options " To see all options click here." ""))])) (if show-options " To see all options click here." "")))
name #f message-to-date)))]))) name #f message-to-date))]))])))
(define (chance-used a) (* (fail-type-chance a) (fail-type-used a))) (define (chance-used a) (* (fail-type-chance a) (fail-type-used a)))
(define (chance-may-use a) (* (fail-type-chance a) (fail-type-may-use a))) (define (chance-may-use a) (* (fail-type-chance a) (fail-type-may-use a)))

14
collects/profj/comb-parsers/java-signatures.scm
View File

@ -55,7 +55,9 @@
((terminals special-toks (EXAMPLE TEST_SUITE IMAGE_SPECIAL OTHER_SPECIAL)))) ((terminals special-toks (EXAMPLE TEST_SUITE IMAGE_SPECIAL OTHER_SPECIAL))))
;General purpose signatures ;General purpose signatures
(define-signature general-productions^ (comma-sep variable-declaration name)) (define-signature general-productions^ (comma-sep #;variable-declaration #;name))
(define-signature java-variables^ (identifier name variable-declaration))
;Types, modifiers, operator signatures ;Types, modifiers, operator signatures
@ -84,17 +86,17 @@
;Statement signatures ;Statement signatures
(define-signature statements^ (statement if-s return-s this-call super-ctor-call (define-signature statements^ (make-statement if-s return-s this-call super-ctor-call
block expression-stmt while-l do-while for-l block expression-stmt while-l do-while for-l
break-s cont-s init)) break-s cont-s init))
;Member signatures ;Member signatures
(define-signature fields^ (field arg args)) (define-signature fields^ (make-field arg args))
(define-signature methods^ (method-signature method-header method)) (define-signature methods^ (method-signature method-header make-method))
(define-signature ctors^ (constructor)) (define-signature ctors^ (make-constructor))
;Definition signatures ;Definition signatures
@ -102,7 +104,7 @@
(define-signature classes^ (class-body implements-dec extend-dec class-def)) (define-signature classes^ (class-body implements-dec extend-dec class-def))
(define-signature top-forms^ (top-member import-dec program)) (define-signature top-forms^ (top-member import-dec make-program))
) )
; ;

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

@ -7,6 +7,11 @@
"java-signatures.scm" "java-signatures.scm"
(lib "string.ss")) (lib "string.ss"))
(define-signature language-forms^ (program statement expression field))
(define-signature token-proc^ (old-tokens->new))
(define-unit java-dictionary@ (define-unit java-dictionary@
(import) (import)
(export language-dictionary^ (export language-dictionary^
@ -179,7 +184,7 @@
(define-unit types@ (define-unit types@
(import combinator-parser^ java-type-keywords^ java-ids^ java-separators^ id^) (import combinator-parser^ java-type-keywords^ java-variables^ java-separators^ id^)
(export java-types^) (export java-types^)
(define integer-types (define integer-types
@ -193,7 +198,7 @@
(define (other-type-base types) (choice types "type")) (define (other-type-base types) (choice types "type"))
(define (value+name-type base-type name) (define (value+name-type base-type)
(choose (base-type name) "type")) (choose (base-type name) "type"))
(define (method-type base-t) (define (method-type base-t)
@ -277,10 +282,31 @@
) )
(define-unit unqualified-java-variables@
(import combinator-parser^ general-productions^ java-separators^ java-operators^ java-ids^ id^)
(export java-variables^)
(define name IDENTIFIER)
(define identifier IDENTIFIER)
(define (variable-declaration type expr share-type? name)
(let* ([f (choose (identifier (sequence ((^ identifier) EQUAL expr) id)) (string-append name " declaration"))]
[s&e (sequence (type (comma-sep f name) SEMI_COLON) id (string-append name " definition"))]
[s (sequence (type (comma-sep identifier name) SEMI_COLON) id (string-append name " definition"))]
[e (sequence (type (^ identifier) EQUAL expr SEMI_COLON) id (string-append name " definition"))]
[base (sequence (type (^ identifier) SEMI_COLON) id (string-append name " definition"))])
(cond
[(and expr share-type?) s&e]
[share-type? s]
[expr (choose (e base) (string-append name " definition"))]
[else base])))
)
(define-unit expressions@ (define-unit expressions@
(import combinator-parser^ general-productions^ id^ (import combinator-parser^ general-productions^ id^
java-literals^ java-expression-keywords^ java-vals^ java-ids^ java-separators^ java-literals^ java-expression-keywords^ java-vals^ java-ids^
java-operators^ java-extras^) java-variables^ java-separators^
java-operators^ java-extras^ language-forms^)
(export expression-maker^ expr-lits^ expr-terms+^ expr-tails^) (export expression-maker^ expr-lits^ expr-terms+^ expr-tails^)
(define (simple-expression exprs) (define (simple-expression exprs)
@ -310,9 +336,9 @@
(choose (NULL_LIT boolean-lits textual-lits prim-numeric-lits double-lits numeric-lits) (choose (NULL_LIT boolean-lits textual-lits prim-numeric-lits double-lits numeric-lits)
"literal expression")) "literal expression"))
(define (new-class class-name expr) (define (new-class expr)
(choose ((sequence (new class-name O_PAREN C_PAREN) id "class instantiation") (choose ((sequence (new name O_PAREN C_PAREN) id "class instantiation")
(sequence (new class-name O_PAREN (comma-sep expr "arguments") C_PAREN) id "class instantiation")) (sequence (new name O_PAREN (comma-sep expression "arguments") C_PAREN) id "class instantiation"))
"class instantiation")) "class instantiation"))
(define (new-array type-name expr) (define (new-array type-name expr)
@ -320,7 +346,7 @@
id "array instantiation")) id "array instantiation"))
(define field-access-end (define field-access-end
(sequence (PERIOD IDENTIFIER) id "field access")) (sequence (PERIOD identifier) id "field access"))
(define (array-access-end expr) (define (array-access-end expr)
(sequence (O_BRACKET expr C_BRACKET) id "array access")) (sequence (O_BRACKET expr C_BRACKET) id "array access"))
@ -342,18 +368,18 @@
(define (simple-method-call expr) (define (simple-method-call expr)
(choose (choose
((sequence ((^ IDENTIFIER) O_PAREN C_PAREN) id "method invocation") ((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 (comma-sep expr "argument list") C_PAREN) id "method invocation"))
"method invocation")) "method invocation"))
(define (method-call-end expr) (define (method-call-end expr)
(choose (choose
((sequence (PERIOD (^ IDENTIFIER) O_PAREN C_PAREN) id "method invocation") ((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 (comma-sep expr "argument list") C_PAREN) id "method invocation"))
"method invocation")) "method invocation"))
(define (assignment name op expr) (define (assignment asignee op expr)
(sequence ((^ name) op expr) id "assignment")) (sequence ((^ asignee) op expr) id "assignment"))
(define (unary-assignment-front expr) (define (unary-assignment-front expr)
(choose ((sequence (++ expr) id "unary modification") (choose ((sequence (++ expr) id "unary modification")
@ -366,12 +392,12 @@
(define (cast type expr) (define (cast type expr)
(sequence (O_PAREN type C_PAREN expr) "cast expression")) (sequence (O_PAREN type C_PAREN expr) "cast expression"))
(define (instanceof-back name) (define instanceof-back
(sequence (instanceof name) "instanceof expression")) (sequence (instanceof name) "instanceof expression"))
(define (super-call expr) (define (super-call expr)
(choose ((sequence (super PERIOD IDENTIFIER O_PAREN C_PAREN) id "super method invocation") (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")) (sequence (super PERIOD identifier O_PAREN (comma-sep expr "arguments") C_PAREN) id "super method invocation"))
"super method invocation")) "super method invocation"))
(define (checks expr) (define (checks expr)
@ -459,23 +485,23 @@
(define init (define init
(sequence (this PERIOD IDENTIFIER EQUAL IDENTIFIER SEMI_COLON) id "field initialization")) (sequence (this PERIOD IDENTIFIER EQUAL IDENTIFIER SEMI_COLON) id "field initialization"))
(define (statement statements) (define (make-statement statements)
(choice statements "statement")) (choice statements "statement"))
) )
(define-unit members@ (define-unit members@
(import combinator-parser^ general-productions^ id^ java-types^ (import combinator-parser^ general-productions^ id^ java-types^
java-separators^ java-ids^ java-definition-keywords^) java-separators^ java-ids^ java-definition-keywords^ java-variables^)
(export fields^ methods^ ctors^) (export fields^ methods^ ctors^)
(define (field mods type expr share-types?) (define (make-field mods type expr share-types?)
(cond (cond
[mods (sequence ((repeat mods) (variable-declaration type expr share-types? "field")) [mods (sequence ((repeat mods) (variable-declaration type expr share-types? "field"))
id "field definition")] id "field definition")]
[else (variable-declaration type expr share-types? "field")])) [else (variable-declaration type expr share-types? "field")]))
(define arg (sequence ((value+name-type prim-type IDENTIFIER) IDENTIFIER) id "argument")) (define arg (sequence ((value+name-type prim-type) identifier) id "argument"))
(define args (comma-sep arg "parameter list")) (define args (comma-sep arg "parameter list"))
@ -485,10 +511,10 @@
(choose ((sequence (O_PAREN C_PAREN) id) (choose ((sequence (O_PAREN C_PAREN) id)
(sequence (O_PAREN a C_PAREN) id)) "method parameter list") (sequence (O_PAREN a C_PAREN) id)) "method parameter list")
(sequence (O_PAREN 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 type")) id "method signature")]
[full-no-t (sequence ((repeat m) ret (^ IDENTIFIER) method-parms) 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 type")) id "method signature")]
[no-mods (sequence (ret (^ IDENTIFIER) method-parms) id "method signature")]) [no-mods (sequence (ret (^ identifier) method-parms) id "method signature")])
(cond (cond
[(and m t?) (choose (full full-no-t) "method signature")] [(and m t?) (choose (full full-no-t) "method signature")]
[m full-no-t] [m full-no-t]
@ -498,13 +524,13 @@
(define (method-header method-sig) (define (method-header method-sig)
(sequence (method-sig SEMI_COLON) id "method declaration")) (sequence (method-sig SEMI_COLON) id "method declaration"))
(define (method signature statement) (define (make-method signature statement)
(sequence ((^ signature) O_BRACE statement C_BRACE) id "method definition")) (sequence ((^ signature) O_BRACE statement C_BRACE) id "method definition"))
(define (constructor mod body) (define (make-constructor mod body)
(let ([ctor (choose (let ([ctor (choose
((sequence ((^ IDENTIFIER) O_PAREN C_PAREN O_BRACE body C_BRACE) id) ((sequence ((^ identifier) O_PAREN C_PAREN O_BRACE body C_BRACE) id)
(sequence ((^ IDENTIFIER) O_PAREN args C_PAREN O_BRACE body C_BRACE) id)) (sequence ((^ identifier) O_PAREN args C_PAREN O_BRACE body C_BRACE) id))
"constructor definition")]) "constructor definition")])
(cond (cond
[mod (sequence ((repeat mod) ctor) id "constructor definition")] [mod (sequence ((repeat mod) ctor) id "constructor definition")]
@ -567,18 +593,19 @@
(define-unit top-forms@ (define-unit top-forms@
(import combinator-parser^ id^ java-definition-keywords^ java-separators^ (import combinator-parser^ id^ java-definition-keywords^ java-separators^
general-productions^) java-variables^ general-productions^)
(export top-forms^) (export top-forms^)
(define (top-member mems) (define (top-member mems)
(choice mems "program body")) (choice mems "program body"))
;Note -- should enfore name to be identifier.identifier instead of name
(define import-dec (define import-dec
(choose (choose
((sequence (import name PERIOD TIMES SEMI_COLON) id) ((sequence (import name PERIOD TIMES SEMI_COLON) id)
(sequence (import name SEMI_COLON) id)) "import declaration")) (sequence (import name SEMI_COLON) id)) "import declaration"))
(define (program package import body) (define (make-program package import body)
(let ([p&i (sequence (package import body) id "program")] (let ([p&i (sequence (package import body) id "program")]
[p (sequence (package body) id "program")] [p (sequence (package body) id "program")]
[i (sequence (import body) id "program")]) [i (sequence (import body) id "program")])
@ -593,286 +620,288 @@
) )
(define-signature language-forms^
(beginner-program beginner-statement beginner-expression beginner-field
intermediate-program intermediate+access-program intermediate-statement intermediate-expression
advanced-program advanced-statement advanced-expression
))
(define-signature token-proc^ (old-tokens->new))
(define-signature parsers^
(parse-beginner parse-intermediate parse-intermediate+access parse-advanced))
(define-unit java-grammars@
(import combinator-parser^ java-operators^ java-separators^
java-statement-keywords^ java-definition-keywords^
java-type-keywords^ java-ids^
java-types^ java-access^ java-ops^ general-productions^
expression-maker^ expr-lits^ expr-terms+^ expr-tails^ statements^
fields^ methods^ ctors^ interfaces^ classes^ top-forms^ id^)
(export language-forms^ token-proc^)
;Remembered Unsupported Features ;Remembered Unsupported Features
;throws clause ;throws clause
;strictfp ;strictfp
;allowing static fields in interface ;allowing static fields in interface
;Beginner definition (define-unit beginner-grammar@
(import combinator-parser^ java-operators^ java-separators^
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 beginner-unique-base (define unique-base
(simple-expression (simple-expression
(list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits)) (list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
this this
IDENTIFIER identifier
(new-class IDENTIFIER (eta beginner-expression)) (new-class (eta expression))
(simple-method-call (eta beginner-expression)) (simple-method-call (eta expression))
(sequence (O_PAREN (eta beginner-expression) C_PAREN) id "expression") (sequence (O_PAREN (eta expression) C_PAREN) id "expression")
(sequence (! (eta beginner-expression)) id "conditional expression") (sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta beginner-expression)) id "negation expression") (sequence (MINUS (eta expression)) id "negation expression")
(checks (eta beginner-expression))))) (checks (eta expression)))))
(define beginner-unique-end (define unique-end
(simple-expression (simple-expression
(list field-access-end (list field-access-end
(method-call-end (eta beginner-expression)) (method-call-end (eta expression))
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops)) (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))
(eta beginner-expression))))) (eta expression)))))
(define beginner-expression (define expression
(sequence (beginner-unique-base (repeat beginner-unique-end)) id "expression")) (sequence (unique-base (repeat unique-end)) id "expression"))
(define beginner-statement (define statement
(statement (list (if-s beginner-expression (eta beginner-statement) #f) (make-statement (list (if-s expression (eta statement) #f)
(return-s beginner-expression #f)))) (return-s expression #f))))
(define beginner-field (field #f (value+name-type prim-type IDENTIFIER) beginner-expression #f)) (define field (make-field #f (value+name-type prim-type) expression #f))
(define beginner-method-sig (define method-sig
(method-signature #f (value+name-type prim-type IDENTIFIER) args #f IDENTIFIER)) (method-signature #f (value+name-type prim-type) args #f identifier))
(define beginner-method (define method (make-method method-sig statement))
(method beginner-method-sig beginner-statement))
(define beginner-constructor (constructor #f (repeat init))) (define constructor (make-constructor #f (repeat init)))
(define beginner-interface (define interface (interface-def #f #f (repeat method-sig)))
(interface-def #f #f (repeat beginner-method-sig)))
(define beginner-class (define class
(class-def #f #f (implements-dec IDENTIFIER) (class-def #f #f (implements-dec identifier)
(repeat (class-body (list beginner-field beginner-method beginner-constructor))))) (repeat (class-body (list field method constructor)))))
(define beginner-program (define program
(program #f (repeat import-dec) (make-program #f (repeat import-dec) (repeat (top-member (list class interface)))))
(repeat (top-member (list beginner-class beginner-interface))))) )
(define-signature int+acc^ (intermediate+access-prog))
; (define-unit intermediate-grammar@
;Intermediate definition (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^)
(define intermediate-unique-base (define unique-base
(simple-expression (simple-expression
(list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits)) (list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this this
IDENTIFIER identifier
(new-class IDENTIFIER (eta intermediate-expression)) (new-class (eta expression))
(simple-method-call (eta intermediate-expression)) (simple-method-call (eta expression))
(sequence (O_PAREN (eta intermediate-expression) C_PAREN) id "expression") (sequence (O_PAREN (eta expression) C_PAREN) id "expression")
(sequence (! (eta intermediate-expression)) id "conditional expression") (sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta intermediate-expression)) id "negation expression") (sequence (MINUS (eta expression)) id "negation expression")
(cast (value+name-type prim-type IDENTIFIER) (eta intermediate-expression)) (cast (value+name-type prim-type) (eta expression))
(super-call (eta intermediate-expression)) (super-call (eta expression))
(checks (eta intermediate-expression))))) (checks (eta expression)))))
(define intermediate-unique-end (define unique-end
(simple-expression (simple-expression
(list field-access-end (list field-access-end
(method-call-end (eta intermediate-expression)) (method-call-end (eta expression))
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops)) (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops))
(eta intermediate-expression)) (eta expression))
(instanceof-back (value+name-type prim-type IDENTIFIER))))) instanceof-back)))
(define intermediate-expression (define expression
(sequence (intermediate-unique-base (repeat intermediate-unique-end)) (sequence (unique-base (repeat unique-end)) id "expression"))
id "expression"))
(define intermediate-stmt-expr (define stmt-expr
(simple-expression (list (new-class IDENTIFIER intermediate-expression) (simple-expression (list (new-class expression)
(super-call intermediate-expression) (super-call expression)
(sequence (intermediate-expression (sequence (expression (method-call-end expression))
(method-call-end intermediate-expression))
id "method call") id "method call")
(assignment (assignment
(choose (IDENTIFIER (choose (identifier
(sequence (intermediate-unique-base field-access-end) id)) (sequence (unique-base field-access-end) id))
"assignee") "assignee")
EQUAL intermediate-expression)))) EQUAL expression))))
(define intermediate-statement (define statement
(statement (list (if-s intermediate-expression (eta intermediate-statement) #f) (make-statement (list (if-s expression (eta statement) #f)
(return-s intermediate-expression #t) (return-s expression #t)
(variable-declaration (value+name-type prim-type IDENTIFIER) intermediate-expression #f "local variable") (variable-declaration (value+name-type prim-type) expression #f "local variable")
(block (repeat (eta intermediate-statement))) (block (repeat (eta statement)))
(sequence (intermediate-stmt-expr SEMI_COLON) id "statement")))) (sequence (stmt-expr SEMI_COLON) id "statement"))))
(define intermediate-field (field #f (value+name-type prim-type IDENTIFIER) intermediate-expression #t)) (define field (make-field #f (value+name-type prim-type) expression #t))
(define intermediate+access-field (field access-mods (value+name-type prim-type IDENTIFIER) intermediate-expression #t)) (define intermediate+access-field (make-field access-mods (value+name-type prim-type) expression #t))
(define intermediate-method-sig-no-abs (define method-sig-no-abs
(method-signature #f (method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-signature #f (method-type (value+name-type prim-type)) args #f identifier))
(define intermediate-method-sig-abs (define method-sig-abs
(method-signature abstract (method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-signature tok:abstract (method-type (value+name-type prim-type)) args #f identifier))
(define intermediate+access-method-sig-no-abs (define intermediate+access-method-sig-no-abs
(method-signature access-mods (method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-signature access-mods (method-type (value+name-type prim-type)) args #f identifier))
(define intermediate+access-method-sig-abs (define intermediate+access-method-sig-abs
(method-signature (method-mods access-mods) (method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-signature (method-mods access-mods)
(method-type (value+name-type prim-type)) args #f identifier))
(define intermediate-method (define method
(choose ((method intermediate-method-sig-no-abs intermediate-statement) (choose ((make-method method-sig-no-abs statement)
(method-header intermediate-method-sig-abs)) "method definition")) (method-header method-sig-abs)) "method definition"))
(define intermediate+access-method (define intermediate+access-method
(choose ((method intermediate+access-method-sig-no-abs intermediate-statement) (choose ((make-method intermediate+access-method-sig-no-abs statement)
(method-header intermediate+access-method-sig-abs)) "method definition")) (method-header intermediate+access-method-sig-abs)) "method definition"))
(define intermediate-constructor (define constructor
(constructor #f (make-constructor #f
(choose ((sequence ((super-call intermediate-expression) (repeat intermediate-statement)) id) (choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call intermediate-expression) (repeat intermediate-statement)) id) (sequence ((this-call expression) (repeat statement)) id)
(repeat intermediate-statement)) "constructor body"))) (repeat statement)) "constructor body")))
(define intermediate+access-constructor (define intermediate+access-constructor
(constructor access-mods (make-constructor access-mods
(choose ((sequence ((super-call intermediate-expression) (repeat intermediate-statement)) id) (choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call intermediate-expression) (repeat intermediate-statement)) id) (sequence ((this-call expression) (repeat statement)) id)
(repeat intermediate-statement)) "constructor body"))) (repeat statement)) "constructor body")))
(define intermediate-interface (define interface
(interface-def (interface-def
#f #f
(sequence (extends (comma-sep IDENTIFIER "interfaces")) id "extends") (sequence (tok:extends (comma-sep identifier "interfaces")) id "extends")
(repeat intermediate-method-sig-no-abs))) (repeat method-sig-no-abs)))
(define intermediate-class (define class
(class-def abstract (extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces")) (class-def tok:abstract (extend-dec identifier) (implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list intermediate-field intermediate-method intermediate-constructor))))) (repeat (class-body (list field method constructor)))))
(define intermediate+access-class (define intermediate+access-class
(class-def abstract (extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces")) (class-def tok:abstract (extend-dec identifier) (implements-dec (comma-sep identifier "interfaces"))
(repeat (class-body (list intermediate+access-field (repeat (class-body (list intermediate+access-field
intermediate+access-method intermediate+access-method
intermediate+access-constructor))))) intermediate+access-constructor)))))
(define intermediate-program (define program
(program #f (repeat import-dec) (repeat (top-member (list class interface)))))
(define intermediate+access-prog
(program #f (repeat import-dec) (program #f (repeat import-dec)
(repeat (top-member (list intermediate-class intermediate-interface))))) (repeat (top-member (list intermediate+access-class interface)))))
(define intermediate+access-program )
(program #f (repeat import-dec)
(repeat (top-member (list intermediate+access-class intermediate-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^
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 advanced-unique-base (define unique-base
(simple-expression (simple-expression
(list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits)) (list (literals (list null-lit boolean-lits textual-lits prim-numeric-lits double-lits))
this this
IDENTIFIER IDENTIFIER
(new-class IDENTIFIER (eta advanced-expression)) (new-class (eta expression))
(simple-method-call (eta advanced-expression)) (simple-method-call (eta expression))
(new-array (value+name-type prim-type IDENTIFIER) (eta advanced-expression)) (new-array (value+name-type prim-type) (eta expression))
(sequence (O_PAREN (eta advanced-expression) C_PAREN) id "expression") (sequence (O_PAREN (eta expression) C_PAREN) id "expression")
(sequence (! (eta advanced-expression)) id "conditional expression") (sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta advanced-expression)) id "negation exxpression") (sequence (MINUS (eta expression)) id "negation exxpression")
(cast (value+name-type prim-type IDENTIFIER) (eta advanced-expression)) (cast (value+name-type prim-type) (eta expression))
(super-call (eta advanced-expression)) (super-call (eta expression))
(checks (eta advanced-expression))))) (checks (eta expression)))))
(define advanced-unique-end (define unique-end
(simple-expression (simple-expression
(list field-access-end (list field-access-end
(array-access-end (eta advanced-expression)) (array-access-end (eta expression))
(method-call-end (eta advanced-expression)) (method-call-end (eta expression))
(if-expr-end (eta advanced-expression)) (if-expr-end (eta expression))
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops)) (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops))
(eta advanced-expression)) (eta expression))
(instanceof-back (value+name-type prim-type IDENTIFIER))))) instanceof-back)))
(define expression
(sequence (unique-base (repeat unique-end)) id "expression"))
(define advanced-expression (define stmt-expr
(sequence (advanced-unique-base (repeat advanced-unique-end)) id "expression")) (simple-expression (list (new-class expression)
(super-call expression)
(sequence (expression
(define advanced-stmt-expr (method-call-end expression)) id "method call")
(simple-expression (list (new-class IDENTIFIER advanced-expression)
(super-call advanced-expression)
(sequence (advanced-expression
(method-call-end advanced-expression)) id "method call")
(assignment (assignment
(choose (IDENTIFIER (choose (identifier
(sequence (advanced-expression field-access-end) id) (sequence (expression field-access-end) id)
(sequence (advanced-expression array-access-end) id)) (sequence (expression array-access-end) id))
"asignee") "asignee")
assignment-ops advanced-expression) assignment-ops expression)
(sequence (advanced-expression ++) id "unary mutation") (sequence (expression ++) id "unary mutation")
(sequence (advanced-expression --) id "unary mutation") (sequence (expression --) id "unary mutation")
(sequence (++ advanced-expression) id "unary mutation") (sequence (++ expression) id "unary mutation")
(sequence (-- advanced-expression) id "unary mutation")))) (sequence (-- expression) id "unary mutation"))))
(define advanced-statement (define statement
(statement (list (if-s advanced-expression (eta advanced-statement) #t) (make-statement (list (if-s expression (eta statement) #t)
(return-s advanced-expression #t) (return-s expression #t)
(variable-declaration (value+name-type prim-type IDENTIFIER) advanced-expression #t "local variable") (variable-declaration (value+name-type prim-type) expression #t "local variable")
(block (repeat (eta advanced-statement))) (block (repeat (eta statement)))
(sequence (advanced-stmt-expr SEMI_COLON) id "statement") (sequence (stmt-expr SEMI_COLON) id "statement")
(for-l (choose ((variable-declaration (value+name-type prim-type IDENTIFIER) advanced-expression #t "for loop variable") (for-l (choose ((variable-declaration (value+name-type prim-type) expression #t "for loop variable")
(comma-sep advanced-stmt-expr "initializations")) "for loop initialization") (comma-sep stmt-expr "initializations")) "for loop initialization")
#t #t
advanced-expression #t expression #t
(comma-sep advanced-stmt-expr "for loop increments") #t (eta advanced-statement)) (comma-sep stmt-expr "for loop increments") #t (eta statement))
(while-l advanced-expression (eta advanced-statement)) (while-l expression (eta statement))
(do-while advanced-expression (eta advanced-statement)) (do-while expression (eta statement))
(break-s #f) (break-s #f)
(cont-s #f)))) (cont-s #f))))
(define advanced-field (field (global-mods access-mods) (value+name-type prim-type IDENTIFIER) advanced-expression #t)) (define field (make-field (global-mods access-mods) (value+name-type prim-type) expression #t))
(define advanced-method-sig-no-abs (define method-sig-no-abs
(method-signature (global-mods access-mods) (method-signature (global-mods access-mods)
(method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-type (value+name-type prim-type)) args #f IDENTIFIER))
(define advanced-method-sig-abs (define method-sig-abs
(method-signature (method-mods (global-mods access-mods)) (method-signature (method-mods (global-mods access-mods))
(method-type (value+name-type prim-type IDENTIFIER)) args #f IDENTIFIER)) (method-type (value+name-type prim-type)) args #f IDENTIFIER))
(define advanced-method (define method
(choose ((method advanced-method-sig-no-abs advanced-statement) (choose ((make-method method-sig-no-abs statement)
(method-header advanced-method-sig-abs)) "method definition")) (method-header method-sig-abs)) "method definition"))
(define advanced-constructor (define constructor
(constructor access-mods (make-constructor access-mods
(choose ((sequence ((super-call advanced-expression) (repeat advanced-statement)) id) (choose ((sequence ((super-call expression) (repeat statement)) id)
(sequence ((this-call advanced-expression) (repeat advanced-statement)) id) (sequence ((this-call expression) (repeat statement)) id)
(repeat advanced-statement)) "constructor body"))) (repeat statement)) "constructor body")))
(define advanced-interface (define interface
(interface-def (interface-def
#f #f
(sequence (extends (comma-sep IDENTIFIER "interfaces")) id "extends") (sequence (tok:extends (comma-sep IDENTIFIER "interfaces")) id "extends")
(repeat (choose (advanced-method-sig-no-abs (repeat (choose (method-sig-no-abs
(field (global-mods access-mods) (value+name-type prim-type IDENTIFIER) advanced-expression #t)) (make-field (global-mods access-mods) (value+name-type prim-type) expression #t))
"interface member definition")))) "interface member definition"))))
(define advanced-class (define class
(class-def (choose (abstract public) "class modifier") (class-def (choose (tok:abstract tok:public) "class modifier")
(extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces")) (extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces"))
(repeat (class-body (list advanced-field advanced-method advanced-constructor (repeat (class-body (list field method constructor
(method-header advanced-method-sig-abs)))))) (method-header method-sig-abs))))))
(define advanced-program (define program
(program (sequence (package name SEMI_COLON) id "package specification") (program (sequence (tok:package name SEMI_COLON) id "package specification")
(repeat import-dec) (repeat import-dec)
(repeat (top-member (list advanced-class advanced-interface))))) (repeat (top-member (list class interface)))))
)
(define-unit token@
(import java-operators^ java-separators^ java-definition-keywords^
java-statement-keywords^ java-type-keywords^ java-ids^)
(export token-proc^)
(define (old-tokens->new tok-list) (define (old-tokens->new tok-list)
(cond (cond
@ -904,32 +933,44 @@
) )
(define-signature parsers^ (parse-program))
(define-unit full-program-parsers@ (define-unit definition-parsers@
(import language-forms^ combinator-parser^) (import language-forms^ combinator-parser^)
(export parsers^) (export parsers^)
(define parse-program (parser program)))
(define parse-beginner (parser beginner-program)) (define-unit interactions-parsers@
(define parse-intermediate (parser intermediate-program))
(define parse-intermediate+access (parser intermediate+access-program))
(define parse-advanced (parser advanced-program))
)
(define-unit interaction-parsers@
(import language-forms^ combinator-parser^) (import language-forms^ combinator-parser^)
(export parsers^) (export parsers^)
(define parse-program (parser (choose (expression statement field) "interactions program"))))
(define parse-beginner (parser (choose (beginner-expression beginner-statement beginner-field)
"interactions program")))
(define parse-intermediate (parser (choose (intermediate-expression intermediate-statement) ; (define-unit full-program-parsers@
"interactions program"))) ; (import language-forms^ combinator-parser^)
(define parse-intermediate+access parse-intermediate) ; (export parsers^)
;
(define parse-advanced ; (define parse-beginner (parser beginner-program))
(parser (choose (advanced-expression advanced-statement) "interactions program"))) ; (define parse-intermediate (parser intermediate-program))
) ; (define parse-intermediate+access (parser intermediate+access-program))
; (define parse-advanced (parser advanced-program))
;
; )
;
; (define-unit interaction-parsers@
; (import language-forms^ combinator-parser^)
; (export parsers^)
;
; (define parse-beginner (parser (choose (beginner-expression beginner-statement beginner-field)
; "interactions program")))
;
; (define parse-intermediate (parser (choose (intermediate-expression intermediate-statement)
; "interactions program")))
; (define parse-intermediate+access parse-intermediate)
;
; (define parse-advanced
; (parser (choose (advanced-expression advanced-statement) "interactions program")))
; )
(define-unit file-constants@ (define-unit file-constants@
(import) (import)
@ -963,31 +1004,112 @@
(export id^) (export id^)
(define (id x . args) x)) (define (id x . args) x))
(define-compound-unit/infer java-file-parsers@ (define-compound-unit/infer beginner-file-parser@
(import) (import)
(export parsers^ token-proc^ err^) (export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ file-constants@ id@ (link java-dictionary@ combinator-parser-tools@ file-constants@ id@
java-terminals@ types@ mods@ operators@ general@ java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@ expressions@ statements@ members@ interface@ class@ top-forms@
java-grammars@ full-program-parsers@)) beginner-grammar@ token@ definition-parsers@))
(define-compound-unit/infer java-definitions-parsers@
(define-compound-unit/infer beginner-definitions-parser@
(import) (import)
(export parsers^ token-proc^ err^) (export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ de-constants@ id@ (link java-dictionary@ combinator-parser-tools@ de-constants@ id@
java-terminals@ types@ mods@ operators@ general@ java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@ expressions@ statements@ members@ interface@ class@ top-forms@
java-grammars@ full-program-parsers@)) beginner-grammar@ token@ definition-parsers@))
(define-compound-unit/infer java-interactions-parsers@ (define-compound-unit/infer beginner-interactions-parsers@
(import) (import)
(export parsers^ token-proc^ err^) (export parsers^ token-proc^ err^)
(link java-dictionary@ combinator-parser-tools@ interact-constants@ id@ (link java-dictionary@ combinator-parser-tools@ interact-constants@ id@
java-terminals@ types@ mods@ operators@ general@ java-terminals@ types@ mods@ operators@ general@ unqualified-java-variables@
expressions@ statements@ members@ interface@ class@ top-forms@ expressions@ statements@ members@ interface@ class@ top-forms@
java-grammars@ interaction-parsers@)) beginner-grammar@ token@ interactions-parsers@))
(provide java-definitions-parsers@ java-interactions-parsers@ parsers^ token-proc^) (define-compound-unit/infer intermediate-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-grammar@ token@ definition-parsers@))
(define-compound-unit/infer intermediate-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-grammar@ token@ definition-parsers@))
(define-compound-unit/infer intermediate-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-grammar@ token@ interactions-parsers@))
(define-compound-unit/infer advanced-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@
advanced-grammar@ token@ definition-parsers@))
(define-compound-unit/infer advanced-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@
advanced-grammar@ token@ definition-parsers@))
(define-compound-unit/infer advanced-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@
advanced-grammar@ token@ interactions-parsers@))
;
(provide advanced-file-parser@ advanced-definitions-parser@ advanced-interactions-parsers@
intermediate-file-parser@ intermediate-definitions-parser@ intermediate-interactions-parsers@
beginner-file-parser@ beginner-definitions-parser@ beginner-interactions-parsers@
parsers^ token-proc^)
; (define-compound-unit/infer java-file-parsers@
; (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@
; java-grammars@ full-program-parsers@))
;
; (define-compound-unit/infer java-definitions-parsers@
; (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@
; java-grammars@ full-program-parsers@))
;
; (define-compound-unit/infer java-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@
; java-grammars@ interaction-parsers@))
;
; (provide java-definitions-parsers@ java-interactions-parsers@ parsers^ token-proc^)
) )

52
collects/profj/comb-parsers/parsers.scm
View File

@ -323,13 +323,35 @@
; )) ; ))
; ;
(define-values/invoke-unit java-definitions-parsers@ ; (define-values/invoke-unit java-definitions-parsers@
(import) ; (import)
(export (prefix def: parsers^) (prefix def: err^) token-proc^)) ; (export (prefix def: parsers^) (prefix def: err^) token-proc^))
;
; (define-values/invoke-unit java-interactions-parsers@
; (import)
; (export (prefix int: parsers^) (prefix int: err^)))
(define-values/invoke-unit java-interactions-parsers@ (define-values/invoke-unit beginner-definitions-parser@
(import) (import)
(export (prefix int: parsers^) (prefix int: err^))) (export (prefix beginner-def: parsers^) (prefix beginner-def: err^) token-proc^))
(define-values/invoke-unit beginner-interactions-parsers@
(import)
(export (prefix beginner-int: parsers^) (prefix beginner-int: err^)))
(define-values/invoke-unit intermediate-definitions-parser@
(import)
(export (prefix intermediate-def: parsers^) (prefix intermediate-def: err^)))
(define-values/invoke-unit intermediate-interactions-parsers@
(import)
(export (prefix intermediate-int: parsers^) (prefix intermediate-int: err^)))
(define-values/invoke-unit advanced-definitions-parser@
(import)
(export (prefix advanced-def: parsers^) (prefix advanced-def: err^)))
(define-values/invoke-unit advanced-interactions-parsers@
(import)
(export (prefix advanced-int: parsers^) (prefix advanced-int: err^) ))
(define (parse parser err? err-src err-msg) (define (parse parser err? err-src err-msg)
(lambda (program-stream location) (lambda (program-stream location)
@ -341,13 +363,19 @@
(!!! ((!!! parser) (old-tokens->new program-stream) location))]);)]) (!!! ((!!! parser) (old-tokens->new program-stream) location))]);)])
(if (err? output) (list (err-msg output) (!!! (err-src output))))))) (if (err? output) (list (err-msg output) (!!! (err-src output)))))))
(define parse-beginner (parse def:parse-beginner def:err? def:err-msg def:err-src)) (define parse-beginner (parse beginner-def:parse-program
(define parse-intermediate (parse def:parse-intermediate def:err? def:err-msg def:err-src)) beginner-def:err? beginner-def:err-msg beginner-def:err-src))
(define parse-intermediate+access (parse def:parse-intermediate+access def:err? def:err-msg def:err-src)) (define parse-intermediate (parse intermediate-def:parse-program
(define parse-advanced (parse def:parse-advanced def:err? def:err-msg def:err-src)) intermediate-def:err? intermediate-def:err-msg intermediate-def:err-src))
(define parse-beginner-interact (parse int:parse-beginner int:err? int:err-msg int:err-src)) (define parse-intermediate+access null #;(parse def:parse-intermediate+access def:err? def:err-msg def:err-src))
(define parse-intermediate-interact (parse int:parse-intermediate int:err? int:err-msg int:err-src)) (define parse-advanced (parse advanced-def:parse-program
(define parse-advanced-interact (parse int:parse-advanced int:err? int:err-msg int:err-src)) advanced-def:err? advanced-def:err-msg advanced-def:err-src))
(define parse-beginner-interact (parse beginner-int:parse-program
beginner-int:err? beginner-int:err-msg beginner-int:err-src))
(define parse-intermediate-interact (parse intermediate-int:parse-program
intermediate-int:err? intermediate-int:err-msg intermediate-int:err-src))
(define parse-advanced-interact (parse advanced-int:parse-program
advanced-int:err? advanced-int:err-msg advanced-int:err-src))

1
collects/profj/parser.ss
View File

@ -39,6 +39,7 @@
(if (new-parser?) (if (new-parser?)
(lambda () (lambda ()
(let ([result (!!! (parser lexed loc))]) (let ([result (!!! (parser lexed loc))])
#;(printf "~a~n" result)
(if (list? result) (if (list? result)
(raise-read-error (cadr result) (raise-read-error (cadr result)
(car (car result)) (car (car result))