LCP: Use named-readtables

Reviewers: teon.banek

Reviewed By: teon.banek

Subscribers: pullbot

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

src/lisp/lcp-test.lisp

@@ -2,6 +2,7 @@
   (:use #:cl #:prove))
 
 (in-package #:lcp-test)
+(named-readtables:in-readtable lcp:lcp-syntax)
 
 (defun same-type-test (a b)
   "Test whether A and B are the same C++ type under LCP::CPP-TYPE=."

src/lisp/lcp.asd

@@ -2,9 +2,10 @@
   :description "LCP: The Lisp C++ Preprocessor"
   :version "0.0.1"
   :author "Teon Banek <teon.banek@memgraph.io>"
-  :depends-on ("cl-ppcre")
+  :depends-on ("cl-ppcre" "named-readtables")
   :serial t
   :components ((:file "package")
+               (:file "reader")
                (:file "types")
                (:file "code-gen")
                (:file "slk")

src/lisp/lcp.lisp

@@ -2,6 +2,7 @@
 ;;; C++ code.
 
 (in-package #:lcp)
+(named-readtables:in-readtable lcp-syntax)
 
 (defvar +vim-read-only+ "vim: readonly")
 (defvar +emacs-read-only+ "-*- buffer-read-only: t; -*-")
@@ -9,9 +10,6 @@
 (defvar *generating-cpp-impl-p* nil
   "T if we are currently writing the .cpp file.")
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (set-dispatch-macro-character #\# #\> #'|#>-reader|))
-
 (defun fnv1a64-hash-string (string)
   "Produce (UNSIGNED-BYTE 64) hash of the given STRING using FNV-1a algorithm.
 See https://en.wikipedia.org/wiki/Fowler_Noll_Vo_hash."
@@ -1385,7 +1383,8 @@ enums which aren't defined in LCP."
   "Read the FILEPATH and return a list of C++ meta information that should be
 formatted and output."
   (with-open-file (in-stream filepath)
-    (let ((stream-pos 0))
+    (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)

src/lisp/package.lisp

@@ -17,7 +17,8 @@
            #:capnp-load-vector
            #:capnp-save-enum
            #:capnp-load-enum
-           #:process-file))
+           #:process-file
+           #:lcp-syntax))
 
 (defpackage #:lcp.slk
   (:use #:cl)

src/lisp/reader.lisp

@@ -0,0 +1,95 @@
+(in-package #:lcp)
+
+(defstruct raw-cpp
+  "Represents a raw character string of C++ code."
+  (string "" :type string :read-only t))
+
+(defvar +whitespace-chars+
+  '(#\Newline #\Space #\Return #\Linefeed #\Tab #\Page))
+
+(defun read-expecting (string &optional (stream *standard-input*)
+                                (eof-error-p t) recursivep)
+  "Tries to read from STREAM a character sequence that matches a possibly empty
+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.
+
+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
+characters that were read from STREAM, i.e. successfully matched.
+
+If STRING is empty then it is automatically treated as a successful
+match (returning T and 0), whether or not STREAM has reached EOF.
+
+RECURSIVEP should be treated as in standard reader functions such as READ."
+  (loop :for count :from 0
+        :for c1 :across string
+        :for c2 := (peek-char nil stream eof-error-p nil recursivep)
+        :while (and c2 (char= c1 c2))
+        :do (read-char stream t nil recursivep)
+        :finally (return (values (= count (length string)) count))))
+
+(defun |#>-reader| (stream sub-char numarg)
+  "Reads the #>cpp ... cpp<# block into an instance of RAW-CPP.
+
+The block supports string interpolation of variables by using the syntax similar
+to shell interpolation. For example, ${variable} will interpolate (be replaced
+with) the value of VARIABLE."
+  (declare (ignore sub-char numarg))
+  (let ((output
+          (make-array 0 :element-type 'character :adjustable t :fill-pointer 0))
+        (begin-cpp "cpp")
+        (end-cpp "cpp<#")
+        (interpolated-args nil))
+    (unless (read-expecting begin-cpp stream nil t)
+      (error "Expected a C++ block to start with \"#>cpp\""))
+    (flet ((interpolate-argument ()
+             "Parse argument for interpolation after $."
+             (when (char= #\$ (peek-char nil stream t nil t))
+               ;; $$ is just $
+               (vector-push-extend (read-char stream t nil t) output)
+               (return-from interpolate-argument))
+             (unless (char= #\{ (peek-char nil stream t nil t))
+               (error "Expected { after $"))
+             (read-char stream t nil t) ;; consume {
+             (let ((form (let ((*readtable* (copy-readtable)))
+                           ;; Read form to }
+                           (set-macro-character #\} (get-macro-character #\)))
+                           (read-delimited-list #\} stream t))))
+               (when (and (not *read-suppress*)
+                          (or (null form)
+                              (not (symbolp (car form)))
+                              (cdr form)))
+                 (error "Expected a variable inside ${...}, got ~S" form))
+               ;; Push the variable symbol
+               (push (car form) interpolated-args))
+             ;; Push the format directive
+             (vector-push-extend #\~ output)
+             (vector-push-extend #\A output)))
+      (handler-case
+          (do (curr
+               (pos 0))
+              ((= pos (length end-cpp)))
+            (setf curr (read-char stream t nil t))
+            (if (and (< pos (length end-cpp))
+                     (char= (char-downcase curr) (aref end-cpp pos)))
+                (incf pos)
+                (setf pos 0))
+            (if (char= #\$ curr)
+                (interpolate-argument)
+                (vector-push-extend curr output)))
+        (end-of-file ()
+          (error "Missing a closing \"cpp<#\" delimiter for a C++ block"))))
+    (let ((trimmed-string
+            (string-trim +whitespace-chars+
+                         (subseq output
+                                 0 (- (length output) (length end-cpp))))))
+      `(make-raw-cpp
+        :string ,(if interpolated-args
+                     `(format nil ,trimmed-string ,@(reverse interpolated-args))
+                     trimmed-string)))))
+
+(named-readtables:defreadtable lcp-syntax
+  (:merge :standard)
+  (:dispatch-macro-char #\# #\> #'|#>-reader|))

src/lisp/types.lisp

@@ -4,68 +4,6 @@
 
 (in-package #:lcp)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar +whitespace-chars+ '(#\Newline #\Space #\Return #\Linefeed #\Tab)))
-
-(defstruct raw-cpp
-  "Represents a raw character string of C++ code."
-  (string "" :type string :read-only t))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun |#>-reader| (stream sub-char numarg)
-    "Reads the #>cpp ... cpp<# block into `RAW-CPP'.
-    The block supports string interpolation of variables by using the syntax
-    similar to shell interpolation. For example, ${variable} will be
-    interpolated to use the value of VARIABLE."
-    (declare (ignore sub-char numarg))
-    (let ((begin-cpp (read stream nil :eof t)))
-      (unless (and (symbolp begin-cpp) (string= begin-cpp 'cpp))
-        (error "Expected #>cpp, got '#>~A'" begin-cpp)))
-    (let ((output (make-array 0 :element-type 'character :adjustable t :fill-pointer 0))
-          (end-cpp "cpp<#")
-          interpolated-args)
-      (flet ((interpolate-argument ()
-               "Parse argument for interpolation after $."
-               (when (char= #\$ (peek-char nil stream t nil t))
-                 ;; $$ is just $
-                 (vector-push-extend (read-char stream t nil t) output)
-                 (return-from interpolate-argument))
-               (unless (char= #\{ (peek-char nil stream t nil t))
-                 (error "Expected { after $"))
-               (read-char stream t nil t) ;; consume {
-               (let ((form (let ((*readtable* (copy-readtable)))
-                             ;; Read form to }
-                             (set-macro-character #\} (get-macro-character #\)))
-                             (read-delimited-list #\} stream t))))
-                 (unless (and (not (null form)) (null (cdr form)) (symbolp (car form)))
-                   (error "Expected a variable inside ${..}, got ~A" form))
-                 ;; Push the variable symbol
-                 (push (car form) interpolated-args))
-               ;; Push the format directive
-               (vector-push-extend #\~ output)
-               (vector-push-extend #\A output)))
-        (handler-case
-            (do (curr
-                 (pos 0))
-                ((= pos (length end-cpp)))
-              (setf curr (read-char stream t nil t))
-              (if (and (< pos (length end-cpp))
-                       (char= (char-downcase curr) (aref end-cpp pos)))
-                  (incf pos)
-                  (setf pos 0))
-              (if (char= #\$ curr)
-                  (interpolate-argument)
-                  (vector-push-extend curr output)))
-          (end-of-file () (error "Missing closing '#>cpp .. cpp<#' block"))))
-      (let ((trimmed-string
-             (string-trim +whitespace-chars+
-                          (subseq output
-                                  0 (- (length output) (length end-cpp))))))
-        `(make-raw-cpp
-          :string ,(if interpolated-args
-                       `(format nil ,trimmed-string ,@(reverse interpolated-args))
-                       trimmed-string))))))
-
 (deftype cpp-primitive-type-keywords ()
   "List of keywords that specify a primitive type in C++."
   `(member :bool :char :int :int16_t :int32_t :int64_t :uint :uint16_t