[elpa] externals/phps-mode a907f103f0 026/212: More work on AST for bookkeeping

[Christian Johansson]

branch: externals/phps-mode
commit a907f103f0e713d0ac19a00cd42cb150a1226c09
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    More work on AST for bookkeeping
---
 phps-mode-ast.el | 234 +++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 165 insertions(+), 69 deletions(-)

diff --git a/phps-mode-ast.el b/phps-mode-ast.el
index 908a700f8d..5e0dbbacf3 100644
--- a/phps-mode-ast.el
+++ b/phps-mode-ast.el
@@ -2,21 +2,6 @@
 
 ;; Copyright (C) 2018-2021  Free Software Foundation, Inc.
 
-;; This file is not part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-
 
 ;;; Commentary:
 
@@ -50,6 +35,17 @@
   #s(hash-table size 12 test equal rehash-size 1.5 rehash-threshold 0.8125 
data ("$_GET" 1 "$_POST" 1 "$_COOKIE" 1 "$_SESSION" 1 "$_REQUEST" 1 "$GLOBALS" 
1 "$_SERVER" 1 "$_FILES" 1 "$_ENV" 1 "$argc" 1 "$argv" 1 
"$http_​response_​header" 1))
   "Hash-table of super-global variables.")
 
+;; Macros
+
+
+(defun phps-mode-ast--get-list-of-objects (objects)
+  "Get list of OBJECTS."
+  (if (and (listp objects)
+           (plist-get objects 'ast-type))
+      (list objects)
+    objects))
+
+
 ;; Syntax directed translation for grammar
 
 
@@ -141,6 +137,36 @@
    (nth 1 args))
  phps-mode-parser--table-translations)
 
+;; statement -> (T_WHILE "(" expr ")" while_statement)
+(puthash
+ 143
+ (lambda(args _terminals)
+   (let ((ast-object
+          (list
+           'ast-type
+           'while
+           'condition
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
+           'children
+           (phps-mode-ast--get-list-of-objects (nth 4 args)))))
+     ast-object))
+ phps-mode-parser--table-translations)
+
+;; statement -> (T_DO statement T_WHILE "(" expr ")" ";")
+(puthash
+ 144
+ (lambda(args _terminals)
+   (let ((ast-object
+          (list
+           'ast-type
+           'do-while
+           'children
+           (phps-mode-ast--get-list-of-objects (nth 1 args))
+           'condition
+           (phps-mode-ast--get-list-of-objects (nth 4 args)))))
+     ast-object))
+ phps-mode-parser--table-translations)
+
 ;; statement -> (T_FOR "(" for_exprs ";" for_exprs ";" for_exprs ")" 
for_statement)
 (puthash
  145
@@ -150,13 +176,13 @@
            'ast-type
            'for
            'initial
-           (nth 2 args)
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
            'test
-           (nth 4 args)
+           (phps-mode-ast--get-list-of-objects (nth 4 args))
            'incremental
-           (nth 6 args)
+           (phps-mode-ast--get-list-of-objects (nth 6 args))
            'children
-           (nth 8 args))))
+           (phps-mode-ast--get-list-of-objects (nth 8 args)))))
      ast-object))
  phps-mode-parser--table-translations)
 
@@ -169,7 +195,7 @@
            'ast-type
            'echo
            'children
-           (nth 1 args))))
+           (phps-mode-ast--get-list-of-objects (nth 1 args)))))
      ast-object))
  phps-mode-parser--table-translations)
 
@@ -177,7 +203,7 @@
 (puthash
  154
  (lambda(args _terminals)
-   (car args))
+   (nth 0 args))
  phps-mode-parser--table-translations)
 
 ;; statement -> (T_FOREACH "(" expr T_AS foreach_variable ")" 
foreach_statement)
@@ -189,11 +215,11 @@
            'ast-type
            'foreach
            'expression
-           (nth 2 args)
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
            'value
            (nth 4 args)
            'children
-           (nth 6 args))))
+           (phps-mode-ast--get-list-of-objects (nth 6 args)))))
      ast-object))
  phps-mode-parser--table-translations)
 
@@ -206,13 +232,13 @@
            'ast-type
            'foreach
            'expression
-           (nth 2 args)
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
            'key
            (nth 4 args)
            'value
            (nth 6 args)
            'children
-           (nth 8 args))))
+           (phps-mode-ast--get-list-of-objects (nth 8 args)))))
      ast-object))
  phps-mode-parser--table-translations)
 
@@ -239,7 +265,7 @@
            'return-type
            (nth 7 args)
            'children
-           (nth 10 args))))
+           (phps-mode-ast--get-list-of-objects (nth 10 args)))))
      ;; (message "Function: %S" ast-object)
      ;; (message "args: %S" args)
      ;; (message "terminals: %S" terminals)
@@ -263,7 +289,7 @@
            'end
            (car (cdr (nth 7 terminals)))
            'children
-           (nth 6 args))))
+           (phps-mode-ast--get-list-of-objects (nth 6 args)))))
      ;; (message "Class %S" ast-object)
      ;; (message "args: %S" args)
      ;; (message "terminals: %S" terminals)
@@ -280,6 +306,8 @@
            'interface
            'name
            (nth 1 args)
+           'extends
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
            'index
            (car (cdr (nth 1 terminals)))
            'start
@@ -287,7 +315,7 @@
            'end
            (car (cdr (nth 6 terminals)))
            'children
-           (nth 5 args))))
+           (phps-mode-ast--get-list-of-objects (nth 5 args)))))
      ;; (message "Interface %S" ast-object)
      ;; (message "args: %S" args)
      ;; (message "terminals: %S" terminals)
@@ -304,9 +332,9 @@
            'ast-type
            'if
            'condition
-           (nth 2 args)
+           (phps-mode-ast--get-list-of-objects (nth 2 args))
            'children
-           (nth 4 args))))
+           (phps-mode-ast--get-list-of-objects (nth 4 args)))))
      ast-object))
  phps-mode-parser--table-translations)
 
@@ -374,7 +402,7 @@
            'ast-type
            'property
            'modifiers
-           (nth 0 args)
+           (phps-mode-ast--get-list-of-objects (nth 0 args))
            'type
            (nth 1 args)
            'subject
@@ -390,6 +418,8 @@
           (list
            'ast-type
            'method
+           'modifiers
+           (phps-mode-ast--get-list-of-objects (nth 0 args))
            'returns-reference-p
            (not (equal (nth 2 args) nil))
            'name
@@ -399,7 +429,7 @@
            'return-type
            (nth 8 args)
            'children
-           (nth 10 args)
+           (phps-mode-ast--get-list-of-objects (nth 10 args))
            'index
            (car (cdr (nth 3 terminals)))
            'start
@@ -415,7 +445,7 @@
 ;; 302: method_body -> ("{" inner_statement_list "}")
 (puthash
  302
- (lambda(args terminals)
+ (lambda(args _terminals)
    (nth 1 args))
  phps-mode-parser--table-translations)
 
@@ -452,7 +482,7 @@
            'key
            (nth 0 args)
            'value
-           (nth 2 args))))
+           (phps-mode-ast--get-list-of-objects (nth 2 args)))))
      ;; (message "Method: %S" ast-object)
      ;; (message "args: %S" args)
      ;; (message "terminals: %S" terminals)
@@ -810,25 +840,25 @@
                      bookkeeping-stack)))))
 
              ((equal type 'if)
-              (let ((condition (plist-get item 'condition)))
-                (when (equal (plist-get condition 'ast-type) 'variable)
+              (let ((children (reverse (plist-get item 'children))))
+                (dolist (child children)
                   (push
                    (list
                     (list
                      class
                      function
                      namespace)
-                    condition)
+                    child)
                    bookkeeping-stack)))
-              (let ((children (reverse (plist-get item 'children))))
-                (dolist (child children)
+              (let ((conditions (reverse (plist-get item 'condition))))
+                (dolist (condition conditions)
                   (push
                    (list
                     (list
                      class
                      function
                      namespace)
-                    child)
+                    condition)
                    bookkeeping-stack))))
 
              ((equal type 'foreach)
@@ -849,7 +879,6 @@
                    object
                    1
                    bookkeeping)))
-
               (let* ((value (plist-get item 'value))
                      (id (format
                           "%s id %s"
@@ -866,7 +895,6 @@
                  object
                  1
                  bookkeeping))
-
               (let ((children (reverse (plist-get item 'children))))
                 (dolist (child children)
                   (push
@@ -876,39 +904,107 @@
                      function
                      namespace)
                     child)
+                   bookkeeping-stack)))
+              (let ((expression (reverse (plist-get item 'expression))))
+                (dolist (expr expression)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    expr)
                    bookkeeping-stack))))
 
              ((equal type 'for)
               ;; Optional incremental
-              (when-let ((child (plist-get item 'incremental)))
-                (push
-                 (list
-                  (list
-                   class
-                   function
-                   namespace)
-                  child)
-                 bookkeeping-stack))
+              (when-let ((children (reverse (plist-get item 'children))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack)))
+              ;; Optional incremental
+              (when-let ((children (reverse (plist-get item 'incremental))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack)))
               ;; Optional test
-              (when-let ((child (plist-get item 'test)))
-                (push
-                 (list
-                  (list
-                   class
-                   function
-                   namespace)
-                  child)
-                 bookkeeping-stack))
+              (when-let ((children (reverse (plist-get item 'test))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack)))
               ;; Optional initial
-              (when-let ((child (plist-get item 'initial)))
-                (push
-                 (list
-                  (list
-                   class
-                   function
-                   namespace)
-                  child)
-                 bookkeeping-stack)))
+              (when-let ((children (reverse (plist-get item 'initial))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack))))
+
+             ((equal type 'while)
+              (when-let ((children (reverse (plist-get item 'children))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack)))
+              (when-let ((conditions (reverse (plist-get item 'condition))))
+                (dolist (condition conditions)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    condition)
+                   bookkeeping-stack))))
+
+             ((equal type 'do-while)
+              (when-let ((conditions (reverse (plist-get item 'condition))))
+                (dolist (condition conditions)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    condition)
+                   bookkeeping-stack)))
+              (when-let ((children (reverse (plist-get item 'children))))
+                (dolist (child children)
+                  (push
+                   (list
+                    (list
+                     class
+                     function
+                     namespace)
+                    child)
+                   bookkeeping-stack))))
 
              ((equal type 'assign-variable)
               (let ((id (format