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

Correction to using public/private in int+acc

Browse Source 
svn: r7100
This commit is contained in:
Kathy Gray 2007-08-14 19:50:34 +00:00
parent a672ccf4d0
commit 49f08fb06a
4 changed files with 34 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/profj/check.ss
View File

@ -1457,7 +1457,7 @@
(expr-src exp) (expr-src exp)
type-recs type-recs
c-class c-class
env level static?))) env level static? interact?)))
((inner-alloc? exp) ((inner-alloc? exp)
(set-expr-type exp (set-expr-type exp
(check-inner-alloc exp (check-inner-alloc exp
@ -2315,8 +2315,8 @@
;; 15.9 ;; 15.9
;;check-class-alloc: expr (U name identifier) (list exp) (exp env -> type/env) src type-records ;;check-class-alloc: expr (U name identifier) (list exp) (exp env -> type/env) src type-records
; (list string) env symbol bool-> type/env ; (list string) env symbol bool bool-> type/env
(define (check-class-alloc exp name/def arg-exps check-e src type-recs c-class env level static?) (define (check-class-alloc exp name/def arg-exps check-e src type-recs c-class env level static? interact?)
(let* ((args/env (check-args arg-exps check-e env)) (let* ((args/env (check-args arg-exps check-e env))
(args (car args/env)) (args (car args/env))
(name (cond (name (cond
@ -2387,7 +2387,7 @@
(unless (lookup-exn thrown env type-recs level) (unless (lookup-exn thrown env type-recs level)
(ctor-throws-error (ref-type-class/iface thrown) type src))) (ctor-throws-error (ref-type-class/iface thrown) type src)))
(method-record-throws const))) (method-record-throws const)))
(when (and (memq 'private mods) (not (eq? class-record this))) (when (and (memq 'private mods) (or interact? (not (eq? class-record this))))
(class-access-error 'pri level type src)) (class-access-error 'pri level type src))
(when (and (memq 'protected mods) (or (not (is-eq-subclass? this type type-recs)) (when (and (memq 'protected mods) (or (not (is-eq-subclass? this type type-recs))
(not (package-members? c-class (cons (ref-type-class/iface type) (not (package-members? c-class (cons (ref-type-class/iface type)
@ -3346,7 +3346,7 @@
((pro) ((pro)
(format "method ~a from ~a may only be called by ~a, a subclass, or package member of ~a" (format "method ~a from ~a may only be called by ~a, a subclass, or package member of ~a"
n t t t)) n t t t))
((pri) (format "~a does not contain a method named ~a" t n)) ((pri) (format "~a does not contain a visible method named ~a" t n))
((pac) (format "method ~a from ~a may only be called by ~a or a package member of ~a" ((pac) (format "method ~a from ~a may only be called by ~a or a package member of ~a"
n t t t)))) n t t t))))
n src))) n src)))

4
collects/profj/libs/java/runtime.scm
View File

@ -187,7 +187,7 @@
(send val check-ref-type type dim))) (send val check-ref-type type dim)))
;nullError: symbol -> void ;nullError: symbol -> void
(define (nullError kind) (define (nullError kind marks)
(raise (raise
(create-java-exception NullPointerException (create-java-exception NullPointerException
(case kind (case kind
@ -197,7 +197,7 @@
"This value cannot retrieve a field as it is null and therefore has no fields")) "This value cannot retrieve a field as it is null and therefore has no fields"))
(lambda (exn msg) (lambda (exn msg)
(send exn NullPointerException-constructor-java.lang.String msg)) (send exn NullPointerException-constructor-java.lang.String msg))
(current-continuation-marks)))) marks #;(current-continuation-marks))))
(define in-check-mutate? (make-parameter #f)) (define in-check-mutate? (make-parameter #f))
(define stored-checks (make-parameter null)) (define stored-checks (make-parameter null))

19
collects/profj/parsers/intermediate-access-parser.ss
View File

@ -225,7 +225,7 @@
(VariableDeclaratorId (VariableDeclaratorId
[(IDENTIFIER) [(IDENTIFIER)
(make-var-decl (make-id $1 (build-src 1)) (make-var-decl (make-id $1 (build-src 1))
(list (make-modifier 'public #f)) null
(make-type-spec #f 0 (build-src 1)) #f (build-src 1))]) (make-type-spec #f 0 (build-src 1)) #f (build-src 1))])
(VariableInitializer (VariableInitializer
@ -245,16 +245,17 @@
(build-src 2))]) (build-src 2))])
(MethodHeader (MethodHeader
[(Modifiers Type MethodDeclarator) (construct-method-header (cons (make-modifier 'public #f) $1) null $2 $3 null)] [(Modifiers Type MethodDeclarator)
(construct-method-header $1 null $2 $3 null)]
[(Modifiers void MethodDeclarator) [(Modifiers void MethodDeclarator)
(construct-method-header (cons (make-modifier 'public #f) $1) (construct-method-header $1
null null
(make-type-spec 'void 0 (build-src 2 2)) (make-type-spec 'void 0 (build-src 2 2))
$3 $3
null)] null)]
[(Type MethodDeclarator) (construct-method-header (list (make-modifier 'public #f)) null $1 $2 null)] [(Type MethodDeclarator) (construct-method-header null null $1 $2 null)]
[(void MethodDeclarator) [(void MethodDeclarator)
(construct-method-header (list (make-modifier 'public #f)) (construct-method-header null
null null
(make-type-spec 'void 0 (build-src 1 1)) (make-type-spec 'void 0 (build-src 1 1))
$2 $2
@ -280,9 +281,13 @@
(ConstructorDeclaration (ConstructorDeclaration
[(ConstructorDeclarator ConstructorBody) [(ConstructorDeclarator ConstructorBody)
(make-method (list (make-modifier 'public #f)) (make-method null
(make-type-spec 'ctor 0 (build-src 2)) null (car $1) (make-type-spec 'ctor 0 (build-src 2)) null (car $1)
(cadr $1) null $2 #f #f (build-src 2))]) (cadr $1) null $2 #f #f (build-src 2))]
[(Modifiers ConstructorDeclarator ConstructorBody)
(make-method $1
(make-type-spec 'ctor 0 (build-src 3)) null (car $2)
(cadr $2) null $3 #f #f (build-src 3))])
(ConstructorDeclarator (ConstructorDeclarator
[(IDENTIFIER O_PAREN FormalParameterList C_PAREN) (list (make-id $1 (build-src 1)) (reverse $3))] [(IDENTIFIER O_PAREN FormalParameterList C_PAREN) (list (make-id $1 (build-src 1)) (reverse $3))]

21
collects/profj/to-scheme.ss
View File

@ -2483,7 +2483,8 @@
(make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src)) (make-syntax #f `(send ,expr ,(translate-id field-string field-src)) (build-src src))
(make-syntax #f (make-syntax #f
`(if (null? ,expr) `(if (null? ,expr)
(javaRuntime:nullError 'field) ,(create-syntax #f '(javaRuntime:nullError 'field (current-continuation-marks))
expr)
(send ,expr ,(translate-id field-string field-src))) (send ,expr ,(translate-id field-string field-src)))
(build-src src)))) (build-src src))))
((and (eq? (var-access-access access) 'private) #;(or (static-method) (inner-class))) ((and (eq? (var-access-access access) 'private) #;(or (static-method) (inner-class)))
@ -2492,7 +2493,10 @@
(get-syntax (if cant-be-null? (get-syntax (if cant-be-null?
(make-syntax #f getter (build-src src)) (make-syntax #f getter (build-src src))
(make-syntax #f `(if (null? ,expr) (make-syntax #f `(if (null? ,expr)
(javaRuntime:nullError 'field) ,(create-syntax
#f
'(javaRuntime:nullError 'field (current-continuation-marks))
expr)
,getter) ,getter)
(build-src src))))) (build-src src)))))
(if (dynamic-val? type) (if (dynamic-val? type)
@ -2519,7 +2523,8 @@
(make-syntax #f (make-syntax #f
`(let ([val~1 ,expr]) `(let ([val~1 ,expr])
(if (null? val~1) (if (null? val~1)
(javaRuntime:nullError 'field) ,(create-syntax #f '(javaRuntime:nullError 'field (current-continuation-marks))
expr)
(,id val~1))) (,id val~1)))
(build-src src))))) (build-src src)))))
(if (dynamic-val? type) (if (dynamic-val? type)
@ -2585,7 +2590,8 @@
(else (else
`(let ((,unique-name ,expression)) `(let ((,unique-name ,expression))
(if (null? ,unique-name) (if (null? ,unique-name)
(javaRuntime:nullError 'method) ,(create-syntax #f '(javaRuntime:nullError 'method (current-continuation-marks))
expression)
(send-generic ,unique-name ,generic-c-name ,@args))))) (send-generic ,unique-name ,generic-c-name ,@args)))))
(build-src src)) (build-src src))
@ -2594,7 +2600,8 @@
(create-syntax #f (create-syntax #f
`(let ((,unique-name ,expression)) `(let ((,unique-name ,expression))
(if (null? ,unique-name) (if (null? ,unique-name)
,(create-syntax #f `(javaRuntime:nullError 'method) expression) ,(create-syntax #f `(javaRuntime:nullError 'method (current-continuation-marks))
expression)
(send ,unique-name ,c-name ,@translated-args))) (send ,unique-name ,c-name ,@translated-args)))
(build-src src))))) (build-src src)))))
@ -2668,7 +2675,9 @@
(create-syntax #f (create-syntax #f
`(let ((,unique-name ,expression)) `(let ((,unique-name ,expression))
(if (null? ,unique-name) (if (null? ,unique-name)
(javaRuntime:nullError 'method) (javaRuntime:nullError 'method
,(create-syntax #f
'(current-continuation-marks) expression))
(send ,unique-name ,name ,@translated-args))) (send ,unique-name ,name ,@translated-args)))
(build-src src)))))) (build-src src))))))
(if (or (method-contract? method-record) (if (or (method-contract? method-record)