1
0
Fork 0

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.
This commit is contained in:
Andy Wingo 2010-10-14 16:25:30 +02:00
parent 4f62c95bde
commit 5b81c576a5
3 changed files with 15 additions and 11 deletions

View file

@ -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* ...)))))

View file

@ -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) ...)

View file

@ -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
(match-bind pattern line bindings
(cons expr seed)
seed))
'() (string-split string #\newline))))))
'() (string-split string #\newline)))))
(define (dbg fmt . args)
(apply format (current-error-port) fmt args))