Merge pull request #12 from EuAndreh/master

Change from ppcre:scan to ppcre:scan-to-strings

let-over-lambda.lisp

@@ -110,7 +110,7 @@
          ,@body))))
 
 (defmacro defmacro! (name args &rest body)
-  (let* ((os (remove-if-not #'o!-symbol-p args))
+  (let* ((os (remove-if-not #'o!-symbol-p (flatten args)))
          (gs (mapcar #'o!-symbol-to-g!-symbol os))
          (docstring (if (stringp (car body))
                         (car body)
@@ -207,7 +207,7 @@
 #+cl-ppcre
 (defmacro! match-mode-ppcre-lambda-form (o!args o!mods)
  ``(lambda (,',g!str)
-     (cl-ppcre:scan
+     (ppcre:scan-to-strings
        ,(if (zerop (length ,g!mods))
           (car ,g!args)
           (format nil "(?~a)~a" ,g!mods (car ,g!args)))
@@ -529,37 +529,28 @@
                 :end1 1)
        (ignore-errors (parse-integer (subseq (symbol-name s) 1)))))
 
-(defun prune-if-match-bodies-from-sub-lexical-scope (tree)
-  (if (consp tree)
-    (if (or (eq (car tree) 'if-match)
-            (eq (car tree) 'when-match))
-      (cddr tree)
-      (cons (prune-if-match-bodies-from-sub-lexical-scope (car tree))
-            (prune-if-match-bodies-from-sub-lexical-scope (cdr tree))))
-    tree))
-
-;; WARNING: Not %100 correct. Removes forms like (... if-match ...) from the
-;; sub-lexical scope even though this isn't an invocation of the macro.
-#+cl-ppcre
-(defmacro! if-match ((test str) conseq &optional altern)
-  (let ((dollars (remove-duplicates
+(defmacro! if-match ((match-regex str) then &optional else)
+  (let* ((dollars (remove-duplicates
                    (remove-if-not #'dollar-symbol-p
-                                  (flatten (prune-if-match-bodies-from-sub-lexical-scope conseq))))))
-    (let ((top (or (car (sort (mapcar #'dollar-symbol-p dollars) #'>)) 0)))
-      `(let ((,g!str ,str))
-         (multiple-value-bind (,g!s ,g!e ,g!ms ,g!me) (,test ,g!str)
-           (declare (ignorable ,g!e ,g!me))
-           (if ,g!s
-             (if (< (length ,g!ms) ,top)
-               (error "ifmatch: too few matches")
-               (let ,(mapcar #`(,(symb "$" a1) (subseq ,g!str (aref ,g!ms ,(1- a1))
-                                                              (aref ,g!me ,(1- a1))))
-                             (loop for i from 1 to top collect i))
-                 ,conseq))
-              ,altern))))))
-
-(defmacro when-match ((test str) conseq &rest more-conseq)
-  `(if-match (,test ,str)
-     (progn ,conseq ,@more-conseq)))
+                                  (flatten then))))
+         (top (or (car (sort (mapcar #'dollar-symbol-p dollars) #'>))
+                  0)))
+    `(multiple-value-bind (,g!matches ,g!captures) (,match-regex ,str)
+       (declare (ignorable ,g!matches ,g!captures))
+       (let ((,g!captures-len (length ,g!captures)))
+         (declare (ignorable ,g!captures-len))
+         (symbol-macrolet ,(mapcar #`(,(symb "$" a1)
+                                       (if (< ,g!captures-len ,a1)
+                                           (error "Too few matchs: ~a unbound." ,(mkstr "$" a1))
+                                           (aref ,g!captures ,(1- a1))))
+                                   (loop for i from 1 to top collect i))
+           (if ,g!matches
+               ,then
+               ,else))))))
+
+
+(defmacro when-match ((match-regex str) &body forms)
+  `(if-match (,match-regex ,str)
+     (progn ,@forms)))
 
 ;; EOF

t/let-over-lambda.lisp

@@ -11,7 +11,7 @@
 
 ;; NOTE: To run this test file, execute `(asdf:test-system :let-over-lambda)' in your Lisp.
 
-(plan 6)
+(plan 7)
 
 (defparameter flatten-list `(D (E (F ,'(G)))))
 
@@ -37,13 +37,13 @@ the reading of this string is..."
 
 (deftest pilfered-perl-regex-syntax-test
   (is-expand '#~m|\w+tp://|
-             '(lambda ($str) (cl-ppcre:scan "\\w+tp://" $str))
+             '(lambda ($str) (cl-ppcre:scan-to-strings "\\w+tp://" $str))
              "#~m expands correctly.")
   (is-expand '#~s/abc/def/
              '(lambda ($str) (cl-ppcre:regex-replace-all "abc" $str "def"))
              "#~s expands correctly.")
   (is-values (#~m/abc/ "123abc")
-             '(3 6 #() #())
+             '("abc" #())
              "#~m runs correctly."
              :test #'equalp)
   (is (#~s/abc/def/ "Testing abc testing abc")
@@ -79,4 +79,47 @@ the reading of this string is..."
       "Contains \" and \\."
       "SHARP-QUOTE read macro works as expected."))
 
+(deftest if-match-test
+  (is (if-match (#~m_a(b)c_ "abc")
+          $1)
+      "b"
+      "IF-MATCH correctly returns the single capture.")
+  (is-error (if-match (#~m_a(b)c_ "abc")
+                $2)
+            'simple-error
+            "IF-MATCH throws an error when $2 is unbound.")
+  (is (if-match (#~m_a(b)c_ "def")
+          $1
+          :else)
+      :else
+      "When IF-MATCH test is false it goes to the else body.")
+  (is (if-match (#~m_a(b)c_ "abc")
+          (if-match (#~m_(d)(e)f_ "def")
+              (list $1 $2)
+              :no-second-match)
+          $1)
+      '("d" "e")
+      "IF-MATCH works with nested IF-MATCHs.")
+  (is (if-match (#~m_a(b)c_ "abc")
+          (if-match (#~m_(d)(e)f_ "d ef")
+              (list $1 $2)
+              :no-second-match)
+          $1)
+      :no-second-match
+      "IF-MATCH works with nested IF-MATCHs.")
+  (is-error (if-match (#~m_a(b)c_ "ab c")
+                (if-match (#~m_(d)(e)f_ "d ef")
+                    (list $1 $2)
+                    :no-second-match)
+                $1)
+            'simple-error
+            "IF-MATCH throws an error, even when nested.")
+  (is-error (if-match (#~m_a(b)c_ "ab c")
+                (if-match (#~m_(d)(e)f_ "d ef")
+                    (list $1 $2)
+                    :no-second-match)
+                $2)
+            'simple-error
+            "IF-MATCH throws an error, even when nested."))
+
 (run-test-all)