Initial reader macro syntax

With syntax support for a variety of regex types (BRE, ERE and PCRE) and
for "ignore case" and "global" options, but with only PCRE implemented
underneath via cl-ppcre [0].

[0]: https://edicl.github.io/cl-ppcre/

9 files changed, 952 insertions, 0 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..de05a6a
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,12 @@
+<!-- Entry template: -->
+<!--
+# Unreleased
+## Added
+## Changed
+## Deprecated
+## Removed
+## Fixed
+## Security
+-->
+
+Changelog for [resyn](https://euandre.org/s/resyn/en/).
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..18562ae
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,67 @@
+.POSIX:
+DATE         = `date +%Y-%m-%d`
+VERSION      = 0.1.0
+NAME         = resyn
+NAME_UC      = resyn
+MAILING_LIST = public-inbox
+TRANSLATIONS =
+## Installation prefix.  Defaults to "/usr".
+PREFIX       = /usr
+LIBDIR       = $(PREFIX)/lib
+SHAREDIR     = $(PREFIX)/share
+INFODIR      = $(SHAREDIR)/info
+## Where to store the installation.  Empty by default.
+DESTDIR      =
+LISP         = cl
+LISPFLAGS    = -n
+
+
+
+.SUFFIXES:
+.SUFFIXES: .in
+
+.in:
+	sed \
+		-e 's:@VERSION@:$(VERSION):g' \
+		-e "s:@DATE@:$(DATE):g"       \
+		-e 's:@NAME@:$(NAME):g'       \
+		< $< > $@
+	if [ -x $< ]; then chmod +x $@; fi
+
+
+
+derived-assets = \
+
+
+
+## Default target.  Builds all artifacts required for testing
+## and installation.
+all: $(derived-assets)
+
+
+check-t:
+	$(LISP) $(LISPFLAGS) -E '(asdf:test-system :$(NAME))'
+
+## Run all tests.  Each test suite is isolated, so that a parallel
+## build can run tests at the same time.  The required artifacts
+## are created if required.
+check: check-t
+
+
+## Installs into $(DESTDIR)$(PREFIX).  Its dependency target
+## ensures that all installable artifacts are crafter beforehand.
+install: all
+
+## Uninstalls from $(DESTDIR)$(PREFIX).  This is a perfect mirror
+## of the "install" target, and removes *all* that was installed.
+## A dedicated test asserts that this is always true.
+uninstall:
+
+
+MAKEFILE = Makefile
+## Show this help.
+help:
+	cat $(MAKEFILE) | sh aux/makehelp.sh
+
+
+ALWAYS:
diff --git a/TODOs.md b/TODOs.md
new file mode 100644
index 0000000..e2c92d3
--- /dev/null
+++ b/TODOs.md
@@ -0,0 +1,25 @@
+# Tasks
+
+
+# Bugs
+
+
+# Improvements
+
+
+# Questions
+
+
+# Decisions
+
+
+# Ideas
+
+
+# Proposals
+
+
+# Resources
+
+
+# Scratch
diff --git a/description b/description
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/description
diff --git a/long-description b/long-description
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/long-description
diff --git a/meta.capim b/meta.capim
new file mode 100644
index 0000000..0a0ddb4
--- /dev/null
+++ b/meta.capim
@@ -0,0 +1,2 @@
+{:dependencies
+ {:check #{"lisp-cli"}}}
diff --git a/resyn.asd b/resyn.asd
new file mode 100644
index 0000000..c14a613
--- /dev/null
+++ b/resyn.asd
@@ -0,0 +1,24 @@
+(defsystem "resyn"
+  :name "resyn"
+  :version "0.1.0"
+  :author "EuAndreh and contributors"
+  :license "AGPL-3.0-or-later"
+  :homepage "https://euandre.org/s/resyn/"
+  :bug-tracker "https://euandre.org/s/resyn/TODOs.html"
+  :source-control (:git "https://euandre.org/git/resyn/")
+  :depends-on ("cl-ppcre")
+  :pathname "src/org/euandre"
+  :components ((:file "resyn"))
+  :description #.(uiop:read-file-string
+                  (uiop:subpathname *load-truename* "description"))
+  :long-description #.(uiop:read-file-string
+                       (uiop:subpathname *load-truename* "long-description"))
+  :in-order-to ((test-op (test-op "resyn/tests"))))
+
+(defsystem "resyn/tests"
+  :description "Test system for resyn"
+  :depends-on ("resyn")
+  :pathname "tests/org/euandre"
+  :components ((:file "resyn-test"))
+  :perform (test-op (_o _c)
+             (uiop:symbol-call :org.euandre.resyn-test :main)))
diff --git a/src/org/euandre/resyn.lisp b/src/org/euandre/resyn.lisp
new file mode 100644
index 0000000..9be2d35
--- /dev/null
+++ b/src/org/euandre/resyn.lisp
@@ -0,0 +1,198 @@
+(defpackage :org.euandre.resyn
+  (:use :cl)
+  (:shadow :match
+           :substitute)
+  (:export :match
+           :substitute
+           :reader))
+(in-package :org.euandre.resyn)
+
+#|
+TODO:
+- capture group
+- (#~m/a(b+)c/i "abc ABbC") => [["abc" "ABbC"] ["b" "Bb"]], or ["abc" "ABbC"] + [["b"] ["Bb"]]
+- robust ignore-case? (instead of #'STRING-DOWNCASE)
+- global?
+- BRE, ERE e PCRE
+- glob?
+- lambda expression vs funcallabla instance: simplicity vs read/print support
+- turn the "if" inside #'read-regex into a compiler macro
+- better error message than ecase?
+- gensyms
+- ack let over lambda
+- split: (split #~/(,| and) ?/ "a, b, c and d") => ["a" "b" "c" "d"]
+
+
+
+regcomp: BRE, ERE
+cl-ppcre: PCRE
+
+
+
+
+(#~m/a(b+)(c)/ "123 456")
+[]
+
+
+(#~m/a(b+)(c)/ "abbc")
+[["abbc", "bb", "c"]]
+
+(#~m/a(b+)(c)/ "abbc abc")
+[["abbc", "bb", "c"]
+ ["abc",  "b",  "c"]]
+
+
+
+
+(#~m/a(b+)(c)/ "abbc abc")
+"abbc"
+["bb" "c"]
+
+(#~m/a(b+)(c)/ "ac ac")
+nil
+nil
+
+(#~m/a(b+)(c)/ "abbc abc")
+["abbc" "abc"]
+[["bb" "c"] ["b" "c"]]
+
+(let [matches (#~m/a(b+)(c)/ "abbc abc")]
+  (when (seq matches))
+    ...)
+
+(let [(matches captures) (#~m/a(b+)(c)/ "abbc abc")]
+  (map (fn [[b c]]
+         ...)
+       captures))
+
+(loop
+  for (match [word spaces]) = (#~/([a-z]+)( +)/ "a  b c d e f")
+  when (...))
+|#
+
+
+(defun segment-reader (stream char n)
+  "FIXME: docstring"
+  (if (<= n 0)
+    (list '() '())
+    (let ((chars '())
+          (fmts '())
+          (escaping? nil))
+      (do ((curr (read-char stream) (read-char stream)))
+          ((and (char= char curr) (not escaping?)))
+        (case curr
+          (#\%
+            (if escaping?
+              (push #\% chars)
+              (progn
+                (push #\~ chars)
+                (push #\a chars)
+                (read-char stream) ;; discard #\(
+                (push `(progn ,@(read-delimited-list #\) stream))
+                      fmts)))
+            (setf escaping? nil))
+          (#\~
+            (when escaping?
+              (push #\\ chars))
+            (push #\~ chars)
+            (push #\~ chars)
+            (setf escaping? nil))
+          (#\\
+            (when escaping?
+              (push #\\ chars)
+              (push #\\ chars))
+            (setf escaping? (not escaping?)))
+          (t
+            (when escaping?
+              (push #\\ chars))
+            (push curr chars)
+            (setf escaping? nil))))
+      (destructuring-bind (segments formats)
+          (segment-reader stream char (1- n))
+        (list
+         (cons (coerce (nreverse chars) 'string)
+               segments)
+         (cons (nreverse fmts) formats))))))
+
+(defun read-regex (stream char n)
+  "FIXME: docstring"
+  (destructuring-bind (segments formats)
+      (segment-reader stream
+                      char
+                      n)
+    (mapcar (lambda (seg fmt)
+              (if fmt
+                `(format nil ,seg ,@fmt)
+                (format nil seg)))
+            segments
+            formats)))
+
+(defun match (regex str type &key ignore-case? global?)
+  "FIXME: docstring"
+  (declare (ignore global?)) ;; FIXME: implement global matching
+  (ecase type
+    ((:ERE :PCRE) ;; FIXME: implement separate rules
+       (cl-ppcre:scan-to-strings
+        (if ignore-case? (string-downcase regex) regex)   ; FIXME: more robust
+        (if ignore-case? (string-downcase str)   str))))) ;  handling of case
+
+(defun substitute (regex str replacement type &key ignore-case? global?)
+  "FIXME: docstring"
+  (declare (ignore global?)) ;; FIXME: implement non-global replacing
+  (ecase type
+    ((:BRE :ERE :PCRE) ;; FIXME: implement separate rules
+      (cl-ppcre:regex-replace-all
+       (if ignore-case? (string-downcase regex)       regex) ; FIXME: better
+       (if ignore-case? (string-downcase str)         str)   ; case handling
+       (if ignore-case? (string-downcase replacement) replacement)))))
+
+(defun reader (stream sub-char numarg)
+  "FIXME: docstring"
+  (declare (ignore sub-char numarg))
+  (let* ((ignore-case? nil)
+         (global? nil)
+         (type nil)
+         (seen-modifiers '())
+         (mode-char (read-char stream))
+         (parts (read-regex stream
+                            (ecase mode-char
+                              ((#\m #\s) (read-char stream))
+                              (#\/ #\/))
+                            (ecase mode-char
+                              ((#\m #\/) 1)
+                              (#\s 2))))
+         (regex (first parts))
+         (replacement (second parts)))
+    (loop while t do
+      (let ((modifier (peek-char nil stream)))
+        (when (member modifier seen-modifiers :test #'char=)
+          (return))
+        (case modifier
+          (#\i (setf ignore-case? t))
+          (#\g (setf global? t))
+          (#\B (if type (return) (setf type :BRE)))
+          (#\E (if type (return) (setf type :ERE)))
+          (#\P (if type (return) (setf type :PCRE)))
+          (t (return)))
+        (push modifier seen-modifiers)
+        (read-char stream)))
+    (when (not type)
+      (setf type :ERE))
+    (ecase mode-char
+      ((#\m #\/)
+        `(lambda (str)
+           (match
+            ,regex
+            str
+            ,type
+            :ignore-case? ,ignore-case?
+            :global? ,global?)))
+      (#\s
+        `(lambda (str)
+           (substitute
+            ,regex
+            str
+            ,replacement
+            ,type
+            :ignore-case? ,ignore-case?
+            :global? ,global?))))))
diff --git a/tests/org/euandre/resyn-test.lisp b/tests/org/euandre/resyn-test.lisp
new file mode 100644
index 0000000..660e74f
--- /dev/null
+++ b/tests/org/euandre/resyn-test.lisp
@@ -0,0 +1,624 @@
+(defpackage :org.euandre.resyn-test
+  (:use :cl)
+  (:local-nicknames (:resyn :org.euandre.resyn))
+  (:export :main))
+(in-package :org.euandre.resyn-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf *readtable* (copy-readtable nil))
+  (set-dispatch-macro-character #\# #\~ #'resyn:reader))
+
+(defun test-segment-reader ()
+  (assert
+    (equal '(("abc" "def") (() ()))
+           (with-input-from-string (s "abc/def/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("abc" "def" "ghi") (() () ()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 3))))
+  (assert
+    (equal '(("abc" "def") (() ()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("abc") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(() ())
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ 0))))
+  (assert
+    (equal '(() ())
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\/ -1))))
+  (assert
+    (equal :eof
+           (handler-case
+               (progn
+                 (with-input-from-string (s "abc/def/ghi/")
+                   (resyn::segment-reader s #\/ 4))
+                 (assert nil))
+             (end-of-file ()
+               :eof))))
+  (assert
+    (equal '((("abc") (())) "def/ghi/")
+           (with-input-from-string (s "abc/def/ghi/")
+             (list
+              (resyn::segment-reader s #\/ 1)
+              (read-line s)))))
+  (assert
+    (equal '(("") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\a 1))))
+  (assert
+    (equal '(("a") (()))
+           (with-input-from-string (s "abc/def/ghi/")
+             (resyn::segment-reader s #\b 1))))
+  (assert
+    (equal '(("ab" "/ab" "/ab") (() () ()))
+           (with-input-from-string (s "abc/abc/abc/")
+             (resyn::segment-reader s #\c 3))))
+  (assert
+    (equal '(("" "" "" "" "") (() () () () ()))
+           (with-input-from-string (s ".....")
+             (resyn::segment-reader s #\. 5))))
+  (assert
+    (equal '(("se\\/g1" "seg2\\\\" "\\.seg3") (() () ()))
+           (with-input-from-string (s "se\\/g1/seg2\\\\/\\.seg3/")
+             (resyn::segment-reader s #\/ 3))))
+  (assert
+    (equal '(("%not") (()))
+           (with-input-from-string (s "\\%not/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("%(escaped)") (()))
+           (with-input-from-string (s "\\%(escaped)/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("%\\(escaped\\)") (()))
+           (with-input-from-string (s "\\%\\(escaped\\)/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("a ~a here") (((progn cl-user::var))))
+           (with-input-from-string (s "a %(var) here/")
+             (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("we ~a" "~a ~a") (((progn cl-user::have))
+                                ((progn cl-user::many)
+                                 (progn (cl-user::vars) (cl-user::here)))))
+           (with-input-from-string (s "we %(have)/%(many) %((vars) (here))/")
+             (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("~a and " "%(without)") (((progn cl-user::with)) ()))
+            (with-input-from-string (s "%(with) and /\\%(without)/")
+              (resyn::segment-reader s #\/ 2))))
+  (assert
+    (equal '(("~a \" %(all) \\. %the \\/ things \\.\\? ~~ ~a")
+             (((progn cl-user::mix)
+               (progn cl-user::here))))
+            (with-input-from-string
+                (s "%(mix) \" \\%(all) \\. \\%the \\/ things \\.\\? ~ %(here)/")
+              (resyn::segment-reader s #\/ 1))))
+  (assert
+    (equal '(("~a %(one) \\\\~a \\\\%(three) \\\\\\\\~a")
+             (((progn cl-user::zero)
+               (progn cl-user::two)
+               (progn cl-user::four))))
+            (with-input-from-string
+                (s "%(zero) \\%(one) \\\\%(two) \\\\\\%(three) \\\\\\\\%(four)/")
+              (resyn::segment-reader s #\/ 1)))))
+
+(defun test-read-regex ()
+  (assert
+    (equal '("")
+           (with-input-from-string (s "/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("a")
+           (with-input-from-string (s "a/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("a"
+             (format nil "~a" (progn cl-user::b))
+             "%(c)"
+             (format nil "~a" (progn cl-user::d)))
+           (with-input-from-string (s "a/%(b)/\\%(c)/%(d)/")
+             (resyn::read-regex s #\/ 4))))
+  (assert
+    (equal '("a%~\\/")
+           (with-input-from-string (s "a\\%~\\//")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '("^(.*)\\.lisp\\$")
+           (with-input-from-string (s "^(.*)\\.lisp\\$/")
+             (resyn::read-regex s #\/ 1))))
+  (assert
+    (equal '((format nil "^(.*)\\.~a\\$" (progn cl-user::ext)))
+           (with-input-from-string (s "^(.*)\\.%(ext)\\$/")
+             (resyn::read-regex s #\/ 1)))))
+
+(defun test-match ()
+  (assert
+    (equal nil
+           (resyn:match
+            "abc"
+            "aaBcc"
+            :ERE)))
+  (assert
+    (equal "abc"
+           (resyn:match
+            "abc"
+            "aaBcc"
+            :ERE
+            :ignore-case? t))))
+
+(defun test-substitute ()
+  (assert
+    (equal "aaBcc"
+           (resyn::substitute
+            "abc"
+            "aaBcc"
+            "___"
+            :ERE)))  (assert
+    (equal "a___c"
+           (resyn::substitute
+            "abc"
+            "aaBcc"
+            "___"
+            :ERE
+            :ignore-case? t))))
+
+(defun test-reader ()
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "abc"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m/abc/))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               "def"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc/def/))
+  (assert
+    (equal "4555556"
+           (#~m/45*6/ "01234555556789")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               ""
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m//))
+  (assert
+    (equal :type-error
+           (let ((*readtable* (copy-readtable nil)))
+             (set-dispatch-macro-character #\# #\~ #'resyn:reader *readtable*)
+             (handler-case
+                 (progn
+                   (read-from-string "#~a//")
+                   (assert nil))
+               (type-error () :type-error)))))
+  (assert
+    (equal ""
+           (#~m// "non empty string")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                ""
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             /)
+           '(#~m///)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                ""
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             //)
+           '(#~m////)))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               "def"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc/def/))
+  (assert
+    (equal "defdefghi"
+           (#~s/abc/def/ "abcdefghi")))
+  (assert
+    (equal "0123-789"
+           (#~s/45*6/-/ "01234555556789")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               "abc"
+               resyn::str
+               ""
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s/abc//))
+  (assert
+    (equal "string containing  chars (changed)"
+           (#~s/abc// "string containing abc chars (changed)")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:substitute
+               ""
+               resyn::str
+               "abc"
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~s//abc/))
+  (assert
+    (equal "abc1abc2abc3abc"
+           (#~s//abc/ "123")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                ""
+                resyn::str
+                ""
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             /)
+           '(#~s////)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                ""
+                resyn::str
+                ""
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             //)
+           '(#~s/////)))
+  (assert
+    (equal "not"
+           (#~m_not_ "not the slash char")))
+  (assert
+    (equal "not slash char"
+           (#~s: the:: "not the slash char")))
+#+nil
+  (assert
+    (equal '("ab" "ac" "abc" "a") ;; FIXME: list of all matches?
+           (#~m/ab?c?/ "ab ac abc a")))
+  (assert
+    (equal "___ ___ ___"
+           (#~s/abc/___/ "abc abc abc")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "a%(b)c"
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~m/a\%(b)c/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "a%(b)c"
+                resyn::str
+                "%(de)f"
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~s/a\%(b)c/\%(de)f/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                (format nil "a~ac" (progn b))
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~m/a%(b)c/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                (format nil "a~ac" (progn b))
+                resyn::str
+                (format nil "~af" (progn de))
+                :ERE
+                :ignore-case? nil
+                :global? nil)))
+           '(#~s/a%(b)c/%(de)f/)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "a%(b)c"
+                resyn::str
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             %)
+           '(#~m/a\%(b)c/%)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "a%(b)c"
+                resyn::str
+                "%(de)f"
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             $)
+           '(#~s/a\%(b)c/\%(de)f/$)))
+  (assert
+    (equal nil
+           (#~m/tirar \%(sub)/ "tirar uma var daqui")))
+  (assert
+    (equal "trocar uma var daqui"
+           (#~s/tirar \%(sub)/\%(repl)/ "trocar uma var daqui")))
+  (let ((sub "uma var"))
+    (assert
+      (equal "tirar uma var"
+             (#~m/tirar %(sub)/ "tirar uma var daqui"))))
+  (let ((sub "uma var")
+        (repl "um texto"))
+    (assert
+      (equal "tirar um texto daqui"
+             (#~s/tirar %(sub)/tirar %(repl)/ "tirar uma var daqui"))))
+  (assert
+    (equal "abc"
+           (#~m/abc/ "abcdefghi")))
+  (assert
+    (equal "defdefghi"
+           (#~s/abc/def/ "abcdefghi")))
+  (let ((place "here"))
+    (assert
+      (equal "percent sign here: %"
+             (#~m/percent sign %(place): \%/
+              "a percent sign here: %."))))
+  (let ((percent "%")
+        (dollar "$")
+        (from "here")
+        (to "there"))
+    (assert
+      (equal
+       "place: there, sign: $"
+       (#~s/place: %(from), sign: %(percent)/place: %(to), sign: %(dollar)/
+        "place: here, sign: %"))))
+  (assert
+    (equal "333444"
+           (#~m/3*444/ "111222333444")))
+  (let ((n 0))
+    (assert
+      (equal "111222"
+             (#~m/%((incf n))*222/ "111222333444"))))
+  (let ((n 0))
+    (assert
+      (equal "222333"
+             (#~m/%((incf n) (incf n))*333/ "111222333444"))))
+  (let ((n 0))
+    (assert
+      (equal "223223223"
+             (#~s/%((incf n))/%((incf n))/ "123123123"))))
+  (let ((b "real")
+        (pat "%\\(b\\)"))
+    (assert
+      (equal "real"
+             (#~m/%(b)/ "real embedded %(b) string")))
+    (assert
+      (equal nil
+             (#~m/%(b)/ "the embedded %(b) string")))
+    (assert
+      (equal "real and %(b)"
+             (#~m/%(b).*%(pat)/ "both real and %(b)"))))
+  (assert
+    (equal "the regex: #~m/ghi/"
+           (#~s|#~s/abc/def/|#~m/ghi/| "the regex: #~s/abc/def/")))
+  (assert
+    (equal "tildes (~) are covered: ~."
+           (#~s/~ are/tildes (~) are/ "~ are covered: ~.")))
+  (let ((tilde "~"))
+    (assert
+      (and
+        (equal "literal: ~"
+               (#~m/literal: ~/        "a literal: ~."))
+        (equal "literal: ~"
+               (#~m/literal: %(tilde)/ "a literal: ~.")))))
+  (assert
+    (equal "esc"
+           (#~m/.../ "escaping...")))
+  (assert
+    (equal ".../%()"
+           (#~m/\.\.\.\/\%\(\)/ "escaping.../%()")))
+  (assert
+    (equal "./"
+           (#~m/\.\// "escaping .%./")))
+  (assert
+    (equal "a"
+           (#~m/./ "anything")))
+  (assert
+    (equal nil
+           (#~m/\./ "anything")))
+  (assert
+    (equal " /// "
+           (#~m/ \/* / "before /// after")))
+  (assert
+    (equal "%(.*?)/"
+           (#~m/\%\(\.\*\?\)\// "%(.*?)/")))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "abc"
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/abc/i))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "aBc"
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/aBc/i))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "aBc"
+                resyn::str
+                :ERE
+                :ignore-case? t
+                :global? nil))
+             i)
+           '(#~m/aBc/ii)))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               (format nil "aB~a%d" (progn c))
+               resyn::str
+               :ERE
+               :ignore-case? t
+               :global? nil))
+           '#~m/aB%(c)\%d/i))
+  (let ((c ".*f"))
+    (assert
+      (equal "%abcdef"
+             (#~m/\%aB%(c)/i " %abcdefghi"))))
+  (let ((var "defun"))
+    (assert
+      (equal "(DEFUN not-working ())"
+             (#~s/%(var)/defn/ "(DEFUN not-working ())")))
+    (assert
+      (equal "(defn working ())"
+             (#~s/%(var)/defn/i "(DEFUN working ())"))))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "x"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~/x/))
+  (assert
+    (equal "ALL THE THINGS"
+           (#~/ALL THE THINGS/ "MATCH ALL THE THINGS!")))
+  (let ((vars "all"))
+    (assert
+      (equal "with vars and all"
+             (#~/with vars and %(vars)/i "With vars and all!"))))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "aBcD"
+               resyn::str
+               :ERE
+               :ignore-case? nil
+               :global? nil))
+           '#~m/aBcD/E))
+  (assert
+    (equal '#~m/abc/
+           '#~m/abc/E))
+  (assert
+    (equal '(lambda (resyn::str)
+              (resyn:match
+               "x"
+               resyn::str
+               :BRE
+               :ignore-case? t
+               :global? t))
+           '#~m/x/igB))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :BRE
+                :ignore-case? t
+                :global? t))
+             B)
+           '(#~m/x/igBB)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :PCRE
+                :ignore-case? t
+                :global? t))
+             B)
+           '(#~m/x/igPB)))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:match
+                "x"
+                resyn::str
+                :PCRE
+                :ignore-case? t
+                :global? t))
+             P)
+           '(#~m/x/igPP)))
+  (let ((str "string"))
+    (assert
+      (equal "a string"
+             (#~s/text/%(str)/ "a text"))))
+  (let ((resyn::str "string"))
+    (declare (ignorable resyn::str))
+    (assert
+      (equal "a a text"
+             (#~s/text/%(resyn::str)/ "a text"))))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "text"
+                resyn::str
+                (format nil "~a" (progn str))
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             "a text")
+           '(#~s/text/%(str)/ "a text")))
+  (assert
+    (equal '((lambda (resyn::str)
+               (resyn:substitute
+                "text"
+                resyn::str
+                (format nil "~a" (progn resyn::str))
+                :ERE
+                :ignore-case? nil
+                :global? nil))
+             "a text")
+           '(#~s/text/%(resyn::str)/ "a text"))))
+
+(defparameter test-fns
+  '(test-segment-reader
+    test-read-regex
+    test-match
+    test-substitute
+    test-reader))
+
+(defun main ()
+  (dolist (f test-fns)
+    (funcall f)))