Re: regex-case

[Matt Wette <matthew.wette@verizon.net>]

[-- Attachment #1: Type: text/plain, Size: 1778 bytes --]


> On Feb 6, 2016, at 11:13 AM, Matt Wette <matthew.wette@verizon.net> wrote:
> 
> I have always missed the ease provided by Perl in throwing a string at a list of regular expressions.   I have thought it would be nice if the (ice-9 regex) module would provide something comparable .   So I started work on a macro “regex-case”.    Code attached.
> Comments on syntax appreciated. — Matt

I have added the else case and cleaned up the fold in rx-let.  New code attached, and echoed partial here:

;;; Copyright (C) 2016 Matthew R. Wette
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.

(define-syntax rx-let
  (lambda (x)
    (syntax-case x ()
      ((_ m (v ...) exp ...)
       (with-syntax (((i ...)
		      (let f ((n 1) (vl #'(v ...))) ; fold (v ...) to (1 ...)
			(if (null? vl) '() (cons n (f (1+ n) (cdr vl)))))))
	 #'(let ((v (match:substring m i)) ...) exp ...))))))

(define-syntax regex-case
  (lambda (x)
    (syntax-case x (else)
      ((_ str ((pat v ...) exp ...) ...)
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 #'(let ((id (make-regexp pat)) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...))))
      ((_ str ((pat v ...) exp ...) ... (else else-exp ...))
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 #'(let ((id (make-regexp pat)) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...
	     (else else-exp ...)))))
      )))

[-- Attachment #2: regex-case.scm --]
[-- Type: application/octet-stream, Size: 1817 bytes --]

;; v160206c - M.Wette

;;; Copyright (C) 2016 Matthew R. Wette
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.

(use-modules (ice-9 pretty-print))
(use-modules (ice-9 regex))

;; helper macro for regex-case
;; (rx-let m (v ...) exp ...) => (let ((v (match:substring m 1)) ...) exp ...)
(define-syntax rx-let
  (lambda (x)
    (syntax-case x ()
      ((_ m (v ...) exp ...)
       (with-syntax (((i ...)
		      (let f ((n 1) (vl #'(v ...))) ; fold (v ...) to (1 ...)
			(if (null? vl) '() (cons n (f (1+ n) (cdr vl)))))))
	 #'(let ((v (match:substring m i)) ...) exp ...))))))

;; @example
;; (regex-case str
;;  (("([a-z]+)" v) `(lower ,v))
;;  (("([A-Z]+)" v) `(upper ,v))
;;  (else (error "yuck")))
;; @end example
(define-syntax regex-case
  (lambda (x)
    (syntax-case x (else)
      ((_ str ((pat v ...) exp ...) ...)
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 #'(let ((id (make-regexp pat)) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...))))
      ;; todo: pattern with "else"
      ((_ str ((pat v ...) exp ...) ... (else else-exp ...))
       (with-syntax (((id ...) (generate-temporaries #'(pat ...))))
	 #'(let ((id (make-regexp pat)) ...)
	     (cond
	      ((regexp-exec id str) =>
	       (lambda (m) (rx-let m (v ...) exp ...)))
	      ...
	     (else else-exp ...)))))
      )))

(define str "foo(3)")
(write
 (regex-case str
   (("^([a-z]+)\\(([0-9]+)\\)$" v i)
    (list v i))
   (("^([a-z]+)$" v)
    (list v "1"))
   (else
    (error "not found"))
   )
 )
(newline)

;; --- last line ---