From cccb5150f06137cde114e5df77862e1e59703c71 Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Tue, 3 Jul 2007 23:02:13 +0000 Subject: [PATCH] Changes to add a language level to ProfJ svn: r6814 --- collects/profj/build-info.ss | 14 +- collects/profj/check.ss | 14 +- collects/profj/compile.ss | 2 +- collects/profj/parser.ss | 3 +- .../parsers/intermediate-access-parser.ss | 626 ++++++++++++++++++ collects/profj/restrictions.ss | 2 +- collects/profj/tool.ss | 15 +- .../english-string-constants.ss | 2 + 8 files changed, 658 insertions(+), 20 deletions(-) create mode 100644 collects/profj/parsers/intermediate-access-parser.ss diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index 2d2d7bf9e9..cf43969dfd 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -251,6 +251,7 @@ (suffix (case (unbox new-level) ((beginner) ".bjava") ((intermediate) ".ijava") + ((intermediate+access) ".iajava") ((advanced) ".ajava") ((full) ".java") ((dynamic-full) ".djava"))) @@ -334,6 +335,7 @@ (exists? ".djava" 'dynamic-full) (exists? ".bjava" 'beginner) (exists? ".ijava" 'intermediate) + (exists? ".iajava" 'intermediate+access) (exists? ".ajava" 'advanced)))) ;check-scheme-file-exists? string path -> bool @@ -370,7 +372,7 @@ (lambda () (let ((original-loc (send type-recs get-location)) (dir (find-directory (cdr name) (lambda () (file-error 'dir (cdr name) call-src level))))) - (when (memq level '(beginner intermediate)) + (when (memq level '(beginner intermediate intermediate+access)) (file-error 'file name call-src level)) (import-class (car name) (cdr name) dir original-loc type-recs level call-src #f) (begin0 (get-record (send type-recs get-class-record name) type-recs) @@ -608,7 +610,7 @@ #;(when (and ctor? (eq? level 'beginner) (memq 'abstract test-mods)) (beginner-ctor-error 'abstract (header-id info) (id-src (header-id info)))) - (valid-field-names? (if (memq level '(beginner intermediate advanced)) + (valid-field-names? (if (memq level '(beginner intermediate intermediate+access advanced)) (append f (class-record-fields super-record)) f) members m level type-recs) (valid-method-sigs? m members level type-recs) @@ -896,7 +898,7 @@ (add-ctor test (lambda (rec) (set! m (cons rec m))) old-methods (header-id info) level)) - (valid-field-names? (if (memq level '(beginner intermediate advanced)) + (valid-field-names? (if (memq level '(beginner intermediate intermediate+access advanced)) (append f (class-record-fields super-record)) f) members m level type-recs) @@ -1044,7 +1046,7 @@ (type-spec-to-type (method-type (car members)) (method-record-class member-record) level type-recs))) (car members) (find-member member-record (cdr members) level type-recs))) - ((memq level '(beginner intermediate advanced)) + ((memq level '(beginner intermediate intermediate+access advanced)) (let ((given-name ((if (field-record? member-record) field-record-name method-record-name) member-record)) (looking-at (id-string ((if (field? (car members)) field-name method-name) (car members))))) (if (equal? given-name looking-at) @@ -1080,7 +1082,7 @@ (m (and (not (eq? 'ctor (method-record-rtype (car methods)))) (find-member (car methods) members level type-recs))) (class (method-record-class (car methods)))) - (and res m (memq level '(beginner intermediate)) + (and res m (memq level '(beginner intermediate intermediate+access)) (not (type=? (method-record-rtype (car methods)) (method-record-rtype res))) (method-error 'bad-ret @@ -1650,6 +1652,7 @@ (case level ((beginner) '(public final)) ((intermediate) '(public)) + ((intermediate+access) '(public protected private)) ((advanced) '(public protected private static)) ((full) `(public protected private static final transient volatile)))) (lambda (x) 'invalid-field))) @@ -1659,6 +1662,7 @@ (case level ((beginner) '(public)) ((intermediate) '(public abstract)) + ((intermediate+access) '(public protected private abstract)) ((advanced) `(public protected private abstract static final)) ((full) '(public protected private abstract static final synchronized native strictfp)) ((abstract) '(public protected abstract)) diff --git a/collects/profj/check.ss b/collects/profj/check.ss index bdb1f95b35..0ba5fa2264 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -1722,7 +1722,7 @@ (and (null? (cdr field-class)) (lookup-local-inner (car field-class) env)))) - (when (and (memq level '(beginner intermediate)) + (when (and (memq level '(beginner intermediate intermediate+access)) (special-name? obj) (not (lookup-var-in-env fname env))) (access-before-define (string->symbol fname) src)) @@ -1819,7 +1819,7 @@ (cons "scheme" (scheme-record-path (car static-class)))))))) (cdr accs)))) - ((and (memq level '(beginner intermediate advanced)) (not first-binding) (> (length acc) 1) + ((and (memq level '(beginner intermediate intermediate+access advanced)) (not first-binding) (> (length acc) 1) (with-handlers ((exn:fail:syntax? (lambda (e) #f))) (type-exists? first-acc null c-class (id-src (car acc)) level type-recs))) (build-field-accesses @@ -2627,7 +2627,7 @@ (instanceof-error 'not-class type exp-type src)) (else (cond - ((memq level '(beginner intermediate)) (instanceof-error 'not-ref type exp-type src)) + ((memq level '(beginner intermediate intermediate+access)) (instanceof-error 'not-ref type exp-type src)) ((and (array-type? exp-type) (array-type? type) (= (array-type-dim exp-type) (array-type-dim type)) (or (assignment-conversion exp-type type type-recs))) 'boolean) @@ -3012,7 +3012,7 @@ (raise-error name (case level - ((beginner intermediate) + ((beginner intermediate intermediate+access) (format "Field ~a cannot be retrieved from a class, ~a can only be accessed from an instance of the class." name name)) ((advanced full) @@ -3074,7 +3074,7 @@ (format "Attempted to call method ~a on ~a which does not have methods. ~nOnly values with ~a types have methods" n t (case level - ((beginner intermediate) "class or interface") + ((beginner intermediate intermediate+access) "class or interface") (else "class, interface, or array")))) n src))) @@ -3125,7 +3125,7 @@ (c (string->symbol class))) (raise-error n (case level - ((beginner intermediate) (format "Attempt to use class or interface ~a as an object to call method ~a" c n)) + ((beginner intermediate intermediate+access) (format "Attempt to use class or interface ~a as an object to call method ~a" c n)) ((advanced) (format "Attempt to use method ~a from class ~a as though it were static" n c))) c src))) @@ -3168,7 +3168,7 @@ (raise-error n (string-append (format "Method ~a cannot be called in the interactions window.~n" n) (format "Only ~a methods or methods on objects may be called here." - (if (memq level '(beginner intermediate)) "certain library" "static"))) + (if (memq level '(beginner intermediate intermediate+access)) "certain library" "static"))) n src))) diff --git a/collects/profj/compile.ss b/collects/profj/compile.ss index 37ff7f4524..a2533cd5bf 100644 --- a/collects/profj/compile.ss +++ b/collects/profj/compile.ss @@ -20,7 +20,7 @@ t)) ;kind = 'file | 'port - ;level = 'beginner | 'intermediate | 'advanced | 'full + ;level = 'beginner | 'intermediate | 'intermediate+access | 'advanced | 'full ;compile: kind kind level (U #f string) (U #f port) (U #f location) -> (U (list compilation-unit) void) (define (compile-java src dest level name port loc . type-recs) diff --git a/collects/profj/parser.ss b/collects/profj/parser.ss index fbf9fecf80..1dc2d3579d 100644 --- a/collects/profj/parser.ss +++ b/collects/profj/parser.ss @@ -2,6 +2,7 @@ (module parser mzscheme (require "parsers/full-parser.ss" "parsers/advanced-parser.ss" + "parsers/intermediate-access-parser.ss" "parsers/intermediate-parser.ss" "parsers/beginner-parser.ss" "parsers/general-parsing.ss" @@ -66,7 +67,7 @@ (parse-intermediate my-get)) ((intermediate+access) (determine-error (error-builder err:parse-intermediate+access (lambda () #t) lexed filename)) - (error)) + (parse-intermediate+access my-get)) ((advanced) (determine-error (error-builder err:parse-advanced find-advanced-error lexed filename)) (parse-advanced my-get)) diff --git a/collects/profj/parsers/intermediate-access-parser.ss b/collects/profj/parsers/intermediate-access-parser.ss new file mode 100644 index 0000000000..80c907852c --- /dev/null +++ b/collects/profj/parsers/intermediate-access-parser.ss @@ -0,0 +1,626 @@ +(module intermediate-access-parser mzscheme + + (require "general-parsing.ss" + "lexer.ss" + "../ast.ss" + "../parameters.ss") + + (require (lib "yacc.ss" "parser-tools") + (all-except (lib "lex.ss" "parser-tools") input-port) + (lib "readerr.ss" "syntax")) + + (require-for-syntax "lexer.ss") + ;(require (lib "build-grammar.ss" "tester")) + + (define-syntax testing-parser + (syntax-rules () + ((_ parse-info ...) (parser parse-info ...)))) + + (provide parse-intermediate+access parse-intermediate+access-interactions + parse-intermediate+access-expression parse-intermediate+access-type) + ;(provide intermediate-grammar) + + + (define parsers + (testing-parser + (start CompilationUnit IntermediateInteractions Expression Type) + ;;(debug "parser.output") + (tokens java-vals special-toks Keywords Separators EmptyLiterals Operators ExtraKeywords) + ;(terminals val-tokens special-tokens keyword-tokens separator-tokens literal-tokens operator-tokens) + (error (lambda (tok-ok name val start-pos end-pos) + (if ((determine-error)) + (raise-read-error (format "Parse error near <~a:~a>" name val) + (file-path) + (position-line start-pos) + (position-col start-pos) + (+ (position-offset start-pos) (interactions-offset)) + (- (position-offset end-pos) + (position-offset start-pos)))))) + + (end EOF) + (src-pos) + + (grammar + + ;; 19.3 + (Literal + [(INTEGER_LIT) (make-literal 'int (build-src 1) $1)] + [(LONG_LIT) (make-literal 'long (build-src 1) $1)] + [(FLOAT_LIT) (make-literal 'float (build-src 1) $1)] + [(DOUBLE_LIT) (make-literal 'double (build-src 1) $1)] + [(TRUE_LIT) (make-literal 'boolean (build-src 1) #t)] + [(FALSE_LIT) (make-literal 'boolean (build-src 1) #f)] + [(CHAR_LIT) (make-literal 'char (build-src 1) $1)] + [(STRING_LIT) (make-literal 'string + (make-src (position-line $1-start-pos) + (position-col $1-start-pos) + (+ (position-offset $1-start-pos) (interactions-offset)) + (- (position-offset (cadr $1)) (position-offset $1-start-pos)) + (file-path)) + (car $1))] + [(NULL_LIT) (make-literal 'null (build-src 1) #f)] + [(IMAGE_SPECIAL) (make-literal 'image (build-src 1) $1)]) + + ;; 19.4 + (Type + [(PrimitiveType) $1] + [(ReferenceType) $1]) + + (PrimitiveType + [(NumericType) $1] + [(boolean) (make-type-spec 'boolean 0 (build-src 1))]) + + (NumericType + [(IntegralType) $1] + [(FloatingPointType) $1]) + + (IntegralType + [(byte) (make-type-spec 'byte 0 (build-src 1))] + [(short) (make-type-spec 'short 0 (build-src 1))] + [(int) (make-type-spec 'int 0 (build-src 1))] + [(long) (make-type-spec 'long 0 (build-src 1))] + [(char) (make-type-spec 'char 0 (build-src 1))]) + + (FloatingPointType + [(float) (make-type-spec 'float 0 (build-src 1))] + [(double) (make-type-spec 'double 0 (build-src 1))]) + + (ReferenceType + ;; GJ - To fix the problem mentioned below + ;; [(ClassOrInterfaceType) #t] + ;; GJ - Some type variables will come out as names, so a post-pass needs + ;; to convert them to type-vars + [(Name) (make-type-spec $1 0 (build-src 1))] + ) + + (ClassOrInterfaceType + [(Name) $1]) + + (ClassType + [(ClassOrInterfaceType) $1]) + + (InterfaceType + [(ClassOrInterfaceType) $1]) + + ;;19.5 + (Name + [(IDENTIFIER) (make-name (make-id $1 (build-src 1)) null (build-src 1))] + [(Name PERIOD IDENTIFIER) + (make-name (make-id $3 (build-src 3 3)) + (append (name-path $1) (list (name-id $1))) + (build-src 3))]) + ;; 19.6 + (CompilationUnit + [(ImportDeclarations TypeDeclarations) (make-package #f (reverse $1) (reverse $2))] + [(TypeDeclarations) (make-package #f null (reverse $1))] + [(ImportDeclarations) (make-package #f (reverse $1) null)] + [() (make-package #f null null)]) + + (ImportDeclarations + [(ImportDeclaration) (list $1)] + [(ImportDeclarations ImportDeclaration) (cons $2 $1)]) + + (ImportDeclaration + [(import Name SEMI_COLON) (make-import $2 #f (build-src 1) (build-src 3) (file-path))] + [(import Name PERIOD * SEMI_COLON) + (make-import $2 #t (build-src 1) (build-src 5) (file-path))]) + + (IntermediateInteractions + [(Statement) $1] + [(Expression) $1] + [(FieldDeclaration) $1] + [() null]) + + (TypeDeclarations + [(TypeDeclaration) (if $1 (list $1) null)] + [(TypeDeclarations TypeDeclaration) (if $2 + (cons $2 $1) + $1)]) + + (TypeDeclaration + [(ClassDeclaration) $1] + [(InterfaceDeclaration) $1] + [(EXAMPLE) $1] + [(TEST_SUITE) $1] + [(SEMI_COLON) #f]) + + ;; 19.7 + (Modifiers + [(Modifier) (list $1)] + [(Modifiers Modifier) (cons $2 $1)]) + + (Modifier + [(public) (make-modifier 'public (build-src 1))] + [(protected) (make-modifier 'protected (build-src 1))] + [(private) (make-modifier 'private (build-src 1))] + [(abstract) (make-modifier 'abstract (build-src 1))]) + + ;; 19.8.1 + (ClassDeclaration + [(Modifiers class IDENTIFIER Super Interfaces ClassBody) + (make-class-def (make-header (make-id $3 (build-src 3 3)) $1 $4 $5 null (build-src 5)) + $6 + (build-src 2 2) + (build-src 6) + (file-path) + 'intermediate+access + null 'top null)] + [(class IDENTIFIER Super Interfaces ClassBody) + (make-class-def (make-header (make-id $2 (build-src 2 2)) null $3 $4 null (build-src 4)) + $5 + (build-src 1) + (build-src 5) + (file-path) + 'intermediate+access + null 'top null)]) + + (Super + [() null] + [(extends ClassType) (list $2)]) + + (Interfaces + [() null] + [(implements InterfaceTypeList) $2]) + + (InterfaceTypeList + [(InterfaceType) (list $1)] + [(InterfaceTypeList COMMA InterfaceType) (cons $3 $1)]) + + (ClassBody + [(O_BRACE ClassBodyDeclarations C_BRACE) (reverse $2)]) + + (ClassBodyDeclarations + [() null] + [(ClassBodyDeclarations ClassBodyDeclaration) + (cond + ((not $2) $1) + ((list? $2) (append $2 $1)) + (else (cons $2 $1)))]) + + (ClassBodyDeclaration + [(ClassMemberDeclaration) $1] + [(ConstructorDeclaration) $1] + [(SEMI_COLON) #f]) + + (ClassMemberDeclaration + [(FieldDeclaration) $1] + [(MethodDeclaration) $1]) + + ;; 19.8.2 + (FieldDeclaration + [(Modifiers Type VariableDeclarators SEMI_COLON) + (map (lambda (d) (build-field-decl $1 $2 d)) (reverse $3))] + [(Type VariableDeclarators SEMI_COLON) + (map (lambda (d) (build-field-decl null $1 d)) (reverse $2))]) + + (VariableDeclarators + [(VariableDeclarator) (list $1)] + [(VariableDeclarators COMMA VariableDeclarator) (cons $3 $1)]) + + (VariableDeclarator + [(VariableDeclaratorId) $1] + [(VariableDeclaratorId = VariableInitializer) + (make-var-init $1 $3 (build-src 3))]) + + (VariableDeclaratorId + [(IDENTIFIER) + (make-var-decl (make-id $1 (build-src 1)) + (list (make-modifier 'public #f)) + (make-type-spec #f 0 (build-src 1)) #f (build-src 1))]) + + (VariableInitializer + [(Expression) $1]) + + ;; 19.8.3 + (MethodDeclaration + [(MethodHeader MethodBody) (make-method (method-modifiers $1) + (method-type $1) + (method-type-parms $1) + (method-name $1) + (method-parms $1) + (method-throws $1) + $2 + #f + #f + (build-src 2))]) + + (MethodHeader + [(Modifiers Type MethodDeclarator) (construct-method-header (cons (make-modifier 'public #f) $1) null $2 $3 null)] + [(Modifiers void MethodDeclarator) + (construct-method-header (cons (make-modifier 'public #f) $1) + null + (make-type-spec 'void 0 (build-src 2 2)) + $3 + null)] + [(Type MethodDeclarator) (construct-method-header (list (make-modifier 'public #f)) null $1 $2 null)] + [(void MethodDeclarator) + (construct-method-header (list (make-modifier 'public #f)) + null + (make-type-spec 'void 0 (build-src 1 1)) + $2 + null)]) + + + (MethodDeclarator + [(IDENTIFIER O_PAREN FormalParameterList C_PAREN) (list (make-id $1 (build-src 1)) (reverse $3) 0)] + [(IDENTIFIER O_PAREN C_PAREN) (list (make-id $1 (build-src 1)) null 0)]) + + (FormalParameterList + [(FormalParameter) (list $1)] + [(FormalParameterList COMMA FormalParameter) (cons $3 $1)]) + + (FormalParameter + [(Type VariableDeclaratorId) (build-field-decl null $1 $2)]) + + (MethodBody + [(Block) $1] + [(SEMI_COLON) #f]) + + ;; 19.8.5 + + (ConstructorDeclaration + [(ConstructorDeclarator ConstructorBody) + (make-method (list (make-modifier 'public #f)) + (make-type-spec 'ctor 0 (build-src 2)) null (car $1) + (cadr $1) null $2 #f #f (build-src 2))]) + + (ConstructorDeclarator + [(IDENTIFIER O_PAREN FormalParameterList C_PAREN) (list (make-id $1 (build-src 1)) (reverse $3))] + [(IDENTIFIER O_PAREN C_PAREN) (list (make-id $1 (build-src 1)) null)]) + + (ConstructorBody + [(O_BRACE ExplicitConstructorInvocation BlockStatements C_BRACE) + (make-block (cons $2 (reverse $3)) (build-src 4))] + [(O_BRACE ExplicitConstructorInvocation C_BRACE) + (make-block (list $2) (build-src 3))] + [(O_BRACE BlockStatements C_BRACE) + (make-block + (cons (make-call #f (build-src 3) #f (make-special-name #f #f "super") null #f) + (reverse $2)) + (build-src 3))] + [(O_BRACE C_BRACE) + (make-block + (list (make-call #f (build-src 2) + #f (make-special-name #f #f "super") null #f)) + (build-src 2))]) + + (ExplicitConstructorInvocation + [(super O_PAREN ArgumentList C_PAREN SEMI_COLON) + (make-call #f (build-src 5) + #f (make-special-name #f (build-src 1) "super") (reverse $3) #f)] + [(super O_PAREN C_PAREN SEMI_COLON) + (make-call #f (build-src 4) + #f (make-special-name #f (build-src 1) "super") null #f)]) + + ;; 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)) + $3 + (build-src 1) + (build-src 3) + (file-path) + 'intermdediate + null 'top null)]) + + (ExtendsInterfaces + [(extends InterfaceType) (list $2)] + [(ExtendsInterfaces COMMA InterfaceType) (cons $3 $1)]) + + (InterfaceBody + [(O_BRACE InterfaceMemberDeclarations C_BRACE) $2]) + + (InterfaceMemberDeclarations + [() null] + [(InterfaceMemberDeclarations InterfaceMemberDeclaration) + (cond + ((not $2) $1) + ((list? $2) (append $2 $1)) + (else (cons $2 $1)))]) + + (InterfaceMemberDeclaration + [(AbstractMethodDeclaration) $1] + [(SEMI_COLON) #f]) + + (AbstractMethodDeclaration + [(MethodHeader SEMI_COLON) $1]) + + (VariableInitializers + [(VariableInitializer) (list $1)] + [(VariableInitializers COMMA VariableInitializer) (cons $3 $1)]) + + ;; 19.11 + + (Block + [(O_BRACE BlockStatements C_BRACE) (make-block (reverse $2) (build-src 3))] + [(O_BRACE C_BRACE) (make-block null (build-src 2))]) + + (BlockStatements + [(BlockStatement) (cond + ((list? $1) $1) + (else (list $1)))] + [(BlockStatements BlockStatement) (cond + ((list? $2) + (append (reverse $2) $1)) + (else + (cons $2 $1)))]) + + (BlockStatement + [(LocalVariableDeclarationStatement) $1] + [(Statement) $1]) + + (LocalVariableDeclarationStatement + [(LocalVariableDeclaration SEMI_COLON) $1]) + + (LocalVariableDeclaration + [(Type VariableDeclarators) + (map (lambda (d) (build-field-decl null $1 d)) (reverse $2))]) + + (Statement + [(StatementWithoutTrailingSubstatement) $1] + [(IfThenElseStatement) $1]) + + (StatementNoShortIf + [(StatementWithoutTrailingSubstatement) $1] + [(IfThenElseStatementNoShortIf) $1]) + + (StatementWithoutTrailingSubstatement + [(Block) $1] + [(EmptyStatement) $1] + [(Assignment SEMI_COLON) $1] + [(ExpressionStatement) $1] + [(ReturnStatement) $1]) + + (EmptyStatement + [(SEMI_COLON) (make-block null (build-src 1))]) + + (ExpressionStatement + [(StatementExpression SEMI_COLON) $1]) + + (StatementExpression + [(MethodInvocation) $1] + [(ClassInstanceCreationExpression) $1]) + + (IfThenElseStatement + [(if O_PAREN Expression C_PAREN StatementNoShortIf else Statement) + (make-ifS $3 $5 $7 (build-src 1) (build-src 7))]) + + (IfThenElseStatementNoShortIf + [(if O_PAREN Expression C_PAREN StatementNoShortIf else StatementNoShortIf) + (make-ifS $3 $5 $7 (build-src 1) (build-src 7))]) + + (StatementExpressionList + [(StatementExpression) (list $1)] + [(StatementExpressionList COMMA StatementExpression) (cons $3 $1)]) + + (ReturnStatement + [(return Expression SEMI_COLON) (make-return $2 #f #f (build-src 3))] + [(return SEMI_COLON) (make-return #f #f #f (build-src 2))]) + + ;; 19.12 + + (Primary + [(PrimaryNoNewArray) $1]) + + (PrimaryNoNewArray + [(Literal) $1] + [(this) (make-special-name #f (build-src 1) "this")] + [(O_PAREN Expression C_PAREN) $2] + [(ClassInstanceCreationExpression) $1] + [(FieldAccess) $1] + [(MethodInvocation) $1]) + + (ClassInstanceCreationExpression + [(new ClassOrInterfaceType O_PAREN ArgumentList C_PAREN) + (make-class-alloc #f (build-src 5) $2 (reverse $4) #f #f #f)] + [(new ClassOrInterfaceType O_PAREN C_PAREN) + (make-class-alloc #f (build-src 4) $2 null #f #f #f)]) + + (ArgumentList + [(Expression) (list $1)] + [(ArgumentList COMMA Expression) (cons $3 $1)]) + + (FieldAccess + [(Primary PERIOD IDENTIFIER) + (make-access #f (build-src 3) (make-field-access $1 + (make-id $3 (build-src 3 3)) #f))] + [(super PERIOD IDENTIFIER) + (make-access #f (build-src 3) + (make-field-access (make-special-name #f (build-src 1) + "super") + (make-id $3 (build-src 3 3)) + #f))]) + + (MethodInvocation + [(Name O_PAREN ArgumentList C_PAREN) (build-name-call $1 (reverse $3) (build-src 4))] + [(Name O_PAREN C_PAREN) (build-name-call $1 null (build-src 3))] + [(Primary PERIOD IDENTIFIER O_PAREN ArgumentList C_PAREN) + (make-call #f (build-src 6) $1 (make-id $3 (build-src 3 3)) (reverse $5) #f)] + [(Primary PERIOD IDENTIFIER O_PAREN C_PAREN) + (make-call #f (build-src 5) $1 (make-id $3 (build-src 3 3)) null #f)] + [(super PERIOD IDENTIFIER O_PAREN ArgumentList C_PAREN) + (make-call #f (build-src 6) + (make-special-name #f (build-src 1) "super") + (make-id $3 (build-src 3 3)) (reverse $5) #f)] + [(super PERIOD IDENTIFIER O_PAREN C_PAREN) + (make-call #f (build-src 5) + (make-special-name #f (build-src 1) "super") + (make-id $3 (build-src 3 3)) null #f)]) + + (PostfixExpression + [(Primary) $1] + [(Name) (name->access $1)]) + + (UnaryExpression + [(+ UnaryExpression) (make-unary #f (build-src 2) '+ $2 (build-src 1))] + [(- UnaryExpression) (make-unary #f (build-src 2) '- $2 (build-src 1))] + [(UnaryExpressionNotPlusMinus) $1]) + + + (UnaryExpressionNotPlusMinus + [(PostfixExpression) $1] + [(~ UnaryExpression) (make-unary #f (build-src 2) '~ $2 (build-src 1))] + [(! UnaryExpression) (make-unary #f (build-src 2) '! $2 (build-src 1))] + [(CastExpression) $1]) + + (CastExpression + [(O_PAREN PrimitiveType C_PAREN UnaryExpression) + (make-cast #f (build-src 4) $2 $4)] + [(O_PAREN Expression C_PAREN UnaryExpressionNotPlusMinus) + (if (access? $2) + (make-cast #f (build-src 4) + (make-type-spec (access->name $2) 0 (build-src 2 2)) $4) + (raise-read-error "An operator is needed to combine these expressions." + (file-path) + (position-line $1-start-pos) + (position-col $1-start-pos) + (+ (position-offset $1-start-pos) (interactions-offset)) + (- (position-offset $4-end-pos) + (position-offset $1-start-pos))))]) + + (MultiplicativeExpression + [(UnaryExpression) $1] + [(MultiplicativeExpression * UnaryExpression) + (make-bin-op #f (build-src 3) '* $1 $3 (build-src 2 2))] + [(MultiplicativeExpression / UnaryExpression) + (make-bin-op #f (build-src 3) '/ $1 $3 (build-src 2 2))] + [(MultiplicativeExpression % UnaryExpression) + (make-bin-op #f (build-src 3) '% $1 $3 (build-src 2 2))]) + + (AdditiveExpression + [(MultiplicativeExpression) $1] + [(AdditiveExpression + MultiplicativeExpression) + (make-bin-op #f (build-src 3) '+ $1 $3 (build-src 2 2))] + [(AdditiveExpression - MultiplicativeExpression) + (make-bin-op #f (build-src 3) '- $1 $3 (build-src 2 2))]) + + (ShiftExpression + [(AdditiveExpression) $1] + [(ShiftExpression << AdditiveExpression) + (make-bin-op #f (build-src 3) '<< $1 $3 (build-src 2 2))] + [(ShiftExpression >> AdditiveExpression) + (make-bin-op #f (build-src 3) '>> $1 $3 (build-src 2 2))] + [(ShiftExpression >>> AdditiveExpression) + (make-bin-op #f (build-src 3) '>>> $1 $3 (build-src 2 2))]) + + + (RelationalExpression + [(ShiftExpression) $1] + ;; GJ - changed to remove shift/reduce conflict + [(ShiftExpression < ShiftExpression) + (make-bin-op #f (build-src 3) '< $1 $3 (build-src 2 2))] + [(RelationalExpression > ShiftExpression) + (make-bin-op #f (build-src 3) '> $1 $3 (build-src 2 2))] + [(RelationalExpression <= ShiftExpression) + (make-bin-op #f (build-src 3) '<= $1 $3 (build-src 2 2))] + [(RelationalExpression >= ShiftExpression) + (make-bin-op #f (build-src 3) '>= $1 $3 (build-src 2 2))] + [(RelationalExpression instanceof ReferenceType) + (make-instanceof #f (build-src 3) $1 $3 (build-src 2 2))] + ) + + (EqualityExpression + [(RelationalExpression) $1] + [(EqualityExpression == RelationalExpression) + (make-bin-op #f (build-src 3) '== $1 $3 (build-src 2 2))] + [(EqualityExpression != RelationalExpression) + (make-bin-op #f (build-src 3) '!= $1 $3 (build-src 2 2))]) + + (AndExpression + [(EqualityExpression) $1] + [(AndExpression & EqualityExpression) + (make-bin-op #f (build-src 3) '& $1 $3 (build-src 2 2))]) + + (ExclusiveOrExpression + [(AndExpression) $1] + [(ExclusiveOrExpression ^ AndExpression) + (make-bin-op #f (build-src 3) '^ $1 $3 (build-src 2 2))]) + + (InclusiveOrExpression + [(ExclusiveOrExpression) $1] + [(InclusiveOrExpression PIPE ExclusiveOrExpression) + (make-bin-op #f (build-src 3) 'or $1 $3 (build-src 2 2))]) + + (ConditionalAndExpression + [(InclusiveOrExpression) $1] + [(ConditionalAndExpression && InclusiveOrExpression) + (make-bin-op #f (build-src 3) '&& $1 $3 (build-src 2 2))]) + + (ConditionalOrExpression + [(ConditionalAndExpression) $1] + [(ConditionalOrExpression OR ConditionalAndExpression) + (make-bin-op #f (build-src 3) 'oror $1 $3 (build-src 2 2))]) + + (CheckExpression + [(ConditionalOrExpression) $1] + [(check ConditionalOrExpression expect ConditionalOrExpression) + (make-check-expect #f (build-src 4) $2 $4 #f (build-src 2 4))] + [(check ConditionalOrExpression expect ConditionalOrExpression within ConditionalOrExpression) + (make-check-expect #f (build-src 6) $2 $4 $6 (build-src 2 4))]) + + #;(ConditionalExpression + [(ConditionalOrExpression) $1]) + + (ConditionalExpression + ((CheckExpression) $1)) + + (AssignmentExpression + [(ConditionalExpression) $1]) + + (Assignment + [(LeftHandSide AssignmentOperator AssignmentExpression) + (make-assignment #f (build-src 3) $1 $2 $3 (build-src 2 2))]) + + (LeftHandSide + [(Name) (name->access $1)] + [(FieldAccess) $1]) + + (AssignmentOperator + [(=) '=]) + + (Expression + [(AssignmentExpression) $1]) + + (ConstantExpression + [(Expression) $1])))) + + ;(define intermediate-grammar (cadr parsers)) + ;(set! parsers (car parsers)) + + (define parse-intermediate+access (car parsers)) + (define parse-intermediate+access-interactions (cadr parsers)) + (define parse-intermediate+access-expression (caddr parsers)) + (define parse-intermediate+access-type (cadddr parsers)) + + ) diff --git a/collects/profj/restrictions.ss b/collects/profj/restrictions.ss index dd62176d6f..20b995df9b 100644 --- a/collects/profj/restrictions.ss +++ b/collects/profj/restrictions.ss @@ -61,7 +61,7 @@ (case level ((beginner) (append beginner&intermediate teaching-levels)) - ((intermediate) (append beginner&intermediate + ((intermediate intermediate+access) (append beginner&intermediate teaching-levels)) ((advanced) (append null teaching-levels)) diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index 835b3ed7d4..0296c73ab7 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -137,6 +137,8 @@ (make-object ((drscheme:language:get-default-mixin) full-lang%))) (drscheme:language-configuration:add-language (make-object ((drscheme:language:get-default-mixin) advanced-lang%))) + (drscheme:language-configuration:add-language + (make-object ((drscheme:language:get-default-mixin) intermediate+access-lang%))) (drscheme:language-configuration:add-language (make-object ((drscheme:language:get-default-mixin) intermediate-lang%))) (drscheme:language-configuration:add-language @@ -178,13 +180,13 @@ (int-list (cons #"profj-intermediate" beg-list))) (values (case level ((beginner) beg-list) - ((intermediate) int-list) + ((intermediate intermediate+access) int-list) ((advanced full) (cons #"profj-advanced" int-list))) #f))) ;default-settings: -> profj-settings (define/public (default-settings) - (if (memq level `(beginner intermediate advanced)) + (if (memq level `(beginner intermediate intermediate+access advanced)) (make-profj-settings 'field #f #t #f #t #t null) (make-profj-settings 'type #f #t #t #f #f null))) ;default-settings? any -> bool @@ -755,12 +757,15 @@ (super-instantiate ()))) ;Create the ProfessorJ languages - (define full-lang% (java-lang-mixin 'full (string-constant profj-full-lang) 4 (string-constant profj-full-lang-one-line-summary) #f)) - (define advanced-lang% (java-lang-mixin 'advanced (string-constant profj-advanced-lang) 3 (string-constant profj-advanced-lang-one-line-summary) #f)) + (define dynamic-lang% (java-lang-mixin 'full (string-constant profj-dynamic-lang) 6 (string-constant profj-dynamic-lang-one-summary) #t)) + (define full-lang% (java-lang-mixin 'full (string-constant profj-full-lang) 5 (string-constant profj-full-lang-one-line-summary) #f)) + (define advanced-lang% (java-lang-mixin 'advanced (string-constant profj-advanced-lang) 4 (string-constant profj-advanced-lang-one-line-summary) #f)) + (define intermediate+access-lang% + (java-lang-mixin 'intermediate+access + (string-constant profj-intermediate-access-lang) 3 (string-constant profj-intermediate-access-lang-one-line-summary) #f)) (define intermediate-lang% (java-lang-mixin 'intermediate (string-constant profj-intermediate-lang) 2 (string-constant profj-intermediate-lang-one-line-summary) #f)) (define beginner-lang% (java-lang-mixin 'beginner (string-constant profj-beginner-lang) 1 (string-constant profj-beginner-lang-one-line-summary) #f)) - (define dynamic-lang% (java-lang-mixin 'full (string-constant profj-dynamic-lang) 5 (string-constant profj-dynamic-lang-one-summary) #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss index c3f7c5229e..27d768e244 100644 --- a/collects/string-constants/english-string-constants.ss +++ b/collects/string-constants/english-string-constants.ss @@ -1240,6 +1240,8 @@ please adhere to these guidelines: (profj-advanced-lang-one-line-summary "Java-like Advanced teaching language") (profj-intermediate-lang "Intermediate") (profj-intermediate-lang-one-line-summary "Java-like Intermediate teaching language") + (profj-intermediate-access-lang "Intermediate + access") + (profj-intermediate-access-lang-one-line-summary "Java-like Intermediate teaching language, with access modifiers") (profj-dynamic-lang "Java+dynamic") (profj-dynamic-lang-one-summary "Java with dynamic typing capabilities")