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

Corrected errors in grammar, and in error selection

Browse Source 
svn: r6982
This commit is contained in:
Kathy Gray 2007-07-29 19:57:18 +00:00
parent a25a288870
commit 28a87853fa
4 changed files with 81 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -51,7 +51,7 @@
(position-token-end-pos token)))
build)])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
(opt-lambda (input [last-src (list 1 0 1 0)] [alts 1])
#;(!!! (printf "terminal ~a~n" name))
#;(!!! (printf "input ~a~n" (cons? input)))
#;(!!! (if (eq? input return-name)
@ -118,7 +118,7 @@
[else (!!! (printf "~a~n" r)) (error 'stop1)]))]
[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])
(opt-lambda (input [last-src (list 1 0 1 0)] [alts 1])
#;(!!! (printf "seq ~a~n" name))
(cond
[(eq? input return-name) name]
@ -234,7 +234,7 @@
(res-msg (repeat-res-a res)) #f
(res-first-tok (repeat-res-a res))
new-alts)]
[else (!!! (printf "~a~n" res))(error 'stop) ])) lst)]
[else (!!! (printf "~a~n" res))(error 'stop) ])) (correct-list lst))]
[(correct-rsts) (correct-list rsts)])
#;(printf "rsts =~a~n" rsts)
#;(printf "correct-rsts ~a~n" (map res-a correct-rsts))
@ -395,7 +395,7 @@
[(pair? rest-ans)
(map (lambda (r) (process-rest curr-ans r)) rest-ans)]
[else (error 'here4)]))])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
(opt-lambda (input [last-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)]
@ -494,7 +494,9 @@
(fourth src))))
(define (update-src-end src new-end)
(list (first src) (second src) (third src)
(list (max (first src) 1)
(second src)
(max (third src) 1)
(- (position-offset new-end) (third src))))
(define (repeat op)

6
collects/combinator-parser/private-combinator/structs.scm
View File

@ -22,7 +22,7 @@
;(make-sequence-fail float fail-src string symbol (list string) string 'a boolean string)
(define-struct (sequence-fail fail-type) (id kind correct expected found repeat? last-seen))
;(make-choice-fail float fail-src string int (list string) (list fail-type) boolean)
(define-struct (choice-fail fail-type) (options names messages ended?) (make-inspector))
(define-struct (choice-fail fail-type) (options names ended? messages) (make-inspector))
;(make-options-fail float #f #f (list fail-type))
(define-struct (options-fail fail-type) (opts))
@ -53,8 +53,8 @@
(make-choice-fail chance src name used may-use
(!!! (choice-fail-options fail))
(!!! (choice-fail-names fail))
(map !!!-fail (!!! (choice-fail-messages fail)))
(!!! (choice-fail-ended? fail)))]
(!!! (choice-fail-ended? fail))
(map !!!-fail (!!! (choice-fail-messages fail))))]
[(options-fail? fail)
(make-options-fail chance src name used may-use
(map !!!-fail (!!! (options-fail-opts fail))))]

70
collects/profj/check.ss
View File

@ -37,16 +37,16 @@
;;Environment variable properties
;;(make-properties bool bool bool bool bool bool)
(define-struct properties (parm? field? static? settable? final? usable?))
(define parm (make-properties #t #f #f #t #f #t))
(define final-parm (make-properties #t #f #f #f #t #t))
(define method-var (make-properties #f #f #f #t #f #t))
(define final-method-var (make-properties #f #f #f #f #t #t))
(define obj-field (make-properties #f #t #f #t #f #t))
(define (final-field settable) (make-properties #f #t #f settable #t #t))
(define class-field (make-properties #f #t #t #f #t #t))
(define (final-class-field settable) (make-properties #f #t #t settable #t #t))
(define inherited-conflict (make-properties #f #t #f #f #f #f))
(define-struct properties (parm? field? static? settable? final? usable? set?) (make-inspector))
(define parm (make-properties #t #f #f #t #f #t #t))
(define final-parm (make-properties #t #f #f #f #t #t #t))
(define method-var (make-properties #f #f #f #t #f #t #f))
(define final-method-var (make-properties #f #f #f #f #t #t #f))
(define (obj-field set?) (make-properties #f #t #f #t #f #t set?))
(define (final-field settable) (make-properties #f #t #f settable #t #t #f))
(define (class-field set?) (make-properties #f #t #t #f #t #t set?))
(define (final-class-field settable) (make-properties #f #t #t settable #t #t #f))
(define inherited-conflict (make-properties #f #t #f #f #f #f #f))
;; add-var-to-env: string type properties env -> env
(define (add-var-to-env name type properties env)
@ -65,6 +65,16 @@
(car env)
(lookup (cdr env)))))))
(lookup (environment-types env))))
(define (lookup-field-in-env name env)
(letrec ([lookup
(lambda (env)
(and (not (null? env))
(if (and (string=? name (var-type-var (car env)))
(properties-field? (var-type-properties (car env))))
(car env)
(lookup (cdr env)))))])
(lookup (environment-types env))))
;lookup-specific-this: name env symbol type-records -> bool
(define (lookup-enclosing-this name env level type-recs)
@ -429,7 +439,7 @@
(define (tested-not-found test class src)
(raise-error
'tests
(format "test ~a does not test class ~a, as the class cannot be found."
(format "test ~a cannot test class ~a, as the class cannot be found."
(id->ext-name test) (path->ext (name->path class)))
'tests src))
@ -492,10 +502,10 @@
(set! setting-fields (cons member setting-fields))))
(if static?
(loop (cdr rest)
(add-var-to-env name type class-field statics)
(add-var-to-env name type class-field fields))
(add-var-to-env name type (class-field (var-init? member)) statics)
(add-var-to-env name type (class-field (var-init? member)) fields))
(loop (cdr rest) statics
(add-var-to-env name type obj-field fields)))))
(add-var-to-env name type (obj-field #f #;(var-init? member)) fields)))))
((def? member)
(check-inner-def member level type-recs c-class field-env)
(loop (cdr rest) statics fields))
@ -533,9 +543,9 @@
(field-record-type field)
(cond
((and in-env? (not current?)) inherited-conflict)
((and (not static?) (not final?)) obj-field)
((and (not static?) (not final?)) (obj-field #f))
((and (not static?) final?) (final-field current?))
((and static? (not final?)) class-field)
((and static? (not final?)) (class-field #f))
((and static? final?) (final-class-field current?)))
(create-field-env (cdr fields) env class))))))
@ -1726,6 +1736,23 @@
(special-name? obj)
(not (lookup-var-in-env fname env)))
(access-before-define (string->symbol fname) src))
(when (and (eq? 'beginner level)
assign-left?
(special-name? obj)
(properties-set? (var-type-properties (lookup-field-in-env fname env))))
(assign-twice (string->symbol fname) src))
(when (and (eq? 'beginner level)
assign-left?
(special-name? obj))
(set-properties-set?! (var-type-properties (lookup-field-in-env fname env)) #t))
(when (and (eq? 'beginner level)
(special-name? obj)
(not (properties-set? (var-type-properties (lookup-field-in-env fname env)))))
(access-before-assign (string->symbol fname) src))
(when (and (field-access-access acc)
(var-access-static? (field-access-access acc)))
@ -3007,6 +3034,17 @@
(format "Field ~a cannot be accessed before its declaration." name)
name src))
;assign-twice: symbol src -> void
(define (assign-twice name src)
(raise-error name
(format "Field ~a has been initialized and cannot be initialized again." name)
name src))
(define (access-before-assign name src)
(raise-error name
(format "Field ~a cannot be accessed before it is initialized." name)
name src))
;not-static-field-access-error symbol symbol src -> void
(define (not-static-field-access-error name level src)
(raise-error

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

@ -206,9 +206,11 @@
(choice (list base-t voidT) "method return"))
(define (array-type base-t)
(choice (base-t (sequence (base-t O_BRACKET C_BRACKET
(repeat (sequence (O_BRACKET C_BRACKET) id))) id
"array type")) "type"))
(choose (base-t
(sequence (base-t O_BRACKET C_BRACKET
(repeat-greedy
(sequence (O_BRACKET C_BRACKET) id "array type")))
id "type")) "type"))
)
@ -265,7 +267,7 @@
(export general-productions^)
(define (comma-sep term name)
(sequence (term (repeat (sequence (COMMA term) id))) id (string-append "a list of " name)))
(sequence (term (repeat-greedy (sequence (COMMA term) id))) id (string-append "a list of " name)))
(define (variable-declaration type expr share-type? name)
(let* ([f (choose (IDENTIFIER (sequence ((^ IDENTIFIER) EQUAL expr) id)) (string-append name " declaration"))]
@ -682,7 +684,7 @@
(repeat-greedy (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec) (repeat-greedy (top-member (list class interface)))))
(make-program #f (repeat-greedy import-dec) (repeat-greedy (top-member (list class interface)))))
)
(define-unit intermediate-grammar@
@ -740,7 +742,7 @@
(method-signature tok:abstract (method-type (value+name-type prim-type)) args #f identifier))
(define method
(choose ((make-method method-sig-no-abs statement)
(choose ((make-method method-sig-no-abs (repeat-greedy statement))
(method-header method-sig-abs)) "method definition"))
(define constructor
@ -761,7 +763,7 @@
(define program
(make-program #f (repeat import-dec) (repeat-greedy (top-member (list class interface)))))
(make-program #f (repeat-greedy import-dec) (repeat-greedy (top-member (list class interface)))))
)
@ -841,7 +843,7 @@
(repeat-greedy (class-body (list field method constructor)))))
(define program
(make-program #f (repeat import-dec)
(make-program #f (repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface)))))
)
@ -891,7 +893,7 @@
(sequence (unique-base (repeat unique-end) field-access-end) id)
(sequence (unique-base (repeat unique-end) array-access-end) id))
"asignee")
assignment-ops expression)
assignment-ops)
(sequence (expression ++) id "unary mutation")
(sequence (expression --) id "unary mutation")
(sequence (++ expression) id "unary mutation")
@ -900,10 +902,10 @@
(define statement
(choose ((if-s #t (eta statement))
(return-s #t)
(variable-declaration (value+name-type prim-type) expression #t "local variable")
(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 (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")
#t #t
(comma-sep stmt-expr "for loop increments") #t (block #t))
@ -912,14 +914,14 @@
(break-s #f)
(cont-s #f)) "statement"))
(define field (make-field (global-mods access-mods) (value+name-type prim-type) expression #t))
(define field (make-field (global-mods access-mods) (array-type (value+name-type prim-type)) expression #t))
(define method-sig-no-abs
(method-signature (global-mods access-mods)
(method-type (value+name-type prim-type)) args #f IDENTIFIER))
(method-type (array-type (value+name-type prim-type))) args #f IDENTIFIER))
(define method-sig-abs
(method-signature (method-mods (global-mods access-mods))
(method-type (value+name-type prim-type)) args #f IDENTIFIER))
(method-type (array-type (value+name-type prim-type))) args #f IDENTIFIER))
(define method
(choose ((make-method method-sig-no-abs statement)
@ -947,7 +949,7 @@
(define program
(make-program (sequence (tok:package name SEMI_COLON) id "package specification")
(repeat import-dec)
(repeat-greedy import-dec)
(repeat-greedy (top-member (list class interface)))))
)