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

Corrections to parsing errors and String library

Browse Source 
svn: r1342
This commit is contained in:
Kathy Gray 2005-11-17 22:42:38 +00:00
parent 816a172e8d
commit 2df0524b8a
4 changed files with 73 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/profj/build-info.ss
View File

@ -854,6 +854,26 @@
;valid-method-sigs? (list method-record) (list member) symbol type-records -> bool
(define (valid-method-sigs? methods members level type-recs)
(or (null? methods)
(and (equal? (method-record-name (car methods))
(method-record-class (car methods)))
(not (eq? (method-record-rtype (car methods)) 'ctor))
(let ((m (find-member (car methods) members level type-recs))
(class (method-record-class (car methods))))
(if (field? m)
(method-error 'inherited-conflict-field
(field-name m)
null
#f
(car class)
(field-src m)
#f)
(method-error 'ctor-ret-value
(method-name m)
(map field-type (method-parms m))
(type-spec-to-type (method-type) #f level type-recs)
(car class)
(method-src m)
#f))))
(let ((res (same-method-name? (car methods) (cdr methods)))
(m (and (not (eq? 'ctor (method-record-rtype (car methods))))
(find-member (car methods) members level type-recs)))
@ -886,26 +906,6 @@
(car class)
(method-src m)
(eq? (method-record-rtype (car methods)) 'ctor)))))
(and (equal? (method-record-name (car methods))
(method-record-class (car methods)))
(not (eq? (method-record-rtype (car methods)) 'ctor))
(let ((m (find-member (car methods) members level type-recs))
(class (method-record-class (car methods))))
(if (field? m)
(method-error 'inherited-conflict-field
(field-name m)
null
#f
(car class)
(field-src m)
#f)
(method-error 'ctor-ret-value
(method-name m)
(map field-type (method-parms m))
(type-spec-to-type (method-type) #f level type-recs)
(car class)
(method-src m)
#f))))
(and (memq level `(beginner intermediate))
(not (eq? (method-record-rtype (car methods)) 'ctor))
(shared-class-name? (car methods) (send type-recs get-class-env))

31
collects/profj/libs/java/lang/Object-composite.ss
View File

@ -674,10 +674,27 @@
(define/public (lastIndexOf-java.lang.String-int str offset) (find-last-string (send str get-mzscheme-string) str offset -1))
;int -> String
(define/public (substring-int index) (make-java-string (substring text index (string-length text))))
(define/public (substring-int index)
(substring-int-int index (sub1 (string-length text))))
;... -> String
(define/public (substring-int-int begin end) (make-java-string (substring text begin end)))
(define/public (substring-int-int begin end)
(when (< begin 0)
(raise (make-runtime-error
(format "First argument to substring must be greater than 0, given ~a." begin))))
(when (>= begin (string-length text))
(raise (make-runtime-error
(format "First argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) begin))))
(when (>= end (string-length text))
(raise (make-runtime-error
(format "Second argument to substring must be smaller than the string's length ~a, given ~a." (string-length text) end))))
(when (< end 0)
(raise (make-runtime-error
(format "Second argument to substring must be greater than 0, given ~a." end))))
(when (> begin end)
(raise (make-runtime-error
(format "First argument to substring must be less than the second, given ~a and ~a." begin end))))
(make-java-string (substring text begin end)))
(define/public (subSequence-int-int begin end)
(error 'subSequence "Internal Error: subsequence is unimplemented because charSequence is unimplemented"))
@ -825,7 +842,7 @@
(send this Object-constructor))
(define/public (Throwable-constructor-java.lang.Throwable cse)
(set! message (if (null? cse) null (send cse |toString|)))
(set! message (if (null? cse) null (send cse toString)))
(set! cause cse)
(set! stack (current-continuation-marks))
(send this Object-constructor))
@ -905,6 +922,14 @@
(send exn set-exception! scheme-exn)
scheme-exn))
(define (make-runtime-error t)
(create-java-exception
RuntimeException (string->immutable-string t)
(lambda (exn str)
(send exn RuntimeException-constructor-java.lang.String
(make-java-string str)))
(current-continuation-marks)))
(provide convert-assert-Throwable wrap-convert-assert-Throwable dynamic-Throwable/c
guard-convert-Throwable static-Throwable/c)

15
collects/profj/parsers/beginner-parser.ss
View File

@ -254,15 +254,6 @@
;; 19.9.1
(InterfaceDeclaration
[(interface IDENTIFIER ExtendsInterfaces InterfaceBody)
(make-interface-def (make-header (make-id $2 (build-src 2 2)) (list (make-modifier 'public #f))
$3 null null (build-src 3))
$4
(build-src 1)
(build-src 4)
(file-path)
'intermedaite
null 'top null)]
[(interface IDENTIFIER InterfaceBody)
(make-interface-def (make-header (make-id $2 (build-src 2 2))(list (make-modifier 'public #f))
null null null (build-src 2))
@ -270,13 +261,9 @@
(build-src 1)
(build-src 3)
(file-path)
'intermdediate
'beginner
null 'top null)])
(ExtendsInterfaces
[(extends InterfaceType) (list $2)]
[(ExtendsInterfaces COMMA InterfaceType) (cons $3 $1)])
(InterfaceBody
[(O_BRACE InterfaceMemberDeclarations C_BRACE) $2])

35
collects/profj/parsers/parse-error.ss
View File

@ -434,11 +434,18 @@
(next-tok (get-tok next)))
(cond
((eof? next-tok) (parse-error (format "Expected interface body after ~a" (token-value tok)) srt end))
((extends? next-tok) (parse-definition next (getter) 'iface-extends getter))
((extends? next-tok)
(if (beginner?)
(parse-error "Expected '{' to begin interface body, found 'extends' which is not allowed here"
(get-start next) (get-end next))
(parse-definition next (getter) 'iface-extends getter)))
((o-brace? next-tok) (parse-definition cur-tok next 'iface-body getter))
((close-to-keyword? next-tok 'extends)
(parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok))
(get-start next) (get-end next)))
(if (beginner?)
(parse-error (format "Expected '{' to begin interface body, ~a cannot appear here" (token-value next-tok))
(get-start next) (get-end next))
(parse-error (format "found ~a, which is similar to 'extends'" (token-value next-tok))
(get-start next) (get-end next))))
((open-separator? next-tok)
(parse-error (format "Expected { to begin interface body, but found ~a" (format-out next-tok))
(get-start next) (get-end next)))
@ -1363,10 +1370,14 @@
cur-tok
(parse-error "A name may not contain a *" start stop)))
(else
(if (java-keyword? tok)
(parse-error (format "Expected variable after ., found reserved word ~a, which may not be a variable" kind)
start stop)
(parse-error (format "Expected variable after . in name, found ~a" (format-out tok)) start stop))))))
(cond
((eq? 'this kind)
(parse-error "'this' cannot occur after a '.', only before" start stop))
((java-keyword? tok)
(parse-error (format "Expected name after '.', found reserved word ~a, which may not appear here" kind)
start stop))
(else
(parse-error (format "Expected name after '.', found ~a" (format-out tok)) start stop)))))))
;parse-ctor-body: token token (->token) -> token
(define (parse-ctor-body pre cur-tok getter)
@ -2064,7 +2075,7 @@
'statement-expr-snd getter ctor? super-seen?))))
(else (parse-error (format "Expected a ')' or a ','. Found ~a which is not allowed" out) start end))))
)))
;parse-expression: token token state (->token) bool bool -> token
(define (parse-expression pre cur-tok state getter statement-ok? stmt-exp?)
;(printf "parse-expression state ~a pre ~a cur-tok ~a statement-ok? ~a stmt-exp? ~a ~n"
@ -2158,9 +2169,11 @@
(parse-expression next (parse-expression afterID (getter) 'start getter #f #f)
'assign-end getter statement-ok? stmt-exp?))
(else (parse-expression next afterID 'dot-op-or-end getter statement-ok? stmt-exp?)))))
((java-keyword? next-tok)
(parse-error (format "Expected a method name, reserved name ~a may not be a method name" name) ns ne))
(else (parse-error (format "Expected a method name, found ~a" (format-out next-tok)) ns ne)))))
((eq? 'this name)
(parse-error "Expected a name, 'this' may not appear after a dot" ns ne))
((java-keyword? next-tok)
(parse-error (format "Expected a name, reserved name ~a may not be a name" name) ns ne))
(else (parse-error (format "Expected a name, found ~a" (format-out next-tok)) ns ne)))))
(stmt-exp? (parse-expression pre cur-tok 'op-or-end getter #f stmt-exp?))
((bin-operator? tok) (parse-expression cur-tok (getter) 'start getter #f stmt-exp?))
;Advanced