From f832efe568e1235752f0709968fada5213bd687c Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Sat, 14 Jul 2018 12:18:12 +0200
Subject: dotall

---
 modules/language/python/module/re.scm         | 10 +++++---
 modules/language/python/module/re/compile.scm | 37 +++++++++++++++++++--------
 modules/language/python/module/re/flags.scm   |  6 ++++-
 modules/language/python/module/re/parser.scm  |  2 +-
 4 files changed, 39 insertions(+), 16 deletions(-)

(limited to 'modules/language/python')

diff --git a/modules/language/python/module/re.scm b/modules/language/python/module/re.scm
index 139393e..4da2138 100644
--- a/modules/language/python/module/re.scm
+++ b/modules/language/python/module/re.scm
@@ -16,7 +16,8 @@
                                    f-seq! f-and! f-nl
                                    f-reg f-seq Ds f-or! ff* f-ftr))
   #:use-module ((ice-9 match) #:select ((match . ice-match)))
-  #:re-export (A ASCII DEBUG I IGNORECASE L LOCALE M MULTILINE X VERBOSE)
+  #:re-export (A ASCII DEBUG I IGNORECASE L LOCALE M MULTILINE X VERBOSE
+                 S DOTALL)
   #:export (compile match fullmatch search split finditer findall sub subn
                     purge escape))
 
@@ -188,7 +189,9 @@
 		      (f-seq
 		       (f-or!
 			(f-seq! e-start (f-and! e) e-end
-				(f-ftr (lambda (c) (yield (ReMatch c re (gs) (ge) s)) '())))
+				(f-ftr (lambda (c)
+                                         (yield (ReMatch c re (gs) (ge) s))
+                                         '())))
 			(f-seq (f-reg ".")))
 		       (Ds (lp)))))))))))
 
@@ -326,7 +329,8 @@
 	   (() #t)))
 
 	(set self '__t t)
-	(set self 'regs (__regs self)))))
+	(set self 'regs (__regs self))
+        (pk (span self)))))
 
   (define er (list 'er))
   (define group
diff --git a/modules/language/python/module/re/compile.scm b/modules/language/python/module/re/compile.scm
index ca7663d..210a2ad 100644
--- a/modules/language/python/module/re/compile.scm
+++ b/modules/language/python/module/re/compile.scm
@@ -6,7 +6,7 @@
   #:use-module ((parser stis-parser) #:select 
 		((parse . stisparse) <p-lambda> <p-cc> .. f-nl! f-nl
 		 f-tag! f-tag f-seq f-or f-or! f-and f-true g* g+ gmn ng* ng+
-                 ngmn f-reg! f-and! f-test N M X XL
+                 ngmn f-reg! f-and! f-test N M X XL f-pk
 		 g? ng? f-test! f-eof f-not! f-prev f-not f-out f-rev
                  *whitespace*
 		 f-nm f-pos))
@@ -33,6 +33,18 @@
      (when (= N 0)
        (<p-cc> (wrap L c)))))
 
+(define dotall
+  (<pp-lambda> (L c)
+   (let ((x (fluid-ref *flags*)))
+     (when (pk (not (= 0 (logand x DOTALL))))
+       (<p-cc> (wrap L c))))))
+
+(define multiline
+  (<pp-lambda> (L c)
+   (let ((x (fluid-ref *flags*)))
+     (when (not (= 0 (logand x DOTALL)))
+       (<p-cc> (wrap L c))))))
+
 (define (gt f)
   (<pp-lambda> (L c)
     (let ((x #f))
@@ -149,8 +161,9 @@
     ((#:?<= f) f)
     ((#:?<! f) (#:not f))
     ((#:not f) (list #:not (reverse-form f)))
-    (#:$  #:^)
-    (#:^  #:$)
+    (#:$   #:^)
+    (#:^   #:$)
+    (#:dot #:dot)
     ((#:op  x #:* ) (list #:op  (reverse-form x) #:*)) 
     ((#:op  x #:+ ) (list #:op  (reverse-form x) #:+)) 
     ((#:op  x (#:rep  m n)) (list #:op  (reverse-form x) (#:rep  m n)))
@@ -160,7 +173,7 @@
     ((#:op  x #:? ) (list #:op  (reverse-form x) #:?)) 
     ((#:op  x #:*?) (list #:op  (reverse-form x) #:*?)) 
     ((#:op  x #:+?) (list #:op  (reverse-form x) #:+?)) 
-    ((#:op  x #:??) (list #:op  (reverse-form x) #:??)) 
+    ((#:op  x #:??) (list #:op  (reverse-form x) #:??))
     ((and a (#:ch (#:class x))) a)
     ((and a (#:ch x)) a)
     ((and a (#:bracket not ch ...)) a)))
@@ -194,6 +207,7 @@
         (and
          (= (logand fl ASCII) 0)
          (char-whitespace? x)))))
+   f-nl!
    (f-reg! "[\n\r \t\f\v]")))
 
 (define (get-class tag)
@@ -275,19 +289,20 @@
            no))
     (#:$
      (f-or! f-eof
-            (f-and (f-test (lambda (c)
-                             (let ((x (fluid-ref *flags*)))
-                               (not (= 0 (logior x MULTILINE))))))
+            (f-and multiline
                    f-nl
                    f-true)))
     (#:^
      (f-or! (f-nm 0 1)
-            (f-and (f-test (lambda (c)
-                             (let ((x (fluid-ref *flags*)))
-                               (not (= 0 (logior x MULTILINE))))))
+            (f-and multiline
                    startline
                    f-true)))
-
+    (#:dot
+     (f-or! (fw (f-reg! "."))
+            (f-and
+             dotall
+             (fw f-nl!))))
+    
     ((#:op  x #:* ) (g*   (compile x)    ))
     ((#:op  x #:+ ) (g+   (compile x)    ))
     ((#:op  x (#:rep  m n)) (gmn   (compile x) m n))
diff --git a/modules/language/python/module/re/flags.scm b/modules/language/python/module/re/flags.scm
index 4db839a..37630f8 100644
--- a/modules/language/python/module/re/flags.scm
+++ b/modules/language/python/module/re/flags.scm
@@ -1,6 +1,7 @@
 (define-module (language python module re flags)
   #:export (set-flags get-flags *flags*
-		      A ASCII DEBUG I IGNORECASE L LOCALE M MULTILINE X VERBOSE))
+		      A ASCII DEBUG I IGNORECASE L LOCALE M MULTILINE
+                      X VERBOSE S DOTALL))
 
 (define *flags* (make-fluid 0))
 (define (set-flags x) (fluid-set! *flags* x))
@@ -23,3 +24,6 @@
 (define X          32)
 (define VERBOSE    X)
 
+(define S          64)
+(define DOTALL     X)
+
diff --git a/modules/language/python/module/re/parser.scm b/modules/language/python/module/re/parser.scm
index a7210d1..45a7a5c 100644
--- a/modules/language/python/module/re/parser.scm
+++ b/modules/language/python/module/re/parser.scm
@@ -55,7 +55,7 @@
 
 
 (define f-bar  (f-tag "|"))
-(define qq     (ch (f-reg "[][?+|*.$^() \\]")))
+(define qq     (ch (f-reg "[][?+|*.$^()\\]")))
 (define atom   (f-or qq f-. choice subexpr anongroup namegroup incant coment lookh lookh! rev rev! f-^ f-$))
 (define spec   (f-list #:op atom (f-or! q+? q?? q*? q* q? q+ repn? repnm? repn repnm)))
 (define aatom  (f-or! spec atom))
-- 
cgit v1.2.3