From 5b81c576a5cc297bc9b835d5cbd2881aae319f60 Mon Sep 17 00:00:00 2001
From: Andy Wingo
Date: Thu, 14 Oct 2010 16:25:30 +0200
Subject: fix a number of syncase porting bugs

* tekuti/git.scm (with-output-to-blob, with-input-from-blob): Use
  hygienic macros.

* tekuti/match-bind.scm (match-bind): Add a check that the pattern is a
  literal string.

* tekuti/util.scm (match-lines): Fix port from defmacro.
---
 tekuti/git.scm        | 12 ++++++++----
 tekuti/match-bind.scm |  1 +
 tekuti/util.scm       | 13 ++++++-------
 3 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/tekuti/git.scm b/tekuti/git.scm
index aac6a6e..96e7383 100644
--- a/tekuti/git.scm
+++ b/tekuti/git.scm
@@ -334,11 +334,15 @@
 (define (with-output-to-blob* thunk)
   (git-hash-object (with-output-to-string thunk)))
 
-(define-macro (with-output-to-blob . forms)
-  `(,with-output-to-blob* (lambda () ,@forms)))
+(define-syntax with-output-to-blob
+  (syntax-rules ()
+    ((_ f f* ...)
+     (with-output-to-blob* (lambda () f f* ...)))))
 
 (define (with-input-from-blob* sha1 thunk)
   (with-input-from-string (git "show" sha1) thunk))
 
-(define-macro (with-input-from-blob sha1 . forms)
-  `(,with-input-from-blob* ,sha1 (lambda () ,@forms)))
+(define-syntax with-input-from-blob
+  (syntax-rules ()
+    ((_ sha1 f f* ...)
+     (with-input-from-blob* sha1 (lambda () f f* ...)))))
diff --git a/tekuti/match-bind.scm b/tekuti/match-bind.scm
index c3f87e7..35a28b4 100644
--- a/tekuti/match-bind.scm
+++ b/tekuti/match-bind.scm
@@ -113,6 +113,7 @@ Here is a short example:
       ((_ regex str vars consequent)
        #'(match-bind regex str vars consequent (if #f #f)))
       ((_ regex str vars consequent alternate)
+       (string? (syntax->datum #'regex))
        (let ((m #'m))
          (with-syntax ((m m)
                        (((var val) ...)
diff --git a/tekuti/util.scm b/tekuti/util.scm
index 025a180..9b86a30 100644
--- a/tekuti/util.scm
+++ b/tekuti/util.scm
@@ -97,13 +97,12 @@
 (define-syntax match-lines
   (syntax-rules ()
     ((_ string pattern bindings expr)
-     (let ((rx (irregex pattern)))
-       (fold
-        (lambda (line seed)
-          (match-bind rx line bindings
-                      (cons expr seed)
-                      seed))
-        '() (string-split string #\newline))))))
+     (fold
+      (lambda (line seed)
+        (match-bind pattern line bindings
+                    (cons expr seed)
+                    seed))
+      '() (string-split string #\newline)))))
 
 (define (dbg fmt . args)
   (apply format (current-error-port) fmt args))
-- 
cgit v1.2.3-54-g00ecf