Added actions.lisp

Pascal J. Bourguignon [2015-07-16 22:11]
Added actions.lisp
Filename
languages/c11/actions.lisp
languages/c11/com.informatimago.languages.c11.asd
languages/c11/parser.lisp
languages/c11/scanner.lisp
languages/c11/scratch.lisp
diff --git a/languages/c11/actions.lisp b/languages/c11/actions.lisp
index 3d349db..f58cf74 100644
--- a/languages/c11/actions.lisp
+++ b/languages/c11/actions.lisp
@@ -39,4 +39,12 @@
 (defun c-declaration (specifiers init-declarators semicolon)
   (print (list 'specifiers  specifiers))
   (print (list 'init-declarators init-declarators))
+  (finish-output)
   (list specifiers init-declarators semicolon))
+
+(defun c-trace (&rest sentence)
+  (print sentence)
+  (finish-output)
+  sentence)
+
+;;;; THE END ;;;;
diff --git a/languages/c11/com.informatimago.languages.c11.asd b/languages/c11/com.informatimago.languages.c11.asd
index e5176b0..48261cc 100644
--- a/languages/c11/com.informatimago.languages.c11.asd
+++ b/languages/c11/com.informatimago.languages.c11.asd
@@ -57,11 +57,13 @@
   :components ((:file "packages"        :depends-on  ())
                (:file "context"         :depends-on  ("packages"))
                (:file "scanner"         :depends-on  ("packages" "context"))
-               (:file "read-yacc"       :depends-on  ("packages" ))
+               (:file "read-yacc"       :depends-on  ("packages"))
+               (:file "actions"         :depends-on  ("packages"))
                (:file "parser"          :depends-on  ("packages"
                                                       "read-yacc"
                                                       "context"
-                                                      "scanner")))
+                                                      "scanner"
+                                                      "actions")))
   :in-order-to ((asdf:test-op (asdf:test-op "com.informatimago.languages.c11.test"))))

 ;;;; THE END ;;;;
diff --git a/languages/c11/parser.lisp b/languages/c11/parser.lisp
index 7008b83..4c11b35 100644
--- a/languages/c11/parser.lisp
+++ b/languages/c11/parser.lisp
@@ -58,12 +58,17 @@ token
 |#


-(defun c-declaration (specifiers init-declarators semicolon)
-  (print (list 'specifiers  specifiers))
-  (print (list 'init-declarators init-declarators))
-  (list specifiers init-declarators semicolon))
+(defun make-list-lexer (tokens)
+  (lambda ()
+    (if tokens
+        (let ((token (pop tokens)))
+          (values (setf (token-kind token) (compute-token-kind token))
+                  token))
+        (values nil nil))))

-;; #-(and) ; not yet.
+
+
+#-(and) ; not yet.
 (DEFINE-PARSER *C11-PARSER*

   (:START-SYMBOL |translation_unit|)
@@ -290,32 +295,30 @@ token
    |conditional_expression|)

   (|declaration|
-   (|declaration_specifiers| \;)
-   (|declaration_specifiers| |init_declarator_list| \; #'c-declaration)
-   |static_assert_declaration|)
+   (|declaration_specifiers| |init_declarator_list| \;  #|#'c-trace|#) ; #'c-declaration
+   (|declaration_specifiers| \;                         #|#'c-trace|#)
+   (|static_assert_declaration|                         #|#'c-trace|#))

-  (|declaration_specifiers|
-   (|storage_class_specifier| |declaration_specifiers|)
+  (|declaration_specifier|
    |storage_class_specifier|
-   (|type_specifier| |declaration_specifiers|)
-   |type_specifier|
-   (|type_qualifier| |declaration_specifiers|)
-   |type_qualifier|
-   (|function_specifier| |declaration_specifiers|)
-   |function_specifier|
-   (|alignment_specifier| |declaration_specifiers|)
+   |type_specifier|
+   |type_qualifier|
+   |function_specifier|
    |alignment_specifier|)
+
+  (|declaration_specifiers|
+   (|declaration_specifier|)
+   (|declaration_specifiers| |declaration_specifier|  #|#'c-trace|#))

   (|init_declarator_list|
-   |init_declarator|
+   (|init_declarator|)
    (|init_declarator_list| \, |init_declarator|))

   (|init_declarator|
-   (|declarator| = |initializer|)
-   |declarator|)
+   (|declarator| = |initializer| #|#'c-trace|#)
+   (|declarator|                 #|#'c-trace|#))

   (|storage_class_specifier| TYPEDEF EXTERN STATIC THREAD_LOCAL AUTO REGISTER)
-
   (|type_specifier| VOID CHAR SHORT INT LONG FLOAT DOUBLE SIGNED UNSIGNED BOOL
                     COMPLEX IMAGINARY |atomic_type_specifier| |struct_or_union_specifier|
                     |enum_specifier| TYPEDEF_NAME)
@@ -378,11 +381,11 @@ token
    (ALIGNAS \( |constant_expression| \)))

   (|declarator|
-   (|pointer| |direct_declarator|)
-   |direct_declarator|)
+   (|pointer| |direct_declarator|    #|#'c-trace|#)
+   (|direct_declarator|              #|#'c-trace|#))

   (|direct_declarator|
-   IDENTIFIER
+   (IDENTIFIER                       #|#'c-trace|#)
    (\( |declarator| \))
    (|direct_declarator| \[ \])
    (|direct_declarator| \[ * \])
@@ -546,13 +549,6 @@ token
    (|declaration_list| |declaration|)))


-(defun make-list-lexer (tokens)
-  (lambda ()
-    (if tokens
-        (let ((token (pop tokens)))
-          (values (setf (token-kind token) (compute-token-kind token))
-                  token))
-        (values nil nil))))

 #-(and)
 (let ((*context* (make-instance 'context)))
diff --git a/languages/c11/scanner.lisp b/languages/c11/scanner.lisp
index 62e5681..ab93a4a 100644
--- a/languages/c11/scanner.lisp
+++ b/languages/c11/scanner.lisp
@@ -32,7 +32,8 @@
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************
 (in-package "COM.INFORMATIMAGO.LANGUAGES.C11.PARSER")
-
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))

 #-(and) ; we use the cpp-scanner.
 (define-scanner c11-scanner
@@ -122,78 +123,4 @@
                 (t kind))
               kind)))))

-;; (untrace compute-token-kind)
-#-(and)
-(defparameter *tc*
-  (mapcar (lambda (token)
-            (setf (token-kind token) (compute-token-kind token))
-            token)
-          (reduce (function append)
-                  (reverse (com.informatimago.languages.cpp::context-output-lines
-                            (let ((*identifier-package*
-                                    (load-time-value (find-package "COM.INFORMATIMAGO.LANGUAGES.C11.C"))))
-                              (cpp-e "/Users/pjb/src/public/lisp/languages/cpp/tests/emacs.c"
-                                     :trace-includes t
-                                     :defines '("__GNUC__" "4" "__STDC__" "1" "__x86_64__" "1")
-                                     :includes '("/Users/pjb/src/macosx/emacs-24.5/src/")
-                                     :include-bracket-directories '("/Users/pjb/src/macosx/emacs-24.5/src/"
-                                                                    "/Users/pjb/src/macosx/emacs-24.5/lib/"
-                                                                    "/Users/pjb/src/macosx/gcc-4.9.2/gcc/ginclude/"
-                                                                    "/usr/include/")
-                                     :write-processed-lines nil))))
-                  :initial-value '())))
-
-
-#-(and) (
-         (mapcar 'compute-token-kind (subseq *tc* 0 100))
-         (|typedef| |unsigned| |int| identifier \; |typedef| |signed| |char| identifier \; |typedef| |unsigned| |char| identifier \; |typedef| |short| identifier \; |typedef| |unsigned| |short| identifier \; |typedef| |int| identifier \; |typedef| |unsigned| |int| identifier \; |typedef| |long| |long| identifier \; |typedef| |unsigned| |long| |long| identifier \; |typedef| |long| identifier \; |typedef| |unsigned| |int| identifier \; |typedef| |int| identifier \; |typedef| |union| { |char| identifier [ dec ] \; |long| |long| identifier \; } identifier \; |typedef| identifier identifier \; |typedef| |int| identifier \; |typedef| |unsigned| |long| identifier \; |typedef| |__builtin_va_list| identifier \; |typedef| identifier identifier \; |typedef| identifier identifier \; |typedef| identifier)
-
-         ("typedef" "unsigned" "int" "bool_bf" ";" "typedef" "signed" "char" "__int8_t" ";" "typedef" "unsigned" "char" "__uint8_t" ";" "typedef" "short" "__int16_t" ";" "typedef" "unsigned" "short" "__uint16_t" ";" "typedef" "int" "__int32_t" ";" "typedef" "unsigned" "int" "__uint32_t" ";" "typedef" "long" "long" "__int64_t" ";" "typedef" "unsigned" "long" "long" "__uint64_t" ";" "typedef" "long" "__darwin_intptr_t" ";" "typedef" "unsigned" "int" "__darwin_natural_t" ";" "typedef" "int" "__darwin_ct_rune_t" ";" "typedef" "union" "{" "char" "__mbstate8" "[" "128" "]" ";" "long" "long" "_mbstateL" ";" "}" "__mbstate_t" ";" "typedef" "__mbstate_t" "__darwin_mbstate_t" ";" "typedef" "int" "__darwin_ptrdiff_t" ";" "typedef" "unsigned" "long" "__darwin_size_t" ";" "typedef" "__builtin_va_list" "__darwin_va_list" ";" "typedef" "__darwin_ct_rune_t" "__darwin_wchar_t" ";" "typedef" "__darwin_wchar_t" "__darwin_rune_t" ";" "typedef" "__darwin_ct_rune_t")
-
-
-
-         (let ((*readtable*               vacietis:c-readtable)
-               (vacietis:*compiler-state* (vacietis:make-compiler-state)))
-           (with-open-file (src #P"~/src/lisp/c/duff-device.c")
-             (read src)))
-
-         (defparameter *s* (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
-                                                                #P"~/src/public/lisp/languages/cpp/tests/out.c")))
-         (defparameter *t*
-           (let ((scanner  (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
-                                                                #P"~/src/public/lisp/languages/cpp/tests/out.c"))))
-             (loop for token =  (scan-next-token scanner)
-                   until (eq (token-kind token) 'com.informatimago.common-lisp.parser.scanner::<END\ OF\ SOURCE>)
-                   collect (print token))))
-
-         (defparameter *tc*
-           (mapcar (lambda (token)
-                     (setf (token-kind token) (compute-token-kind token))
-                     token)
-                   (reduce (function append)
-                           (reverse (com.informatimago.languages.cpp::context-output-lines
-                                     (let ((*identifier-package*
-                                             (load-time-value (find-package "COM.INFORMATIMAGO.LANGUAGES.C11.C"))))
-                                       (cpp-e "/Users/pjb/src/public/lisp/languages/cpp/tests/emacs.c"
-                                              :trace-includes t
-                                              :defines '("__GNUC__" "4" "__STDC__" "1" "__x86_64__" "1")
-                                              :includes '("/Users/pjb/src/macosx/emacs-24.5/src/")
-                                              :include-bracket-directories '("/Users/pjb/src/macosx/emacs-24.5/src/"
-                                                                             "/Users/pjb/src/macosx/emacs-24.5/lib/"
-                                                                             "/Users/pjb/src/macosx/gcc-4.9.2/gcc/ginclude/"
-                                                                             "/usr/include/")
-                                              :write-processed-lines nil))))
-                           :initial-value '())))
-
-         (dolist (token *tc*)
-           (setf (token-kind token) (compute-token-kind token)))
-
-         (defparameter *yacc*
-           (let ((scanner  (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
-                                                                #P"scanner.yacc"))))
-             (loop for token =  (scan-next-token scanner)
-                   until (eq (token-kind token) 'com.informatimago.common-lisp.parser.scanner::<END\ OF\ SOURCE>)
-                   collect (print token))))
-
-         )
 ;;;; THE END ;;;;
diff --git a/languages/c11/scratch.lisp b/languages/c11/scratch.lisp
new file mode 100644
index 0000000..5b9c1b6
--- /dev/null
+++ b/languages/c11/scratch.lisp
@@ -0,0 +1,85 @@
+(in-package "COM.INFORMATIMAGO.LANGUAGES.C11.PARSER")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil)))
+
+
+;; (untrace compute-token-kind)
+;; 7 seconds.
+(defparameter *tc*
+  (mapcar (lambda (token)
+            (setf (token-kind token) (compute-token-kind token))
+            token)
+          (reduce (function append)
+                  (reverse (com.informatimago.languages.cpp::context-output-lines
+                            (let ((*identifier-package*
+                                    (load-time-value (find-package "COM.INFORMATIMAGO.LANGUAGES.C11.C"))))
+                              (cpp-e "/Users/pjb/src/public/lisp/languages/cpp/tests/emacs.c"
+                                     :trace-includes t
+                                     :defines '("__GNUC__" "4" "__STDC__" "1" "__x86_64__" "1")
+                                     :includes '("/Users/pjb/src/macosx/emacs-24.5/src/")
+                                     :include-bracket-directories '("/Users/pjb/src/macosx/emacs-24.5/src/"
+                                                                    "/Users/pjb/src/macosx/emacs-24.5/lib/"
+                                                                    "/Users/pjb/src/macosx/gcc-4.9.2/gcc/ginclude/"
+                                                                    "/usr/include/")
+                                     :write-processed-lines nil))))
+                  :initial-value '())))
+
+
+(let ((*context* (make-instance 'context)))
+  (values (parse-with-lexer (make-list-lexer *tc*) *c11-parser*)
+          *context*))
+
+
+
+#-(and) (
+         (mapcar 'compute-token-kind (subseq *tc* 0 100))
+         (|typedef| |unsigned| |int| identifier \; |typedef| |signed| |char| identifier \; |typedef| |unsigned| |char| identifier \; |typedef| |short| identifier \; |typedef| |unsigned| |short| identifier \; |typedef| |int| identifier \; |typedef| |unsigned| |int| identifier \; |typedef| |long| |long| identifier \; |typedef| |unsigned| |long| |long| identifier \; |typedef| |long| identifier \; |typedef| |unsigned| |int| identifier \; |typedef| |int| identifier \; |typedef| |union| { |char| identifier [ dec ] \; |long| |long| identifier \; } identifier \; |typedef| identifier identifier \; |typedef| |int| identifier \; |typedef| |unsigned| |long| identifier \; |typedef| |__builtin_va_list| identifier \; |typedef| identifier identifier \; |typedef| identifier identifier \; |typedef| identifier)
+
+         ("typedef" "unsigned" "int" "bool_bf" ";" "typedef" "signed" "char" "__int8_t" ";" "typedef" "unsigned" "char" "__uint8_t" ";" "typedef" "short" "__int16_t" ";" "typedef" "unsigned" "short" "__uint16_t" ";" "typedef" "int" "__int32_t" ";" "typedef" "unsigned" "int" "__uint32_t" ";" "typedef" "long" "long" "__int64_t" ";" "typedef" "unsigned" "long" "long" "__uint64_t" ";" "typedef" "long" "__darwin_intptr_t" ";" "typedef" "unsigned" "int" "__darwin_natural_t" ";" "typedef" "int" "__darwin_ct_rune_t" ";" "typedef" "union" "{" "char" "__mbstate8" "[" "128" "]" ";" "long" "long" "_mbstateL" ";" "}" "__mbstate_t" ";" "typedef" "__mbstate_t" "__darwin_mbstate_t" ";" "typedef" "int" "__darwin_ptrdiff_t" ";" "typedef" "unsigned" "long" "__darwin_size_t" ";" "typedef" "__builtin_va_list" "__darwin_va_list" ";" "typedef" "__darwin_ct_rune_t" "__darwin_wchar_t" ";" "typedef" "__darwin_wchar_t" "__darwin_rune_t" ";" "typedef" "__darwin_ct_rune_t")
+
+
+
+         (let ((*readtable*               vacietis:c-readtable)
+               (vacietis:*compiler-state* (vacietis:make-compiler-state)))
+           (with-open-file (src #P"~/src/lisp/c/duff-device.c")
+             (read src)))
+
+         (defparameter *s* (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
+                                                                #P"~/src/public/lisp/languages/cpp/tests/out.c")))
+         (defparameter *t*
+           (let ((scanner  (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
+                                                                #P"~/src/public/lisp/languages/cpp/tests/out.c"))))
+             (loop for token =  (scan-next-token scanner)
+                   until (eq (token-kind token) 'com.informatimago.common-lisp.parser.scanner::<END\ OF\ SOURCE>)
+                   collect (print token))))
+
+         (defparameter *tc*
+           (mapcar (lambda (token)
+                     (setf (token-kind token) (compute-token-kind token))
+                     token)
+                   (reduce (function append)
+                           (reverse (com.informatimago.languages.cpp::context-output-lines
+                                     (let ((*identifier-package*
+                                             (load-time-value (find-package "COM.INFORMATIMAGO.LANGUAGES.C11.C"))))
+                                       (cpp-e "/Users/pjb/src/public/lisp/languages/cpp/tests/emacs.c"
+                                              :trace-includes t
+                                              :defines '("__GNUC__" "4" "__STDC__" "1" "__x86_64__" "1")
+                                              :includes '("/Users/pjb/src/macosx/emacs-24.5/src/")
+                                              :include-bracket-directories '("/Users/pjb/src/macosx/emacs-24.5/src/"
+                                                                             "/Users/pjb/src/macosx/emacs-24.5/lib/"
+                                                                             "/Users/pjb/src/macosx/gcc-4.9.2/gcc/ginclude/"
+                                                                             "/usr/include/")
+                                              :write-processed-lines nil))))
+                           :initial-value '())))
+
+         (dolist (token *tc*)
+           (setf (token-kind token) (compute-token-kind token)))
+
+         (defparameter *yacc*
+           (let ((scanner  (make-instance 'c11-scanner :source (com.informatimago.common-lisp.cesarum.file:text-file-contents
+                                                                #P"scanner.yacc"))))
+             (loop for token =  (scan-next-token scanner)
+                   until (eq (token-kind token) 'com.informatimago.common-lisp.parser.scanner::<END\ OF\ SOURCE>)
+                   collect (print token))))
+
+         )
ViewGit