diff options
Diffstat (limited to 'module/hnh/util.scm')
| -rw-r--r-- | module/hnh/util.scm | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/module/hnh/util.scm b/module/hnh/util.scm index 6fe9b371..a6581158 100644 --- a/module/hnh/util.scm +++ b/module/hnh/util.scm @@ -5,6 +5,7 @@ :use-module ((sxml fold) :select (fold-values)) :use-module ((srfi srfi-9 gnu) :select (set-fields)) :use-module ((ice-9 copy-tree) :select (copy-tree)) + :use-module ((ice-9 control) :select (call/ec)) :re-export (fold-values) :export (aif awhen @@ -114,14 +115,37 @@ -(define-syntax for - (syntax-rules (in) +(define-syntax (for stx) + (syntax-case stx (in) ((for (<var> <vars> ...) in <collection> b1 body ...) - (map ((@ (ice-9 match) match-lambda) [(<var> <vars> ...) b1 body ...]) - <collection>)) + (with-syntax ((break (datum->syntax stx 'break)) + (continue (datum->syntax stx 'continue))) + #'(call/ec + (lambda (break) + (map ((@ (ice-9 match) match-lambda) + [(<var> <vars> ...) + (call/ec + (lambda (raw-continue) + (let ((continue + (case-lambda + (() #f) + (args (apply raw-continue args))))) + b1 body ...)))]) + <collection>))))) + ((for <var> in <collection> b1 body ...) - (map (lambda (<var>) b1 body ...) - <collection>)))) + (with-syntax ((break (datum->syntax stx 'break)) + (continue (datum->syntax stx 'continue))) + #'(call/ec + (lambda (break) + (map (lambda (<var>) + (call/ec (lambda (raw-continue) + (let ((continue + (case-lambda + (() #f) + (args (apply raw-continue args))))) + b1 body ...)))) + <collection>))))))) |