Changes to add a language level to ProfJ

svn: r6814
2007-07-03 23:02:13 +00:00 · 2007-07-03 23:02:13 +00:00 · cccb5150f0
commit cccb5150f0
parent 91800b4f0f
8 changed files with 658 additions and 20 deletions
--- 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))
--- 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)))

  
--- 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)
--- 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))
--- a/collects/profj/parsers/intermediate-access-parser.ss
+++ 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))
+  
+  )
--- 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))
--- 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))
      
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      ;;
--- 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")