ryuslash/undone
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Simplify macro

Browse source
This commit is contained in:
Tom Willemsen 2012-08-14 22:53:43 +02:00
parent 8681daf54a
commit d1bc934f9c
1 changed files with 15 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
undone/main.scm
View file

@ -5,8 +5,8 @@
(define-syntax define-view
(lambda (x)
(syntax-case x ()
((_ name doc fmt fields fields* ...)
(syntax-case x (where)
((_ name doc fmt fields fields* ... where predicate)
(with-syntax ((viewname
(datum->syntax
x (symbol-append (syntax->datum #'name) '-view))))
@ -15,16 +15,22 @@
doc
(map (lambda (item)
(let (#,@(map (lambda (field)
#`(#,field (cdr (assq (quote #,field) item))))
#'(fields fields* ...)))
(format #t fmt
#,@(map (lambda (field)
field)
#'(fields fields* ...)))))
#`(#,field (cdr (assq (quote #,field) item))))
#'(fields fields* ...)))
(if predicate
(format #t fmt
#,@(map (lambda (field)
field)
#'(fields fields* ...))))))
todo-list))
(set! view-list
(append view-list
(list (cons 'name viewname))))))))))
(list (cons 'name viewname)))))))
((_ name doc fmt fields fields* ...)
(with-syntax ((viewname
(datum->syntax
x (symbol-append (syntax->datum #'name) '-view))))
#'(define-view name doc fmt fields fields* ... where #t))))))
(define todo-list-file "todo.scm")