Changeset 78

Timestamp:

08/05/07 02:57:38 (17 months ago)

Author:

weyrick

Message:

initial work on PHP5 property visibility. not fully working yet.

Location:

trunk/pcc

Files:

• compiler/ast.scm (modified) (1 diff)
• compiler/evaluate.scm (modified) (1 diff)
• compiler/generate.scm (modified) (1 diff)
• compiler/parser.scm (modified) (2 diffs)
• runtime/php-object.scm (modified) (11 diffs)

trunk/pcc/compiler/ast.scm

@@ -110 +110 @@
        name
        value
-       static?)
+       static?
+       visibility)
     (final-class method-decl::declaration
        name

trunk/pcc/compiler/evaluate.scm

@@ -750 +750 @@
                       (if (null? (property-decl-value prop))
                           (make-container '())
-                          (d/evaluate (property-decl-value prop))))))
+                          (d/evaluate (property-decl-value prop)))
+                      (property-decl-visibility prop))))
 
              ;; PHP5 class constants

trunk/pcc/compiler/generate.scm

@@ -782 +782 @@
 ;                                    (get-location (property-decl-value prop))
                                       ''()
-                                      (get-value (property-decl-value prop))
-                                     ))
+                                      (get-value (property-decl-value prop)))
+                                 ',(property-decl-visibility prop)
+                                 )
                              code)))
                 (php-hash-for-each class-constants

trunk/pcc/compiler/parser.scm

@@ -234 +234 @@
        ((class-function) class-function)
        ((varkey class-vars semi) class-vars)
-       ;; XXX public, private, and protected don't do anything yet
+       ((public class-vars semi)
+        (parse-require-php5)
+        class-vars)
        ((private class-vars semi)
         (parse-require-php5)
-        class-vars)
-       ((public class-vars semi)
-        (parse-require-php5)
-        class-vars)
+        (map (lambda (c) (property-decl-visibility-set! c 'private) c) class-vars))
        ((protected class-vars semi)
         (parse-require-php5)
-        class-vars)
+        (map (lambda (c) (property-decl-visibility-set! c 'protected) c) class-vars))
        ((static class-vars semi)
         (parse-require-php5)
@@ -254 +253 @@
       (class-var
        ((var equals decl-literal)
-        (make-property-decl *parse-loc* var decl-literal #f))
+        (make-property-decl *parse-loc* var decl-literal #f 'public))
        ((var)
-        (make-property-decl *parse-loc* var '() #f)))
+        (make-property-decl *parse-loc* var '() #f 'public)))
 
       (decl-literal

trunk/pcc/runtime/php-object.scm

@@ -72 +72 @@
     (construct-php-object-sans-constructor class-name)
     (get-declared-php-classes)
-    (define-php-property class-name property-name value)
-    (define-php-method class-name method-name method)    
+    (define-php-property class-name property-name value visibility)
+    (define-php-method class-name method-name method)
     (define-class-constant class-name constant-name value)
     (lookup-class-constant class-name constant-name)))
@@ -100 +100 @@
    ;;a hashtable mapping names of declared properties to an index in a property vector
    declared-property-offsets
-   ;;properties is a vector of properties
+   ;;properties is a vector of all properties (which points to actual php data)
    properties
+   ;; a list of protected properties (unmangled)
+   protected-properties
+   ;; a list of private properties (unmangled)
+   private-properties
    ;;extended properties is either #f or a php-hash of non-declared properties
    extended-properties
@@ -592 +596 @@
               #f))))
 
-; XXX update for PHP5
 (define (%class-name-canonicalize name)
    "define class names as case-insensitive strings"
-   ;   (string->symbol
    (string-downcase (mkstr name)))
-    ;))
 
 ; XXX update for PHP5
@@ -625 +626 @@
    ;define the root of the class hierarchy
    (let ((stdclass (%php-class "stdClass" "stdclass" #f #f
-                               (make-hashtable) (make-vector 0)
+                               (make-hashtable) (make-vector 0) '() '()
                                (make-php-hash) (make-php-hash)
                                #f #f #f (make-php-hash)))
          (inc-class (%php-class "__PHP_Incomplete_Class" "__php_incomplete_class" #f #f
-                                (make-hashtable) (make-vector 0)
+                                (make-hashtable) (make-vector 0) '() '()
                                 (make-php-hash) (make-php-hash)
                                 #f #f #f (make-php-hash)) ))
@@ -636 +637 @@
       (hashtable-put! %php-class-registry "__php_incomplete_class" inc-class)))
 
+;; XXX this is in newer versions of bigloo, yank it when we upgrade
+(define (list-copy list)
+   (if (null? list)
+       '()
+       (cons (car list)
+             (list-copy (cdr list)))))
 
 (define (define-php-class name parent-name)
@@ -646 +653 @@
              (php-error "Defining class " name ": unable to find parent class " parent-name))
           (let* ((canonical-name (%class-name-canonicalize name))
-                 (new-class (%php-class (string-downcase (mkstr name))
+                 (new-class (%php-class (if PHP5?
+                                            (mkstr name)
+                                            (string-downcase (mkstr name)))
                                         canonical-name
                                         parent-class
@@ -653 +662 @@
                                          (%php-class-declared-property-offsets parent-class))
                                         (copy-properties-vector (%php-class-properties parent-class))
+                                        '() ; private props
+                                        (list-copy (%php-class-protected-properties parent-class))
                                         (copy-php-data (%php-class-extended-properties parent-class))
                                         (copy-php-data (%php-class-methods parent-class))
@@ -715 +726 @@
                            method))))
 
-(define (define-php-property class-name property-name value)
+(define (mangle-property-private prop)
+   "mangle given property string to private visibility"
+   (mkstr prop ":private"))
+
+(define (mangle-property-protected prop)
+   "mangle given property string to protected visibility"
+   (mkstr prop ":protected"))
+
+(define (%property-name-mangle name visibility)
+   (cond
+      ((eqv? 'public visibility)
+       name)
+      ((eqv? 'private visibility)
+       (mangle-property-private name))
+      ((eqv? 'protected visibility)
+       (mangle-property-protected name))))
+
+(define (define-php-property class-name property-name value visibility)
    (let ((the-class (%lookup-class class-name)))
       (unless the-class
@@ -721 +749 @@
       (let* ((properties (%php-class-properties the-class))
              (offset (vector-length properties))
-             (canonical-name (%property-name-canonicalize property-name)))
-         (aif (hashtable-get (%php-class-declared-property-offsets the-class) canonical-name)
+             (canonical-name (%property-name-canonicalize property-name))
+             (mangled-name (%property-name-mangle canonical-name visibility)))
+         (aif (hashtable-get (%php-class-declared-property-offsets the-class) mangled-name)
               ;; already defined, just set it
               (vector-set! properties it (make-container (maybe-unbox value)))
@@ -732 +761 @@
                   (cruddy-push-extend (make-container (maybe-unbox value)) properties))
                  (hashtable-put! (%php-class-declared-property-offsets the-class)
-                                 canonical-name
+                                 mangled-name
                                  offset)
                  ;store the reverse, too
                  (hashtable-put! (%php-class-declared-property-offsets the-class)
                                  offset
-                                 canonical-name))))))
+                                 mangled-name)
+                 ;store visibility
+                 (when (eqv? 'private visibility)
+                  (%php-class-private-properties-set! the-class (cons canonical-name (%php-class-private-properties the-class))))
+                 (when (eqv? 'protected visibility)
+                  (%php-class-protected-properties-set! the-class (cons canonical-name (%php-class-protected-properties the-class)))))))))
 
 (define (%lookup-class name)
@@ -778 +812 @@
            #f))))
 
+;; this handles visibility mangling
+;; it will check in order: public (no mangle), protected, private
+;; it makes no attempt to restrict the property, it simply returns it if available in mangled form
 (define (%prop-offset obj prop-canon-name)
-   (hashtable-get
-    (%php-class-declared-property-offsets
-     (%php-object-class obj))
-    prop-canon-name))
-
+   (let ((prop (hashtable-get
+                (%php-class-declared-property-offsets
+                 (%php-object-class obj))
+                prop-canon-name)))
+      (if (or prop (not PHP5?))
+          ; found a public
+          prop
+          (let ((prop (hashtable-get
+                       (%php-class-declared-property-offsets
+                        (%php-object-class obj))
+                       (mangle-property-protected prop-canon-name))))
+             (if prop
+                 ; found a protected
+                 prop
+                 ; either privte or nothin'
+                 (hashtable-get
+                  (%php-class-declared-property-offsets
+                   (%php-object-class obj))
+                  (mangle-property-private prop-canon-name)))))))
+                
 ;;;;the actual property looker-uppers
 (define (%lookup-prop-ref obj property)