Subject: [clisp-list] regexp not extended ?

From: Pascal Bourguignon <[email-masked]>
Date: Sat Mar 29 16:50:23 2003

Any reason in particular why  REGEXP does not implement the flags that
are exported by mregcomp?  The  lack of '+' is particularly painful in
non extended posix regexps...

(defun regexp-compile (pattern
                        &optional (case-sensitive t)
                        (extended nil)
                        (newline nil)
                        (nosub nil))
  (let (errcode compiled-pattern)
    (assert (zerop (setf (values errcode compiled-pattern)
                         (mregcomp pattern
                                   (+ (if case-sensitive 0 REG_ICASE)
                                      (if extended 0 REG_EXTENDED)
                                      (if newline 0 REG_NEWLINE)
                                      (if nosub 0 REG_NOSUB)))))
            (pattern)
            "~s: ~a" 'regexp-compile (mregerror errcode compiled-pattern))
    ;; Arrange that when compiled-pattern is garbage-collected,
    ;; mregfree will be called.
    (ext:finalize compiled-pattern #'mregfree-finally)
    compiled-pattern)
  );;REGEXP-COMPILE

(defun match-once (pattern string &key (start 0) (end nil)
                            (case-sensitive t)
                            (extended nil)
                            (newline nil)
                            (nosub nil))
  (regexp-exec (regexp-compile pattern case-sensitive extended newline nosub)
               string :start start :end end)
  );;REGEXP-COMPILE

-- 
__Pascal_Bourguignon__                   http://www.informatimago.com/
----------------------------------------------------------------------
Do not adjust your mind, there is a fault in reality.

---

From: Sam Steingold <[email-masked]>
Date: Sat Mar 29 18:19:10 2003

> * In message <[email-masked]>
> * On the subject of "[clisp-list] regexp not extended ?"
> * Sent on Sun, 30 Mar 2003 01:49:21 +0100 (CET)
> * Honorable Pascal Bourguignon <[email-masked]> writes:
>

would you be happy with the appended patch?

-- 
Sam Steingold (http://www.podval.org/~sds) running RedHat8 GNU/Linux
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.palestine-central.com/links.html>
There are 10 kinds of people: those who count in binary and those who do not.

--- regexp.lisp.~1.8.~	2002-04-16 14:13:11.000000000 -0400
+++ regexp.lisp	2003-03-29 21:15:36.000000000 -0500
@@ -163,24 +160,35 @@
   (:return-type c-string :malloc-free))
 (def-call-out mregfree (:arguments (preg regex_t-ptr))
   (:return-type nil))
-; cflags values
+;; cflags values
+(eval-when (compile load eval)
 (defconstant REG_EXTENDED 1)
 (defconstant REG_ICASE    2)
 (defconstant REG_NEWLINE  4)
-(defconstant REG_NOSUB    8)
-; eflags values
+  (defconstant REG_NOSUB    8))
+;; eflags values
+(eval-when (compile load eval)
 (defconstant REG_NOTBOL   1)
-(defconstant REG_NOTEOL   2)
+  (defconstant REG_NOTEOL   2))
 
 (defun mregfree-finally (compiled-pattern)
   ;; beware: compiled-pattern could come from a previous session
   (when (validp compiled-pattern)
     (mregfree compiled-pattern)))
 
-(defun regexp-compile (pattern &optional (case-sensitive t))
+(defmacro cflags (extended case-sensitive newline nosub)
+  `(+ (if ,extended REG_EXTENDED 0)
+      (if ,case-sensitive 0 REG_ICASE)
+      (if ,newline REG_NEWLINE 0)
+      (if ,nosub REG_NOSUB 0)))
+(defconstant cflags-max  (+ REG_EXTENDED REG_ICASE REG_NEWLINE REG_NOSUB))
+
+(defun regexp-compile (pattern &key (extended nil) (case-sensitive t)
+                       (newline nil) (nosub nil)
+                       (cflags (cflags extended case-sensitive newline nosub)))
   (let (errcode compiled-pattern)
     (assert (zerop (setf (values errcode compiled-pattern)
-                         (mregcomp pattern (if case-sensitive 0 REG_ICASE))))
+                         (mregcomp pattern cflags)))
             (pattern)
             "~s: ~a" 'regexp-compile (mregerror errcode compiled-pattern))
     ;; Arrange that when compiled-pattern is garbage-collected,
@@ -188,6 +196,7 @@
     (ext:finalize compiled-pattern #'mregfree-finally)
     compiled-pattern))
 
+(eval-when (compile load eval)
 (setf (fdefinition 'match-start) (fdefinition 'regmatch_t-rm_so))
 (setf (fdefinition '(setf match-start))
       (lambda (new-value match) (setf (regmatch_t-rm_so match) new-value)))
@@ -195,8 +204,14 @@
 (setf (fdefinition 'match-end) (fdefinition 'regmatch_t-rm_eo))
 (setf (fdefinition '(setf match-end))
       (lambda (new-value match) (setf (regmatch_t-rm_eo match) new-value)))
+)
+
+(defmacro eflags (notbol noteol)
+  `(+ (if ,notbol REG_NOTBOL 0) (if ,noteol REG_NOTEOL 0)))
 
-(defun regexp-exec (compiled-pattern string &key (start 0) (end nil))
+(defun regexp-exec (compiled-pattern string &key (start 0) (end nil)
+                    (notbol nil) (noteol nil)
+                    (eflags (eflags notbol noteol)))
   (assert (stringp string) (string)
           "~s: the second argument must be a string, not ~s"
           'regexp-exec string)
@@ -215,7 +230,7 @@
                          :displaced-index-offset start))))
     (declare (string string))
     (multiple-value-bind (errcode matches)
-        (regexec compiled-pattern string #.num-matches 0)
+        (regexec compiled-pattern string #.num-matches eflags)
       ;; Compute return values.
       (if (zerop errcode)
         (values-list          ; the first value will be non-NIL
@@ -235,71 +250,87 @@
 
 ;; The following implementation of MATCH compiles the pattern
 ;; once for every search.
-(defun match-once (pattern string &key (start 0) (end nil) (case-sensitive t))
-  (regexp-exec (regexp-compile pattern case-sensitive)
-               string :start start :end end))
+(defun match-once (pattern string &key (start 0) (end nil)
+                   (extended nil) (case-sensitive t)
+                   (newline nil) (nosub nil)
+                   (cflags (cflags extended case-sensitive newline nosub))
+                   (notbol nil) (noteol nil)
+                   (eflags (eflags notbol noteol)))
+  (regexp-exec (regexp-compile pattern :cflags cflags)
+               string :start start :end end :eflags eflags))
 
 ;; The following implementation of MATCH compiles the pattern
 ;; only once per Lisp session, if it is a literal string.
 (defmacro match (pattern string &rest more-forms)
   (if (stringp pattern)
     `(%MATCH (MATCHER ,pattern) ,string ,@more-forms)
-    `(MATCH-ONCE ,pattern ,string ,@more-forms)
-) )
+    `(MATCH-ONCE ,pattern ,string ,@more-forms)))
 
 (defmacro matcher (pattern)
   (declare (string pattern))
-  `(LOAD-TIME-VALUE (%MATCHER ,pattern))
-)
+  `(LOAD-TIME-VALUE (%MATCHER ,pattern)))
 (defun %matcher (pattern)
-  (list* pattern nil nil)
-  ; car = pattern,
-  ; cadr = compiled pattern, case sensitive,
-  ; cddr = compiled pattern, case insensitive.
-)
-
-(defun %match (patternbox string &key (start 0) (end nil) (case-sensitive t))
+  (let ((ma (make-array (1+ cflags-max))))
+    (setf (svref ma cflags-max) pattern)
+    ma))
+
+(defun %match (patternbox string &key (start 0) (end nil)
+               (extended nil) (case-sensitive t)
+               (newline nil) (nosub nil)
+               (cflags (cflags extended case-sensitive newline nosub))
+               (notbol nil) (noteol nil)
+               (eflags (eflags notbol noteol)))
   ;; Compile the pattern, if not already done.
-  (let ((compiled-pattern
-          (if case-sensitive (cadr patternbox) (cddr patternbox))))
+  (let ((compiled-pattern (svref patternbox cflags)))
     (unless (and compiled-pattern (validp compiled-pattern))
-      (setq compiled-pattern (regexp-compile (car patternbox) case-sensitive))
-      (if case-sensitive
-        (setf (cadr patternbox) compiled-pattern)
-        (setf (cddr patternbox) compiled-pattern)))
-    (regexp-exec compiled-pattern string :start start :end end)))
+      (setq compiled-pattern (regexp-compile (svref patternbox cflags-max)
+                                             :cflags cflags))
+      (setf (svref patternbox cflags) compiled-pattern))
+    (regexp-exec compiled-pattern string :start start :end end
+                 :eflags eflags)))
 
-; Convert a match (of type regmatch_t) to a substring.
+;; Convert a match (of type regmatch_t) to a substring.
 (defun match-string (string match)
   (let ((start (match-start match))
         (end (match-end match)))
     (make-array (- end start)
                 :element-type 'character
                 :displaced-to string
-                :displaced-index-offset start
-) ) )
+                :displaced-index-offset start)))
 
-; Utility function
-(defun regexp-quote (string)
+;; Utility function
+(defun regexp-quote (string &optional extended)
   (let ((qstring (make-array 10 :element-type 'character
                                 :adjustable t :fill-pointer 0)))
-    (map nil (lambda (c)
+    (map nil (if extended
+               (lambda (c)
                (case c
-                 ((#\$ #\^ #\. #\* #\[ #\] #\\) ; #\+ #\?
+                   ((#\$ #\^ #\. #\* #\[ #\] #\\ #\+ #\?)
                    (vector-push-extend #\\ qstring)))
                (vector-push-extend c qstring))
+               (lambda (c)
+                 (case c
+                   ((#\$ #\^ #\. #\* #\[ #\] #\\)
+                    (vector-push-extend #\\ qstring)))
+                 (vector-push-extend c qstring)))
          string)
     qstring))
 
-(defun regexp-split (pattern string &key (start 0) end (case-sensitive t))
+(defun regexp-split (pattern string &key (start 0) end
+                     (extended nil) (case-sensitive t)
+                     (newline nil) (nosub nil)
+                     (cflags (cflags extended case-sensitive newline nosub))
+                     (notbol nil) (noteol nil)
+                     (eflags (eflags notbol noteol)))
   "Split the STRING by the regexp PATTERN.
 Return a list of substrings of STRINGS."
   (loop
     :with compiled =
             (if (stringp pattern)
-              (regexp-compile pattern case-sensitive)
+              (regexp-compile pattern :cflags cflags)
               pattern)
-    :for match = (regexp-exec compiled string :start start :end end)
+    :for match = (regexp-exec compiled string :start start :end end
+                              :eflags eflags)
     :collect
       (make-array (- (if match (match-start match) (length string)) start)
                   :element-type 'character
@@ -309,19 +340,28 @@
     :do (setq start (match-end match))))
 
 (defmacro with-loop-split ((var stream pattern
-                            &key (start 0) end (case-sensitive t))
+                            &key (start 0) end
+                            (extended nil) (case-sensitive t)
+                            (newline nil) (nosub nil)
+                            (cflags `(cflags ,extended ,case-sensitive
+                                             ,newline ,nosub))
+                            (notbol nil) (noteol nil)
+                            (eflags (eflags notbol noteol)))
                            &body forms)
   "Read from STREAM one line at a time, binding VAR to the split line.
 The line is split with REGEXP-SPLIT using PATTERN."
-  (let ((compiled-pattern (gensym "WLS-")) (line (gensym "WLS-")))
+  (let ((compiled-pattern (gensym "WLS-")) (line (gensym "WLS-"))
+        (ef (gensym "WLS-")))
     `(loop
        :with ,compiled-pattern =
          (if (stringp ,pattern)
-           (regexp-compile ,pattern ,case-sensitive)
+           (regexp-compile ,pattern :cflags ,cflags)
            ,pattern)
+       :and ,ef = ,eflags
        :and ,var
        :for ,line = (read-line ,stream nil nil)
        :while ,line
        :do (setq ,var
-             (regexp-split ,compiled-pattern ,line :start ,start :end ,end))
+             (regexp-split ,compiled-pattern ,line :start ,start :end ,end
+                           :eflags ,ef))
       ,@forms)))

---

From: Pascal Bourguignon <[email-masked]>
Date: Sat Mar 29 19:41:21 2003

> would you be happy with the appended patch?

Yes. Thank you  very much.  It works with 2.30 (well  I only tested it
with REGEXP:MATCH).