parse-result: New module for generic client-defined parse results

This is a generalization of the concrete-tree-syntax module that uses
client-defined parse result representations instead of CST
instances. It also adds the ability to integrate representations of
skipped input into the result tree.

fixes #28

Documentation/chap-external-protocols.tex

@@ -22,6 +22,15 @@ \subsection{Package for readtable features}
 \texttt{common-lisp} package.  Importing this package will likely
 cause conflicts with the \texttt{common-lisp} package otherwise.
 
+\subsection{Package for parse result construction features}
+\label{sec:package-parse-result}
+
+The package for features related to the creation of client-defined
+parse results is named \texttt{eclector.parse-result}.  Although this
+package does not shadow any symbol in the \texttt{common-lisp}
+package, we still recommend the use of explicit package prefixes to
+refer to symbols in this package.
+
 \subsection{Package for CST features}
 \label{sec:package-cst-features}
 
@@ -276,6 +285,115 @@ \section{Readtable Features}
 
 TODO
 
+\section{Parse result construction features}
+\label{sec:parse-result-construction-features}
+
+In this section, symbols written without package marker are in the
+\texttt{eclector.parse-result} package
+\seesec{sec:package-parse-result}
+
+This package provides clients with a reader that behaves similarly to
+\texttt{cl:read} but returns custom parse result objects controlled by
+the client.  Some parse results correspond to things like symbols,
+numbers and lists that \texttt{cl:read} would return, while others, if
+the client chooses, represent comments and other kind of input that
+\texttt{cl:read} would discard.  Furthermore, clients can associate
+source location information with parse results.
+
+Clients using this package must bind the special variable
+\texttt{eclector.reader:*client*} around calls to \texttt{read} to an
+instance for which methods on the generic functions described below
+are applicable.  Suitable client classes can be constructed by using
+\texttt{parse-result-client} as a superclass and at least defining a
+method on the generic function \texttt{make-expression-result}.
+
+\Defun {read} {\optional (input-stream \texttt{*standard-input*})\\
+  (eof-error-p \texttt{t})
+  (eof-value \texttt{nil})}
+
+This function is the main entry point for this variant of the reader.
+It is in many ways similar to the standard \commonlisp{} function
+\texttt{read}.  The differences are:
+
+\begin{itemize}
+\item The first return value, unless \textit{eof-value} is returned,
+  is an arbitrary parse result object created by the client, not
+  generally the read object.
+\item The second return value, unless \textit{eof-value} is returned,
+  is a list of ``orphan'' results.  These results are return values of
+  \texttt{make-skipped-input-result} and arise when skipping input at
+  the toplevel such as comments which are not lexically contained in
+  lists: \texttt{\#|orphan|\# (\#|not orphan|\#)}.
+\item The function does not accept a \textit{recursive} parameter
+  since it sets up a dynamic environment in which calls to
+  \texttt{eclector.reader:read} behave suitably.
+\end{itemize}
+
+\Defclass {parse-result-client}
+
+This class should generally be used as a superclass for client classes
+using this package.
+
+\Defgeneric {source-position} {client stream}
+
+This generic function is called in order to determine the current
+position in \textit{stream}.  The default method calls
+\texttt{cl:file-position}.
+
+\Defgeneric {make-source-range} {client start end}
+
+This generic function is called in order to turn the source positions
+\textit{start} and \textit{end} into a range representation suitable
+for \textit{client}.  The returned representation designates the range
+of input characters from and including the character at position
+\textit{start} to but not including the character at position
+\textit{end}.  The default method returns \texttt{(cons start end)}.
+
+\Defgeneric {make-expression-result} {client result children source}
+
+This generic function is called in order to construct a parse result
+object.  The value of the \textit{result} parameter is the raw object
+read.  The value of the \textit{children} parameter is a list of
+already constructed parse result objects representing objects read by
+recursive \texttt{read} calls.  The value of the \textit{source}
+parameter is a source range, as returned by \texttt{make-source-range}
+and \texttt{source-position} delimiting the range of characters from
+which \textit{result} has been read.
+
+This generic function does not have a default method since the purpose
+of the package is the construction of \emph{custom} parse results.
+Thus, a client must define a method on this generic function.
+
+\Defgeneric {make-skipped-input-result} {client stream reason source}
+
+This generic function is called after the reader skipped over a range
+of characters in \textit{stream}.  It returns either \texttt{nil} if
+the skipped input should not be represented or a client-specific
+representation of the skipped input.  The value of the \textit{source}
+parameter designates the skipped range using a source range
+representation obtained via \texttt{make-source-range} and
+\texttt{source-position}.
+
+Reasons for skipping input include comments, the \texttt{\#+} and
+\texttt{\#-} reader macros and \texttt{*read-suppress*}.  The
+aforementioned reasons are reflected by the value of the
+\textit{reason} parameter as follows:
+
+\begin{tabular}{ll}
+  Input                                          & Value of the \textit{reason} parameter\\
+  \hline
+  Comment starting with \texttt{;}               & \texttt{(:line-comment . 1)}\\
+  Comment starting with \texttt{;;}              & \texttt{(:line-comment . 2)}\\
+  Comment starting with $n$ \texttt{;}           & \texttt{(:line-comment . $n$)}\\
+  Comment delimited by \texttt{\#|} \texttt{|\#} & \texttt{:block-comment}\\
+  \texttt{\#+\textit{false-feature-expression}}  & \texttt{:reader-macro}\\
+  \texttt{\#-\textit{true-feature-expression}}   & \texttt{:reader-macro}\\
+  \texttt{*read-suppress*} is true               & \texttt{*read-suppress*}
+\end{tabular}
+
+The default method returns \texttt{nil}, that is the skipped input is
+not represented as a parse result.
+
 \section{CST reader features}
 \label{sec:cst-reader-features}
 

code/parse-result/client.lisp

@@ -0,0 +1,4 @@
+(cl:in-package #:eclector.parse-result)
+
+(defclass parse-result-client ()
+  ())

code/parse-result/generic-functions.lisp

@@ -0,0 +1,22 @@
+(cl:in-package #:eclector.parse-result)
+
+;;; Source location protocol
+
+(defgeneric source-position (client stream)
+  (:method (client stream)
+    (declare (ignore client))
+    (file-position stream)))
+
+(defgeneric make-source-range (client start end)
+  (:method (client start end)
+    (declare (ignore client))
+    (cons start end)))
+
+;;; Parse result protocol
+
+(defgeneric make-expression-result (client result children source))
+
+(defgeneric make-skipped-input-result (client stream reason source)
+  (:method (client stream reason source)
+    (declare (ignore client stream reason source))
+    nil))

code/parse-result/package.lisp

@@ -0,0 +1,25 @@
+(cl:defpackage #:eclector.parse-result
+  (:use
+   #:common-lisp
+   #:alexandria)
+
+  (:shadow
+   #:read)
+
+  ;; Source location protocol
+  (:export
+   #:source-position
+   #:make-source-range)
+
+  ;; Parse result protocol
+  (:export
+   #:make-expression-result
+   #:make-skipped-input-result)
+
+  ;; Read protocol
+  (:export
+   #:read)
+
+  ;; Client protocol class (can be used as a superclass)
+  (:export
+   #:parse-result-client))

code/parse-result/read.lisp

@@ -0,0 +1,75 @@
+(cl:in-package #:eclector.parse-result)
+
+;;; A list of sub-lists the form
+;;;
+;;;   (CHILDREN-OF-CURRENT-NODE CHILDREN-OF-PARENT ...)
+;;;
+(defvar *stack*)
+
+(defvar *start*)
+
+(flet ((skip-whitespace (stream eof-error-p)
+         (loop with readtable = eclector.reader:*readtable*
+               for char = (eclector.reader:read-char stream eof-error-p)
+               when (null char)
+                 do (return nil)
+               while (eq (eclector.readtable:syntax-type readtable char)
+                         :whitespace)
+               finally (progn
+                         (unread-char char stream)
+                         (return t)))))
+
+  (defmethod eclector.reader:note-skipped-input
+      ((client parse-result-client) input-stream reason)
+    (let* ((start *start*)
+           (end (source-position client input-stream))
+           (range (make-source-range client start end))
+           (parse-result (make-skipped-input-result
+                          client input-stream reason range)))
+      (when parse-result
+        (push parse-result (second *stack*)))
+      ;; Try to advance to the next non-whitespace input character,
+      ;; then update *START*. This way, the source location for an
+      ;; object subsequently read INPUT-STREAM will not include the
+      ;; whitespace.
+      (skip-whitespace input-stream nil)
+      (setf *start* (source-position client input-stream))))
+
+  (defmethod eclector.reader:read-common :around
+      ((client parse-result-client) input-stream eof-error-p eof-value)
+    (let ((*stack* (cons '() *stack*)))
+      (unless (skip-whitespace input-stream eof-error-p)
+        (return-from eclector.reader:read-common eof-value))
+      (let* (;; *START* is used and potentially modified in
+             ;; NOTE-SKIPPED-INPUT to reflect skipped input
+             ;; (comments, reader macros, *READ-SUPPRESS*) before
+             ;; actually reading something.
+             (*start* (source-position client input-stream))
+             (result (call-next-method))
+             (children (reverse (first *stack*)))
+             (end (source-position client input-stream))
+             (source (make-source-range client *start* end))
+             (parse-result (make-expression-result
+                            client result children source)))
+        (push parse-result (second *stack*))
+        (values result parse-result)))))
+
+(defun read (&rest arguments)
+  (when (null eclector.reader:*client*)
+    (error "~S must be bound to a client instance."
+           'eclector.reader:*client*))
+
+  (destructuring-bind (&optional eof-error-p eof-value) (rest arguments)
+    (multiple-value-bind (result parse-result orphan-results)
+        (let ((*stack* (list '())))
+          (multiple-value-call #'values
+            (apply #'eclector.reader:read arguments)
+            (reverse (rest (first *stack*)))))
+      ;; If we come here, that means that either the call to READ
+      ;; succeeded without encountering end-of-file, or that
+      ;; EOF-ERROR-P is false, end-of-file was encountered, and
+      ;; EOF-VALUE was returned.  In the latter case, we want
+      ;; READ to return EOF-VALUE.
+      (if (and (null eof-error-p) (eq eof-value result))
+          eof-value
+          (values parse-result orphan-results)))))

code/reader/read.lisp

@@ -8,7 +8,9 @@
     (if recursive-p
         (read-common *client* input-stream eof-error-p eof-value)
         (let* ((*labels* (make-hash-table))
-               (result (read-common *client* input-stream eof-error-p eof-value)))
+               (values (multiple-value-list
+                        (read-common *client* input-stream eof-error-p eof-value)))
+               (result (first values)))
           ;; *labels* maps labels to conses of the form
           ;; (TEMPORARY-OBJECT . FINAL-OBJECT). For the fixup step,
           ;; these conses into a hash-table mapping temporary objects to
@@ -19,7 +21,7 @@
                             (alexandria:hash-table-values *labels*)
                             :test #'eq)))
               (fixup result seen mapping)))
-          result))))
+          (values-list values)))))
 
 (defun read (&optional
                (input-stream *standard-input*)

eclector.asd

@@ -52,6 +52,15 @@
                              (:file "quasiquote-macro")
                              (:file "fixup")))
 
+               (:module "parse-result"
+                :pathname "code/parse-result"
+                :depends-on ("reader")
+                :serial t
+                :components ((:file "package")
+                             (:file "client")
+                             (:file "generic-functions")
+                             (:file "read")))
+
                (:static-file "README.md")
                (:static-file "LICENSE-BSD"))
 
@@ -85,7 +94,14 @@
 
                              (:file "readtable")
 
-                             (:file "client"))))
+                             (:file "client")))
+
+               (:module "parse-result"
+                :pathname "test/parse-result"
+                :depends-on ("test")
+                :serial t
+                :components ((:file "package")
+                             (:file "read"))))
 
   :perform (test-op (operation component)
              (uiop:symbol-call '#:eclector.test '#:run-tests)))

test/parse-result/package.lisp

@@ -0,0 +1,15 @@
+(cl:defpackage #:eclector.parse-result.test
+  (:use
+   #:common-lisp
+   #:fiveam)
+
+  (:export
+   #:run-tests))
+
+(cl:in-package #:eclector.parse-result.test)
+
+(def-suite :eclector.parse-result
+  :in :eclector)
+
+(defun run-tests ()
+  (run! :eclector.parse-result))