diff --git a/collects/combinator-parser/private-combinator/combinator-parser.scm b/collects/combinator-parser/private-combinator/combinator-parser.scm index b6b410bad0..aa90341ed2 100644 --- a/collects/combinator-parser/private-combinator/combinator-parser.scm +++ b/collects/combinator-parser/private-combinator/combinator-parser.scm @@ -17,7 +17,10 @@ (define (parser start) (lambda (input file) - (let* ([result (start input)] + (let* ([first-src (and src? (pair? input) + (make-src-lst (position-token-start-pos (car input)) + (position-token-end-pos (car input))))] + [result (if first-src (start input first-src) (start input))] [out (cond [(and (res? result) (res-a result) (null? (res-rest result))) diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm index 32f8315c1e..60e1fc4855 100644 --- a/collects/combinator-parser/private-combinator/combinator.scm +++ b/collects/combinator-parser/private-combinator/combinator.scm @@ -464,25 +464,33 @@ (repeat-res-stop rest-ans)))] [(pair? rest-ans) (map (lambda (r) (process-rest curr-ans r)) rest-ans)] - [else (error 'here4)]))]) - (opt-lambda (input [last-src (list 1 0 1 0)] [alts 1]) + [else (error 'here4)]))] + [update-src + (lambda (input prev-src) + (cond + [(null? input) prev-src] + [src? (src-list (position-token-start-pos (car input)) + (position-token-end-pos (car input)))] + [else prev-src]))]) + (opt-lambda (input [start-src (list 1 0 1 0)] [alts 1]) (cond [(eq? input return-name) repeat-name] [(hash-table-get memo-table input #f) (hash-table-get memo-table input)] [else (let ([ans - (let loop ([curr-input input]) + (let loop ([curr-input input][curr-src start-src]) (cond [(null? curr-input) (make-repeat-res (make-res null null repeat-name "" 0 #f #f) 'out-of-input)] [else - (let ([this-res (sub curr-input last-src)]) + (let ([this-res (sub curr-input curr-src)]) #;(printf "Repeat of ~a called it's repeated entity: ~n" repeat-name #;this-res) (cond [(and (res? this-res) (res-a this-res)) #;(printf "loop again case~n") - (process-rest this-res (loop (res-rest this-res)))] + (process-rest this-res (loop (res-rest this-res) + (update-src (res-rest this-res) curr-src)))] [(res? this-res) #;(printf "fail for error case ~a~n" (fail-type? (res-msg this-res))) (make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f) @@ -494,7 +502,9 @@ #;(printf "repeat call, choice-res ~a~n" (and (choice-res? this-res) (length (choice-res-matches this-res)))) - (map (lambda (match) (process-rest match (loop (res-rest match)))) + (map (lambda (match) (process-rest match + (loop (res-rest match) + (update-src (res-rest match) curr-src)))) (if (choice-res? this-res) (choice-res-matches this-res) this-res))] @@ -588,6 +598,13 @@ [(null? in) (values correct incorrect)]))) + (define (src-list src-s src-e) + (list (position-line src-s) + (position-col src-s) + (position-offset src-s) + (- (position-offset src-s) + (position-offset src-e)))) + (define (update-src-start src new-start) (list (position-line new-start) (position-col new-start) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index b99d94e929..afa7247adc 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -8,7 +8,7 @@ (lib "string.ss")) - (define-signature language-forms^ (program statement expression field)) ;value-type method-type)) + (define-signature language-forms^ (program statement expression field interact)) ;value-type method-type)) (define-signature token-proc^ (old-tokens->new)) @@ -206,13 +206,9 @@ (choice (list base-t voidT) "method return")) (define (array-type base-t) - (choose (base-t - (sequence (base-t O_BRACKET C_BRACKET - (repeat-greedy - (sequence (O_BRACKET C_BRACKET) id "array type"))) - id "type")) "type")) - ) + (sequence (base-t (repeat (sequence (O_BRACKET C_BRACKET) id "array type"))) "type")) + ) (define-unit mods@ (import combinator-parser^ java-definition-keywords^) @@ -686,6 +682,9 @@ (define program (make-program #f (repeat-greedy import-dec) (repeat-greedy (top-member (list class interface))))) + + (define interact + (choose (field statement expression) "interactive program")) ) (define-unit intermediate-grammar@ @@ -728,12 +727,22 @@ "assignee") EQUAL)) "expression")) - (define statement - (choose ((if-s (block #t) #f) - (return-s #t) - (variable-declaration (value+name-type prim-type) expression #f "local variable") - (block #t) - (sequence (stmt-expr SEMI_COLON) id)) "statement")) + (define (statement-c interact?) + (if interact? + (choose ((if-s (block #t) #f) + (return-s #t) + (assignment + (choose (identifier + (sequence (unique-base (repeat unique-end) field-access-end) id)) + "assignee") EQUAL) + (block #t)) "statement") + (choose ((if-s (block #t) #f) + (return-s #t) + (block #t) + (variable-declaration (value+name-type prim-type) expression #f "local variable") + (sequence (stmt-expr SEMI_COLON) id)) "statement"))) + + (define statement (statement-c #f)) (define field (make-field #f (value+name-type prim-type) expression #t)) @@ -767,6 +776,9 @@ (make-program #f (repeat-greedy import-dec) (repeat-greedy (choose (class interface) "class or interface")))) + (define interact + (choose (field (statement-c #t) expression) "interactive program")) + ) (define-unit intermediate+access-grammar@ @@ -809,12 +821,23 @@ "assignee") EQUAL)) "expression")) - (define statement - (choose ((if-s (block #t) #f) - (return-s #t) - (variable-declaration (value+name-type prim-type) expression #f "local variable") - (block #t) - (sequence (stmt-expr SEMI_COLON) id)) "statement")) + (define (statement-c interact?) + (if (not interact?) + (choose ((if-s (block #t) #f) + (return-s #t) + (variable-declaration (value+name-type prim-type) expression #f "local variable") + (block #t) + (sequence (stmt-expr SEMI_COLON) id)) "statement") + (choose ((if-s (block #t) #f) + (return-s #t) + (assignment + (choose (identifier + (sequence (unique-base (repeat unique-end) field-access-end) id)) + "assignee") + EQUAL) + (block #t)) "statement"))) + + (define statement (statement-c #f)) (define field (make-field access-mods (value+name-type prim-type) expression #t)) @@ -847,6 +870,8 @@ (define program (make-program #f (repeat-greedy import-dec) (repeat-greedy (top-member (list class interface))))) + + (define interact (choose (field expression (statement-c #t)) "interactive program")) ) @@ -901,20 +926,41 @@ (sequence (++ expression) id "unary mutation") (sequence (-- expression) id "unary mutation")) "expression")) - (define statement - (choose ((if-s #t (eta statement)) - (return-s #t) - (variable-declaration (array-type (value+name-type prim-type)) expression #t "local variable") - (block #t) - (sequence (stmt-expr SEMI_COLON) id) - (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t "for loop variable") - (comma-sep stmt-expr "initializations")) "for loop initialization") - #t #t - (comma-sep stmt-expr "for loop increments") #t (block #t)) - (while-l (block #t)) - (do-while (block #t)) - (break-s #f) - (cont-s #f)) "statement")) + (define (statement-c interact?) + (if interact? + (choose ((if-s #t (eta statement)) + (return-s #t) + (block #t) + (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t "for loop variable") + (comma-sep stmt-expr "initializations")) "for loop initialization") + #t #t + (comma-sep stmt-expr "for loop increments") #t (block #t)) + (while-l (block #t)) + (do-while (block #t)) + (break-s #f) + (cont-s #f) + (assignment + (choose (identifier + (sequence (unique-base (repeat unique-end) field-access-end) id) + (sequence (unique-base (repeat unique-end) array-access-end) id)) + "asignee") + assignment-ops) + ) "statement") + (choose ((if-s #t (eta statement)) + (return-s #t) + (variable-declaration (array-type (value+name-type prim-type)) expression #t "local variable") + (block #t) + (sequence (stmt-expr SEMI_COLON) id) + (for-l (choose ((variable-declaration (array-type (value+name-type prim-type)) expression #t "for loop variable") + (comma-sep stmt-expr "initializations")) "for loop initialization") + #t #t + (comma-sep stmt-expr "for loop increments") #t (block #t)) + (while-l (block #t)) + (do-while (block #t)) + (break-s #f) + (cont-s #f)) "statement"))) + + (define statement (statement-c #f)) (define field (make-field (global-mods access-mods) (array-type (value+name-type prim-type)) expression #t)) @@ -953,6 +999,10 @@ (make-program (sequence (tok:package name SEMI_COLON) id "package specification") (repeat-greedy import-dec) (repeat-greedy (top-member (list class interface))))) + + (define interact + (choose (field expression (statement-c #t)) "interactive program")) + ) (define-unit token@ @@ -1001,7 +1051,7 @@ (define-unit interactions-parsers@ (import language-forms^ combinator-parser^) (export parsers^) - (define parse-program (parser (choose (expression statement field) "interactions program")))) + (define parse-program (parser interact))) ; (define-unit full-program-parsers@ @@ -1043,7 +1093,7 @@ (import) (export error-format-parameters^) (define src? #t) - (define input-type "definitions window") + (define input-type "Definitions") (define show-options #f) (define max-depth 1) (define max-choice-depth 3)) @@ -1052,7 +1102,7 @@ (import) (export error-format-parameters^) (define src? #t) - (define input-type "interactions-window") + (define input-type "Interactions") (define show-options #f) (define max-depth 0) (define max-choice-depth 3))