Added context package; Corrected some errors and warnings.

Pascal J. Bourguignon [2015-07-29 20:02]
Added context package; Corrected some errors and warnings.
Filename
common-lisp/data-encoding/ecp.lisp
languages/c11/c11-parser.lisp
languages/c11/c11-scanner.lisp
languages/c11/context.lisp
languages/c11/packages.lisp
languages/c11/read-yacc.lisp
diff --git a/common-lisp/data-encoding/ecp.lisp b/common-lisp/data-encoding/ecp.lisp
index e620b9f..8ec6b7f 100644
--- a/common-lisp/data-encoding/ecp.lisp
+++ b/common-lisp/data-encoding/ecp.lisp
@@ -269,18 +269,18 @@ RETURN:     NIL;         next; NIL;          STATS -- in case of incomplete or e
     (flet ((process-block ()
              ;; (print `(process-block :ecp ,ecp :start ,start :end ,end :b ,b :c ,c :count ,count :stats ,stats)) (finish-output)
              (loop :named accumulates-until-end-of-block
-                :while (and (plusp c) (< (ecp-count ecp) +ecp-block-size+))
-                :do                       ;; check parity errors
-                (when (/= (aref buffer b) (even-parity (aref buffer b)))
-                  (when (< (ecp-parity-errors ecp) 2)
-                    (when (zerop (ecp-parity-errors ecp))
-                      (setf (ecp-parity-index ecp) (ecp-count ecp)))
-                    (incf (ecp-parity-errors ecp)))
-                  (incf (statistics-parity-errors stats)))
-                (setf (aref (ecp-block ecp) (ecp-count ecp)) (aref buffer b))
-                (incf (ecp-count ecp))
-                (incf b)
-                (decf c))
+                   :while (and (plusp c) (< (ecp-count ecp) +ecp-block-size+))
+                   :do ;; check parity errors
+                       (when (/= (aref buffer b) (even-parity (aref buffer b)))
+                         (when (< (ecp-parity-errors ecp) 2)
+                           (when (zerop (ecp-parity-errors ecp))
+                             (setf (ecp-parity-index ecp) (ecp-count ecp)))
+                           (incf (ecp-parity-errors ecp)))
+                         (incf (statistics-parity-errors stats)))
+                       (setf (aref (ecp-block ecp) (ecp-count ecp)) (aref buffer b))
+                       (incf (ecp-count ecp))
+                       (incf b)
+                       (decf c))
              (incf (statistics-bytes-received stats) (- count c))
              (setf count c)
              (cond
@@ -328,7 +328,7 @@ RETURN:     NIL;         next; NIL;          STATS -- in case of incomplete or e
                            ;; 	but we don't care and don't correct the CRC byte when rank<7 because
                            ;; 	the CRC byte is not used thereafter.
                            (if (= index (ecp-parity-index ecp))
-                               (progn     ; corrected block
+                               (progn   ; corrected block
                                  (incf (statistics-corrected-count stats))
                                  (setf (aref (ecp-block ecp) index) (logxor (aref (ecp-block ecp) index)
                                                                             (ash 1 (mod (1+ rank) 8))))
@@ -339,7 +339,7 @@ RETURN:     NIL;         next; NIL;          STATS -- in case of incomplete or e
                                          (ecp-state ecp) :ecp-start)
                                    (return-from process-input-buffer
                                      (values (subseq (ecp-block ecp) 0 cnt) b bn stats))))
-                               (progn     ; uncorrected block
+                               (progn   ; uncorrected block
                                  (incf (statistics-uncorrected-count stats))
                                  (setf (ecp-state ecp) :ecp-start)
                                  (when send-nak (funcall send-nak))))))
@@ -354,54 +354,54 @@ RETURN:     NIL;         next; NIL;          STATS -- in case of incomplete or e
                 ;; (print 'else) (finish-output)
                 ))))
       (loop :while (plusp c) :do
-         (ecase (ecp-state ecp)
-           (:ecp-start
-            (loop :named skip-nuls
-               :while (and (plusp c) (zerop (aref buffer b)))
-               :do (decf c) (incf b))
-            (setf (ecp-state ecp) :ecp-block
-                  (ecp-parity-errors ecp) 0
-                  (ecp-count ecp) 0)
-            (incf (statistics-bytes-received stats) (- count c))
-            (setf count c)
-            (process-block))
-           (:ecp-block
-            (process-block))
-           (:ecp-syn
-            ;; wait for a SYN SYN 4x sequence
-            (loop :while (and (plusp c) (eql :ecl-syn (ecp-state ecp))) :do
-               (let ((byte (logand (aref buffer b) #x7f)))
-                 (if (= (ecp-count ecp) 2) ; get the 4x
-                     (progn
-                       (when cancel-nak (funcall cancel-nak))
-                       (if (and (= (aref buffer b) (even-parity byte))
-                                (= byte (+ #x40 (ecp-block-number ecp))))
-                           (progn
-                             (incf (statistics-valid-syn-count stats))
-                             (setf (ecp-state ecp) :ecp-start
-                                   (ecp-parity-errors ecp) 0
-                                   (ecp-count ecp) 0))
-                           (progn
-                             (incf (statistics-invalid-syn-count stats))
-                             (when send-nak (funcall send-nak)))))
-                     (progn
-                       (if (= (aref buffer b) (even-parity byte))
-                           (if (= byte #x16)
-                               (incf (ecp-count ecp)) ; one more SYN
-                               (progn                 ; Not SYN
-                                 (incf (statistics-invalid-syn-count stats) (ecp-count ecp))
-                                 (setf (ecp-count ecp) 0)))
+        (ecase (ecp-state ecp)
+          (:ecp-start
+           (loop :named skip-nuls
+                 :while (and (plusp c) (zerop (aref buffer b)))
+                 :do (decf c) (incf b))
+           (setf (ecp-state ecp) :ecp-block
+                 (ecp-parity-errors ecp) 0
+                 (ecp-count ecp) 0)
+           (incf (statistics-bytes-received stats) (- count c))
+           (setf count c)
+           (process-block))
+          (:ecp-block
+           (process-block))
+          (:ecp-syn
+           ;; wait for a SYN SYN 4x sequence
+           (loop :while (and (plusp c) (eql :ecl-syn (ecp-state ecp))) :do
+             (let ((byte (logand (aref buffer b) #x7f)))
+               (if (= (ecp-count ecp) 2) ; get the 4x
+                   (progn
+                     (when cancel-nak (funcall cancel-nak))
+                     (if (and (= (aref buffer b) (even-parity byte))
+                              (= byte (+ #x40 (ecp-block-number ecp))))
+                         (progn
+                           (incf (statistics-valid-syn-count stats))
+                           (setf (ecp-state ecp) :ecp-start
+                                 (ecp-parity-errors ecp) 0
+                                 (ecp-count ecp) 0))
+                         (progn
+                           (incf (statistics-invalid-syn-count stats))
+                           (when send-nak (funcall send-nak)))))
+                   (progn
+                     (if (= (aref buffer b) (even-parity byte))
+                         (if (= byte #x16)
+                             (incf (ecp-count ecp)) ; one more SYN
+                             (progn                 ; Not SYN
+                               (incf (statistics-invalid-syn-count stats) (ecp-count ecp))
+                               (setf (ecp-count ecp) 0)))
                                         ; parity error
-                           (progn
-                             (incf (statistics-parity-errors stats))
-                             (when (= byte #x16)
-                               (incf (statistics-invalid-syn-count stats))
-                               (when send-nak (funcall send-nak)))
-                             (setf (ecp-count ecp) 0)))))
-                 (incf b)
-                 (decf c)))
-            (incf (statistics-bytes-received stats) (- count c))
-            (setf count c)))))
+                         (progn
+                           (incf (statistics-parity-errors stats))
+                           (when (= byte #x16)
+                             (incf (statistics-invalid-syn-count stats))
+                             (when send-nak (funcall send-nak)))
+                           (setf (ecp-count ecp) 0)))))
+               (incf b)
+               (decf c)))
+           (incf (statistics-bytes-received stats) (- count c))
+           (setf count c)))))
     (values nil b nil stats)))


diff --git a/languages/c11/c11-parser.lisp b/languages/c11/c11-parser.lisp
index cba3408..c0874bf 100644
--- a/languages/c11/c11-parser.lisp
+++ b/languages/c11/c11-parser.lisp
@@ -815,6 +815,7 @@
   (dolist (form (cdr (macroexpand-1 *c*)))
     (pprint form out)))

+(defvar *scanner* nil)
 (defun test/parse-stream (tokens)
   (let ((*scanner* (make-instance 'pre-scanned-scanner :tokens tokens)))
     (loop
diff --git a/languages/c11/c11-scanner.lisp b/languages/c11/c11-scanner.lisp
index 0edb8ce..5c8e7ed 100644
--- a/languages/c11/c11-scanner.lisp
+++ b/languages/c11/c11-scanner.lisp
@@ -104,6 +104,7 @@
      (oct        "0[0-7]+[uUlL]*")
      (dec        "[0-9]+[uUlL]*"))))

+(defvar *context*)
 (defun compute-token-kind (token)
   (let ((text  (token-text token)))
     (or (gethash text *c11-literal-tokens-map*)
diff --git a/languages/c11/context.lisp b/languages/c11/context.lisp
index d382063..c75b409 100644
--- a/languages/c11/context.lisp
+++ b/languages/c11/context.lisp
@@ -31,7 +31,7 @@
 ;;;;    You should have received a copy of the GNU Affero General Public License
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************
-(in-package "COM.INFORMATIMAGO.LANGUAGES.C11.PARSER")
+(in-package "COM.INFORMATIMAGO.LANGUAGES.C11.CONTEXT")

 (defclass context ()
   ((c-identifiers-package :initarg :c-identifiers-package
@@ -79,7 +79,7 @@ The scanner uses it to detect enumeration_constant tokens."
        (gethash (token-symbol name) table)))

 (defun enter-into-table (context table kind name definition)
-  (declare (ignore context))
+  (declare (ignore context kind))
   (assert (eq '|identifier| (token-kind name)) (name))
   (setf (gethash (token-symbol name) table) definition))

@@ -105,3 +105,4 @@ The scanner uses it to detect enumeration_constant tokens."
     (enter-into-table context (context-enumeration-constants context) '|enum_name| name definition)))

 ;;;; THE END ;;;;
+
diff --git a/languages/c11/packages.lisp b/languages/c11/packages.lisp
index 463d9c0..79fb315 100644
--- a/languages/c11/packages.lisp
+++ b/languages/c11/packages.lisp
@@ -51,6 +51,18 @@
            "<" ">" "=" "^" "|" "?" "STAR")
   (:documentation "This package exports the token-kinds of the C11 terminal symbols."))

+(defpackage "COM.INFORMATIMAGO.LANGUAGES.C11.CONTEXT"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.LANGUAGES.CPP"
+        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS"
+        "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER")
+  (:export "CONTEXT" "CONTEXT-C-IDENTIFIERS-PACKAGE"
+           "CONTEXT-TYPEDEFS" "CONTEXT-FUNCTIONS" "CONTEXT-ENUMERATION-CONSTANTS"
+           "CONTEXT-DECLARATION-SPECIFIERS" "*CONTEXT*" "TYPEDEF-NAME-P"
+           "FUNCTION-NAME-P" "ENUMERATION-CONSTANT-NAME-P"
+           "IDENTIFIER-IN-TABLE-P" "ENTER-TYPEDEF" "ENTER-FUNCTION"
+           "ENTER-ENUMERATION-CONSTANT"))
+
 (defpackage "COM.INFORMATIMAGO.LANGUAGES.C11.SCANNER"
   (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.LIST"
@@ -58,7 +70,8 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER"
         "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
-        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS")
+        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS"
+        "COM.INFORMATIMAGO.LANGUAGES.C11.CONTEXT")
   (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
                           "SPLIT-STRING")
   (:export "C11-SCANNER"
@@ -74,7 +87,8 @@
         "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
         "COM.INFORMATIMAGO.LANGUAGES.CPP"
         "COM.INFORMATIMAGO.TOOLS.READER-MACRO"
-        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS")
+        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS"
+        "COM.INFORMATIMAGO.LANGUAGES.C11.CONTEXT")
   (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
                           "SPLIT-STRING")
   (:export "C11-SCANNER" "READ-YACC")
@@ -95,7 +109,8 @@ returning a yacc:defgrammar form.
         "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
         "COM.INFORMATIMAGO.LANGUAGES.CPP"
         "COM.INFORMATIMAGO.TOOLS.READER-MACRO"
-        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS")
+        "COM.INFORMATIMAGO.LANGUAGES.C11.TOKENS"
+        "COM.INFORMATIMAGO.LANGUAGES.C11.CONTEXT")
   (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.REGEXP.REGEXP"
                           "SPLIT-STRING")
   (:export "C11-PARSER"))
diff --git a/languages/c11/read-yacc.lisp b/languages/c11/read-yacc.lisp
index 226803f..e2b7bd7 100644
--- a/languages/c11/read-yacc.lisp
+++ b/languages/c11/read-yacc.lisp
@@ -41,9 +41,7 @@
       :with length := (length text)
       :with state  := :top
       :with chunks := '()
-      :with start  := (ecase state
-                        (:top 0)
-                        (:in-multiline-comment length))
+      :with start  := 0
       :with i := 0
       :while (< i length)
       :do (let ((ch (aref text i)))
ViewGit