From d6c9f918e0b599b2b1c211932d5e5dfd33a95b8a Mon Sep 17 00:00:00 2001
From: Masataro Asai <guicho2.71828@gmail.com>
Date: Wed, 3 Apr 2019 23:30:23 +0900
Subject: [PATCH] defpattern

---
 quickdocs-parser.asd |  1 +
 src/nodes.lisp       |  8 ++++++++
 src/package.lisp     |  4 +++-
 src/parsers.lisp     | 18 ++++++++++++++++++
 src/print.lisp       | 10 ++++++++++
 5 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/quickdocs-parser.asd b/quickdocs-parser.asd
index d36b171..8821b65 100644
--- a/quickdocs-parser.asd
+++ b/quickdocs-parser.asd
@@ -6,6 +6,7 @@
   :homepage ""
   :bug-tracker ""
   :source-control (:git "")
+  :depends-on (:optima :trivia)
   :components ((:module "src"
                 :serial t
                 :components
diff --git a/src/nodes.lisp b/src/nodes.lisp
index 254ea85..b81207e 100644
--- a/src/nodes.lisp
+++ b/src/nodes.lisp
@@ -114,6 +114,14 @@
   ()
   (:documentation "A type."))
 
+(defclass optima-pattern-node (operator-node)
+  ()
+  (:documentation "An optima defpattern node."))
+
+(defclass trivia-pattern-node (operator-node)
+  ()
+  (:documentation "A trivia defpattern node."))
+
 ;;; CFFI classes
 
 (defclass cffi-node ()
diff --git a/src/package.lisp b/src/package.lisp
index ab885e3..6b9dd5e 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -16,7 +16,9 @@
            :struct-node
            :class-node
            :condition-node
-           :type-node)
+           :type-node
+           :optima-pattern-node
+           :trivia-pattern-node)
   ;; CFFI classes
   (:export :cffi-node
            :cffi-function
diff --git a/src/parsers.lisp b/src/parsers.lisp
index e3c8125..445e52d 100644
--- a/src/parsers.lisp
+++ b/src/parsers.lisp
@@ -84,6 +84,24 @@
                    :docstring docstring
                    :lambda-list lambda-list)))
 
+(define-parser optima:defpattern (name lambda-list &rest body)
+  (let ((docstring (if (stringp (first body))
+                       (first body)
+                       nil)))
+    (make-instance 'optima-pattern-node
+                   :name name
+                   :docstring docstring
+                   :lambda-list lambda-list)))
+
+(define-parser trivia:defpattern (name lambda-list &rest body)
+  (let ((docstring (if (stringp (first body))
+                       (first body)
+                       nil)))
+    (make-instance 'trivia-pattern-node
+                   :name name
+                   :docstring docstring
+                   :lambda-list lambda-list)))
+
 (defun parse-slot (slot)
   (if (listp slot)
       (let ((slot (copy-list slot)))
diff --git a/src/print.lisp b/src/print.lisp
index 2672a1f..7c8b1b9 100644
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -41,6 +41,16 @@
   (print-unreadable-object (type stream)
     (format stream "type ~A" (render-humanize (node-name type)))))
 
+(defmethod print-object ((optima-pattern optima-pattern-node) stream)
+  "Print a optima-pattern definition node."
+  (print-unreadable-object (optima-pattern stream)
+    (format stream "optima-pattern ~A" (render-humanize (node-name optima-pattern)))))
+
+(defmethod print-object ((trivia-pattern trivia-pattern-node) stream)
+  "Print a trivia-pattern definition node."
+  (print-unreadable-object (trivia-pattern stream)
+    (format stream "trivia-pattern ~A" (render-humanize (node-name trivia-pattern)))))
+
 ;;; CFFI classes
 
 (defmethod print-object ((function cffi-function) stream)