LCP: Split up PROCESS-FILE

Summary:
Split up `process-file` so that looking at the generated code for an LCP form is
easier from the REPL.

`process-lcp`, `generate-hpp` and `generate-cpp` now perform the generation of
C++ code, but take a list of "C++ elements" (the results of LCP forms) as input
and write their output to streams. They do no reading/evaluating of LCP forms of
their own.

`read-lcp` and `read-lcp-file` are used to read and evaluate a stream of LCP
forms. The latter is a specialized version for file streams which also reports
the position of the form within the file when an error happens.

`process-lcp-string` and `process-lcp-file` are convenient wrappers around the
main functionality that take a string (file) and output to strings (files).
Using `read-lcp` and `read-lcp-file` they process LCP forms and pass them off to
`process-lcp` for code generation.

Reviewers: mtomic, teon.banek

Reviewed By: teon.banek

Subscribers: pullbot

Differential Revision: https://phabricator.memgraph.io/D2097

src/lisp/lcp.lisp

@@ -225,6 +225,10 @@ included in the method declaration."
      ${returns} ${namespace}${method-name}(${args}) ${const} ${override} ${delete}
      cpp<#)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; C++ elements
+
 (defstruct cpp-list
   values)
 
@@ -278,71 +282,64 @@ included in the method declaration."
           (append *cpp-impl* (mapcar (lambda (cpp) (cons namespaces cpp))
                                      args)))))
 
-(defun read-lcp (filepath)
+(defun process-lcp (cpp-elements &key cpp hpp lcp-file hpp-file cpp-file slk-serialize-p)
-  "Read the file FILEPATH and return a list of C++ meta information that should
+  "Process a list of C++ elements.
-be formatted and output."
-  (with-open-file (in-stream filepath)
-    (let ((*readtable* (named-readtables:find-readtable 'lcp-syntax))
-          (stream-pos 0))
-      (handler-case
-          (loop :for form := (read-preserving-whitespace in-stream nil 'eof)
-                :until (eq form 'eof)
-                :for res := (handler-case (eval form)
-                              (error (err)
-                                ;; Seek to the start of the stream.
-                                (file-position in-stream 0)
-                                (error "~%~A:~A: error:~2%~A~2%in:~2%~A"
-                                       (uiop:native-namestring filepath)
-                                       (count-newlines
-                                        in-stream
-                                        :stop-position (1+ stream-pos))
-                                       err form)))
-                :do (setf stream-pos (file-position in-stream))
-                :when (typep res '(or raw-cpp cpp-type cpp-list))
-                  :collect res)
-        (end-of-file ()
-          ;; Seek to the start of the stream.
-          (file-position in-stream 0)
-          (error "~%~A:~A:error: READ error, did you forget a closing ')'?"
-                 (uiop:native-namestring filepath)
-                 (count-newlines in-stream :stop-position (1+ stream-pos))))))))
 
-(defun process-file (lcp-file &key slk-serialize)
+To process a C++ element means to generate code for it and any of the
-  "Process a LCP-FILE and write the output to .hpp file in the same directory."
+additional functionalities that have been specified.
-  (multiple-value-bind (filename extension)
+
-      (uiop:split-name-type lcp-file)
+A C++ element can be:
-    (assert (string= (string-downcase extension) "lcp"))
+
-    (let ((hpp-file (concatenate 'string filename ".hpp"))
+- an instance of CPP-CLASS or CPP-ENUM (e.g. returned by DEFINE-CLASS or
-          ;; Unlike hpp, for cpp file use the full path. This allows us to
+  DEFINE-ENUM) -- specifies the definition of a C++ class or enum, along with
-          ;; have our own accompanying .cpp files
+  any additional functionality
-          (cpp-file (concatenate 'string lcp-file ".cpp"))
+
-          (serializep slk-serialize)
+- an instance of RAW-CPP -- specifies raw C++ code to include into the generated
-          ;; Reset globals
+  code
-          (*cpp-inner-types* nil)
+
-          (*cpp-impl*)
+- an instance of CPP-LIST -- specifies a list of C++ elements which are
-          ;; Don't reset *cpp-classes* if we want to have support for
+  processed recursively
-          ;; procesing multiple files.
+
-          ;; (*cpp-classes* nil)
+CPP and HPP are streams to which the generated hpp and cpp code will be output.
-          ;; (*cpp-enums* nil)
+Note that these can be any streams, not just file streams.
-          )
+
-      ;; First read and evaluate the whole file, then output the evaluated
+LCP-FILE, HPP-FILE and CPP-FILE are pathname designators that will be used for
-      ;; cpp-code. This allows us to generate code which may rely on
+the purposes of C++ includes or other such functionality. They can be omitted,
-      ;; evaluation done after the code definition.
+in which case the string \"<UNKNOWN>\" will be used.
-      (with-open-file (out hpp-file :direction :output :if-exists :supersede)
+
+SLK-SERIALIZE-P determines whether SLK serialization code is generated."
+  (generate-hpp cpp-elements hpp
+                :lcp-file lcp-file
+                :hpp-file hpp-file
+                :cpp-file cpp-file
+                :slk-serialize-p slk-serialize-p)
+  ;; NOTE: Some code may rely on the fact that the .cpp file is generated after
+  ;; the .hpp.
+  (let ((*generating-cpp-impl-p* t))
+    (generate-cpp cpp-elements cpp
+                  :lcp-file lcp-file
+                  :hpp-file hpp-file
+                  :cpp-file cpp-file
+                  :slk-serialize-p slk-serialize-p)))
+
+(defun generate-hpp (cpp-elements out &key lcp-file hpp-file cpp-file slk-serialize-p)
+  "Process a list of C++ elements to generate C++ header file code.
+
+OUT is a stream to write the generated code to.
+
+LCP-FILE, HPP-FILE, CPP-FILE and SLK-SERIALIZE-P are as in PROCESS-LCP."
+  (declare (ignore hpp-file cpp-file))
   (format out "~@{// ~A~%~}" +emacs-read-only+ +vim-read-only+)
   (format out "// DO NOT EDIT! Generated using LCP from '~A'~2%"
-                (file-namestring lcp-file))
+          (or lcp-file "<UNKNOWN>"))
-        (dolist (res (read-lcp lcp-file))
+  (dolist (res cpp-elements)
-          (write-line (cpp-code res) out)))
+    (write-line (cpp-code res) out))
-      (when *cpp-namespaces*
+  (alexandria:when-let
-        (error "Unclosed namespaces: ~A" (reverse *cpp-namespaces*)))
+      ((types-for-slk
-      ;; Collect types for serialization
+        (when slk-serialize-p
-      (let ((types-for-slk (when serializep
           (append (remove-if (complement #'cpp-class-slk-opts) *cpp-classes*)
                   (remove-if (complement #'cpp-enum-serializep) *cpp-enums*)))))
-        (when types-for-slk
     ;; Append top-level declarations for SLK serialization
-          (with-open-file (out hpp-file :direction :output :if-exists :append)
     (terpri out)
     (write-line "// SLK serialization declarations" out)
     (write-line "#include \"slk/serialization.hpp\"" out)
@@ -360,14 +357,18 @@ be formatted and output."
           (cpp-enum
            (format out "~A;~%" (lcp.slk:save-function-declaration-for-enum type-for-slk))
            (format out "~A;~%" (lcp.slk:load-function-declaration-for-enum type-for-slk))))))))
-        ;; Generate the .cpp file.  Note, that some code may rely on the fact
+
-        ;; that .cpp file is generated after .hpp.
+(defun generate-cpp (cpp-elements out &key lcp-file hpp-file cpp-file slk-serialize-p)
-        (let ((*generating-cpp-impl-p* t))
+  "Process a list of C++ elements to generate C++ source file code.
-          (with-open-file (out cpp-file :direction :output :if-exists :supersede)
+
+OUT is a stream to write the generated code to.
+
+LCP-FILE, HPP-FILE, CPP-FILE and SLK-SERIALIZE-P are as in PROCESS-LCP."
+  (declare (ignore cpp-elements cpp-file))
   (format out "~@{// ~A~%~}" +emacs-read-only+ +vim-read-only+)
   (format out "// DO NOT EDIT! Generated using LCP from '~A'~2%"
-                    (file-namestring lcp-file))
+          (or lcp-file "<UNKNOWN>"))
-            (format out "#include \"~A\"~2%" (file-namestring hpp-file))
+  (format out "#include \"~A\"~2%" (or hpp-file "<UNKNOWN>"))
   ;; First output the C++ code from the user
   (with-namespaced-output (out open-namespace)
     (dolist (cpp *cpp-impl*)
@@ -375,7 +376,11 @@ be formatted and output."
         (open-namespace namespaces)
         (write-line (cpp-code code) out))))
   ;; Generate SLK serialization
-            (when types-for-slk
+  (alexandria:when-let
+      ((types-for-slk
+        (when slk-serialize-p
+          (append (remove-if (complement #'cpp-class-slk-opts) *cpp-classes*)
+                  (remove-if (complement #'cpp-enum-serializep) *cpp-enums*)))))
     (write-line "// Autogenerated SLK serialization code" out)
     (with-namespaced-output (out open-namespace)
       (open-namespace '("slk"))
@@ -392,4 +397,142 @@ be formatted and output."
              (write-line (lcp.slk:load-function-definition-for-class cpp-type) out)))
           (cpp-enum
            (write-line (lcp.slk:save-function-definition-for-enum cpp-type) out)
-                     (write-line (lcp.slk:load-function-definition-for-enum cpp-type) out))))))))))))
+           (write-line (lcp.slk:load-function-definition-for-enum cpp-type) out)))))))
+
+(defun read-lcp (stream)
+  "Read and evaluate LCP forms.
+
+Forms are read from the stream STREAM and immediately evaluated, one by one. The
+given stream is read until EOF is reached. In the case of a reading error, a
+condition of type END-OF-FILE is signaled.
+
+Return a list of results."
+  (let ((*readtable* (named-readtables:find-readtable 'lcp-syntax)))
+    (loop :for form := (read-preserving-whitespace stream nil 'eof)
+          :until (eq form 'eof)
+          :for res := (eval form)
+          :when (typep res '(or raw-cpp cpp-type cpp-list))
+            :collect res)))
+
+(defun read-lcp-file (stream)
+  "Read and evaluate LCP forms from a file stream.
+
+The behavior is just as in READ-LCP, except that STREAM must be a file stream.
+The reported error messages will contain the name of the file and the line
+number on which the error ocurred.
+
+In case of a reading error, a condition of type ERROR is signaled reporting the
+file and the line number of the erroneous form.
+
+In case of an evaluation error, a condition of type ERROR is signaled reporting
+the file and the line number of the erroneous form. Additionally, a restart
+named DECLINE will be established around the newly signaled condition which can
+be used by a handler to force the signalling of the original error instead.
+
+Return a list of results."
+  (let ((filepath (pathname stream))
+        (*readtable* (named-readtables:find-readtable 'lcp-syntax))
+        (stream-pos 0))
+    (handler-case
+        (loop :for form := (read-preserving-whitespace stream nil 'eof)
+              :until (eq form 'eof)
+              :for res
+                := (decline-case (eval form)
+                     (error (err)
+                       ;; Seek to the start of the stream.
+                       (file-position stream 0)
+                       (error "~%~A:~A: error:~2%~A~2%in:~2%~A"
+                              (uiop:native-namestring filepath)
+                              (count-newlines
+                               stream
+                               :stop-position (1+ stream-pos))
+                              err form)))
+              :do (setf stream-pos (file-position stream))
+              :when (typep res '(or raw-cpp cpp-type cpp-list))
+                :collect res)
+      (end-of-file ()
+        ;; Seek to the start of the stream.
+        (file-position stream 0)
+        (error "~%~A:~A:error: READ error, did you forget a closing ')'?"
+               (uiop:native-namestring filepath)
+               (count-newlines stream :stop-position (1+ stream-pos)))))))
+
+(defun process-lcp-string (string &key slk-serialize-p)
+  "Process the C++ elements produced by reading and evaluating LCP forms from
+the string STRING.
+
+SLK-SERIALIZE-P is as in PROCESS-LCP.
+
+The generated code is returned as two values, both of which are strings. The
+strings represent the C++ source file and C++ header file code respectively."
+  (with-retry-restart (reprocess-lcp-string "Reprocess the LCP string")
+    (restart-case
+        (let* (;; Reset globals that influence the evaluation of LCP forms
+               (*cpp-inner-types* :toplevel)
+               (*cpp-impl* '())
+               (*cpp-namespaces* '())
+               (cpp-elements (with-input-from-string (lcp string)
+                               (read-lcp lcp))))
+          ;; Check for unclosed namespaces in the LCP file
+          (when *cpp-namespaces*
+            (error "Unclosed namespaces: ~A" (reverse *cpp-namespaces*)))
+          ;; Process the result
+          (with-output-to-string (hpp)
+            (with-output-to-string (cpp)
+              (process-lcp cpp-elements
+                           :cpp cpp
+                           :hpp hpp
+                           :lcp-file "<PROCESS-LCP-STRING>"
+                           :hpp-file "<PROCESS-LCP-STRING>"
+                           :cpp-file "<PROCESS-LCP-STRING>"
+                           :slk-serialize-p slk-serialize-p)
+              (return-from process-lcp-string
+                (values (get-output-stream-string hpp)
+                        (get-output-stream-string cpp))))))
+      (clean-reprocess-lcp-string ()
+        :report "Reprocess the LCP string with a clean registry"
+        (setf *cpp-classes* '()
+              *cpp-enums* '())
+        (invoke-restart 'reprocess-lcp-string)))))
+
+(defun process-lcp-file (lcp-file &key slk-serialize-p)
+  "Process the C++ elements produced by reading and evaluating LCP forms from
+the file named by the pathname designator LCP-FILE.
+
+SLK-SERIALIZE-P is as in PROCESS-LCP.
+
+The generated code is written into two files. The files are in the same
+directory as the LCP file. C++ source file code is written to
+\"<LCP-FILENAME>.lcp.cpp\" while C++ header file code is written to
+\"<LCP-FILENAME>.hpp\"."
+  (multiple-value-bind (filename extension)
+      (uiop:split-name-type lcp-file)
+    (assert (string= (string-downcase extension) "lcp"))
+    (let ((hpp-file (concatenate 'string filename ".hpp"))
+          (cpp-file (concatenate 'string lcp-file ".cpp")))
+      (with-retry-restart (reprocess-lcp-file "Reprocess the LCP file")
+        (restart-case
+            (let* (;; Reset globals that influence the evaluation of LCP forms
+                   (*cpp-inner-types* :toplevel)
+                   (*cpp-impl* '())
+                   (*cpp-namespaces* '())
+                   (cpp-elements (with-open-file (lcp lcp-file)
+                                   (read-lcp-file lcp))))
+              ;; Check for unclosed namespaces in the LCP file
+              (when *cpp-namespaces*
+                (error "Unclosed namespaces: ~A" (reverse *cpp-namespaces*)))
+              ;; Process the results
+              (with-open-file (hpp hpp-file :direction :output :if-exists :supersede)
+                (with-open-file (cpp cpp-file :direction :output :if-exists :supersede)
+                  (process-lcp cpp-elements
+                               :cpp cpp
+                               :hpp hpp
+                               :lcp-file lcp-file
+                               :hpp-file hpp-file
+                               :cpp-file cpp-file
+                               :slk-serialize-p slk-serialize-p))))
+          (clean-reprocess-lcp-file ()
+            :report "Reprocess the LCP file with a clean registry"
+            (setf *cpp-classes* '()
+                  *cpp-enums* '())
+            (invoke-restart 'reprocess-lcp-file)))))))

src/lisp/package.lisp

@@ -8,7 +8,7 @@
            #:in-impl
            #:namespace
            #:pop-namespace
-           #:process-file
+           #:process-lcp-file
            #:lcp-syntax))
 
 (defpackage #:lcp.slk

src/lisp/reader.lisp

@@ -13,7 +13,7 @@
 STRING and reports whether it was successful.
 
 If EOF-ERROR-P is T and EOF is reached before all of the characters are matched,
-an END-OF-FILE error is signalled.
+an END-OF-FILE error is signaled.
 
 Otherwise, returns 2 values, SUCCESSP and COUNT. SUCCESSP is a boolean denoting
 whether it was able to match all of the characters. COUNT is the number of

src/lisp/test.lisp

@@ -8,7 +8,7 @@
 ;;; IS-CONDITION which uses HANDLER-CASE to catch *any* condition (any subclass
 ;;; of CONDITION). This is wrong, because not every condition is an error.
 ;;; Because of this, Prove used to catch LCP's warnings and would fail because
-;;; an LCP error was expected (which would have been signalled).
+;;; an LCP error was expected (which would have been signaled).
 
 (in-package #:prove.test)
 

src/lisp/util.lisp

@@ -103,3 +103,58 @@ WARNING has been established. The handler muffles the warning by calling
 MUFFLE-WARNING."
   `(handler-bind ((warning #'muffle-warning))
      ,@body))
+
+(defmacro with-retry-restart ((restart format-string
+                               &optional (format-arguments nil format-arguments-p))
+                              &body body)
+  "Set up a restart as if by WITH-SIMPLE-RESTART, but with retry behavior. The
+restart can be used to re-execute BODY an arbitrary number of times. The most
+common use case is restarting the execution of some BODY until it succeeds, i.e.
+finishes without any errors.
+
+RESTART, FORMAT-STRING, FORMAT-ARGUMENTS and BODY are as in WITH-SIMPLE-RESTART.
+The value produced by the implicit progn BODY is returned."
+  (alexandria:with-gensyms (block)
+    `(loop :named ,block :do
+      (with-simple-restart (,restart
+                            ,format-string
+                            ,@(when format-arguments-p format-arguments))
+        (return-from ,block
+          (progn ,@body))))))
+
+(defun generate-decline-case-handlers (block clauses)
+  (loop :for (type lambda-list . body) :in clauses
+        :for c := (first lambda-list)
+        :for condition := (or c (gensym (string 'condition)))
+        :for fbody
+          := `(,@(unless c
+                   `((declare (ignore ,condition))))
+               (with-simple-restart (decline "Decline the condition")
+                 (return-from ,block
+                   (progn ,@body))))
+        :collect `(lambda (,condition) ,@fbody)))
+
+(defmacro decline-case (form &body clauses)
+  "Bind a number of condition handlers but allow the handlers to decline the
+handling at any time by invoking a special restart. The behavior is a hybrid of
+HANDLER-BIND and HANDLER-CASE.
+
+Once a handler has been found, its body is executed without performing a
+transfer of control (HANDLER-BIND-like). However, if the execution of the body
+finishes normally (without transferring control), control is transferred to the
+first form after DECLINE-CASE (HANDLER-CASE-like).
+
+The declining functionality is provided by establishing a restart named DECLINE
+around the body of the handler. At any point within the body of the handler,
+invoking the restart will decline the handling of the condition, transferring
+control back to the signalling function in search of a new handler.
+
+FORM and CLAUSES are as in HANDLER-CASE. The value produced by the form FORM is
+returned in case a condition, if any, isn't handled. Otherwise, the value of the
+last form within the body of the corresponding handler is returned."
+  (alexandria:with-gensyms (block)
+    (let ((types (mapcar #'first clauses))
+          (handlers (generate-decline-case-handlers block clauses)))
+      `(block ,block
+         (handler-bind (,@(mapcar #'list types handlers))
+           ,form)))))

tools/lcp

@@ -28,7 +28,7 @@ fi
 
 slk_serialize=""
 if [[ "$2" == "SLK_SERIALIZE" ]]; then
-  slk_serialize=":slk-serialize t"
+  slk_serialize=":slk-serialize-p t"
 fi
 
 if [[ $debug == "true" ]]; then
@@ -37,14 +37,14 @@ if [[ $debug == "true" ]]; then
   (load \"${quicklisp_install_dir}/setup.lisp\")
   (ql:quickload :lcp :silent t)
   (let ((*debugger-hook* #'lcp.debug:lcp-debugger-hook))
-    (lcp:process-file \"$lcp_file\" $slk_serialize))
+    (lcp:process-lcp-file \"$lcp_file\" $slk_serialize))
   " | sbcl --noinform --noprint
 else
   echo \
   "
   (load \"${quicklisp_install_dir}/setup.lisp\")
   (ql:quickload :lcp :silent t)
-  (lcp:process-file \"$lcp_file\" $slk_serialize)
+  (lcp:process-lcp-file \"$lcp_file\" $slk_serialize)
   " | sbcl --script
 fi