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)
(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)))

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

@ -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)

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

@ -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
(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)
(variable-declaration (value+name-type prim-type) expression #f "local variable")
(block #t)
(sequence (stmt-expr SEMI_COLON) id)) "statement"))
(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
(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"))
(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))
@ -848,6 +871,8 @@
(make-program #f (repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface)))))
(define interact (choose (field expression (statement-c #t)) "interactive program"))
)
(define-unit advanced-grammar@
@ -901,7 +926,26 @@
(sequence (++ expression) id "unary mutation")
(sequence (-- expression) id "unary mutation")) "expression"))
(define 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")
@ -914,7 +958,9 @@
(while-l (block #t))
(do-while (block #t))
(break-s #f)
(cont-s #f)) "statement"))
(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))