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

Correction to error highlighting, and tweaks to grammar

Browse Source 
svn: r7031
This commit is contained in:
Kathy Gray 2007-08-06 14:18:09 +00:00
parent 39d78f3fbf
commit aa871e90bd
3 changed files with 113 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -17,7 +17,10 @@
(define (parser start) (define (parser start)
(lambda (input file) (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 [out
(cond (cond
[(and (res? result) (res-a result) (null? (res-rest result))) [(and (res? result) (res-a result) (null? (res-rest result)))

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

@ -464,25 +464,33 @@
(repeat-res-stop rest-ans)))] (repeat-res-stop rest-ans)))]
[(pair? rest-ans) [(pair? rest-ans)
(map (lambda (r) (process-rest curr-ans r)) rest-ans)] (map (lambda (r) (process-rest curr-ans r)) rest-ans)]
[else (error 'here4)]))]) [else (error 'here4)]))]
(opt-lambda (input [last-src (list 1 0 1 0)] [alts 1]) [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 (cond
[(eq? input return-name) repeat-name] [(eq? input return-name) repeat-name]
[(hash-table-get memo-table input #f) (hash-table-get memo-table input)] [(hash-table-get memo-table input #f) (hash-table-get memo-table input)]
[else [else
(let ([ans (let ([ans
(let loop ([curr-input input]) (let loop ([curr-input input][curr-src start-src])
(cond (cond
[(null? curr-input) [(null? curr-input)
(make-repeat-res (make-res null null repeat-name "" 0 #f #f) 'out-of-input)] (make-repeat-res (make-res null null repeat-name "" 0 #f #f) 'out-of-input)]
[else [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" #;(printf "Repeat of ~a called it's repeated entity: ~n"
repeat-name #;this-res) repeat-name #;this-res)
(cond (cond
[(and (res? this-res) (res-a this-res)) [(and (res? this-res) (res-a this-res))
#;(printf "loop again case~n") #;(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) [(res? this-res)
#;(printf "fail for error case ~a~n" (fail-type? (res-msg 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) (make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f)
@ -494,7 +502,9 @@
#;(printf "repeat call, choice-res ~a~n" #;(printf "repeat call, choice-res ~a~n"
(and (choice-res? this-res) (and (choice-res? this-res)
(length (choice-res-matches 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) (if (choice-res? this-res)
(choice-res-matches this-res) (choice-res-matches this-res)
this-res))] this-res))]
@ -588,6 +598,13 @@
[(null? in) [(null? in)
(values correct incorrect)]))) (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) (define (update-src-start src new-start)
(list (position-line new-start) (list (position-line new-start)
(position-col new-start) (position-col new-start)

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

@ -8,7 +8,7 @@
(lib "string.ss")) (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)) (define-signature token-proc^ (old-tokens->new))
@ -206,13 +206,9 @@
(choice (list base-t voidT) "method return")) (choice (list base-t voidT) "method return"))
(define (array-type base-t) (define (array-type base-t)
(choose (base-t (sequence (base-t (repeat (sequence (O_BRACKET C_BRACKET) id "array type"))) "type"))
(sequence (base-t O_BRACKET C_BRACKET
(repeat-greedy
(sequence (O_BRACKET C_BRACKET) id "array type")))
id "type")) "type"))
)
)
(define-unit mods@ (define-unit mods@
(import combinator-parser^ java-definition-keywords^) (import combinator-parser^ java-definition-keywords^)
@ -686,6 +682,9 @@
(define program (define program
(make-program #f (repeat-greedy import-dec) (make-program #f (repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface))))) (repeat-greedy (top-member (list class interface)))))
(define interact
(choose (field statement expression) "interactive program"))
) )
(define-unit intermediate-grammar@ (define-unit intermediate-grammar@
@ -728,12 +727,22 @@
"assignee") "assignee")
EQUAL)) "expression")) EQUAL)) "expression"))
(define statement (define (statement-c interact?)
(choose ((if-s (block #t) #f) (if interact?
(return-s #t) (choose ((if-s (block #t) #f)
(variable-declaration (value+name-type prim-type) expression #f "local variable") (return-s #t)
(block #t) (assignment
(sequence (stmt-expr SEMI_COLON) id)) "statement")) (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)) (define field (make-field #f (value+name-type prim-type) expression #t))
@ -767,6 +776,9 @@
(make-program #f (repeat-greedy import-dec) (make-program #f (repeat-greedy import-dec)
(repeat-greedy (choose (class interface) "class or interface")))) (repeat-greedy (choose (class interface) "class or interface"))))
(define interact
(choose (field (statement-c #t) expression) "interactive program"))
) )
(define-unit intermediate+access-grammar@ (define-unit intermediate+access-grammar@
@ -809,12 +821,23 @@
"assignee") "assignee")
EQUAL)) "expression")) EQUAL)) "expression"))
(define statement (define (statement-c interact?)
(choose ((if-s (block #t) #f) (if (not interact?)
(return-s #t) (choose ((if-s (block #t) #f)
(variable-declaration (value+name-type prim-type) expression #f "local variable") (return-s #t)
(block #t) (variable-declaration (value+name-type prim-type) expression #f "local variable")
(sequence (stmt-expr SEMI_COLON) id)) "statement")) (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)) (define field (make-field access-mods (value+name-type prim-type) expression #t))
@ -847,6 +870,8 @@
(define program (define program
(make-program #f (repeat-greedy import-dec) (make-program #f (repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface))))) (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")
(sequence (-- expression) id "unary mutation")) "expression")) (sequence (-- expression) id "unary mutation")) "expression"))
(define statement (define (statement-c interact?)
(choose ((if-s #t (eta statement)) (if interact?
(return-s #t) (choose ((if-s #t (eta statement))
(variable-declaration (array-type (value+name-type prim-type)) expression #t "local variable") (return-s #t)
(block #t) (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")
(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")
(comma-sep stmt-expr "initializations")) "for loop initialization") #t #t
#t #t (comma-sep stmt-expr "for loop increments") #t (block #t))
(comma-sep stmt-expr "for loop increments") #t (block #t)) (while-l (block #t))
(while-l (block #t)) (do-while (block #t))
(do-while (block #t)) (break-s #f)
(break-s #f) (cont-s #f)
(cont-s #f)) "statement")) (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)) (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") (make-program (sequence (tok:package name SEMI_COLON) id "package specification")
(repeat-greedy import-dec) (repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface))))) (repeat-greedy (top-member (list class interface)))))
(define interact
(choose (field expression (statement-c #t)) "interactive program"))
) )
(define-unit token@ (define-unit token@
@ -1001,7 +1051,7 @@
(define-unit interactions-parsers@ (define-unit interactions-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-program (parser interact)))
; (define-unit full-program-parsers@ ; (define-unit full-program-parsers@
@ -1043,7 +1093,7 @@
(import) (import)
(export error-format-parameters^) (export error-format-parameters^)
(define src? #t) (define src? #t)
(define input-type "definitions window") (define input-type "Definitions")
(define show-options #f) (define show-options #f)
(define max-depth 1) (define max-depth 1)
(define max-choice-depth 3)) (define max-choice-depth 3))
@ -1052,7 +1102,7 @@
(import) (import)
(export error-format-parameters^) (export error-format-parameters^)
(define src? #t) (define src? #t)
(define input-type "interactions-window") (define input-type "Interactions")
(define show-options #f) (define show-options #f)
(define max-depth 0) (define max-depth 0)
(define max-choice-depth 3)) (define max-choice-depth 3))