diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-09 13:56:50 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-09 13:56:50 +0100 |
commit | 1a1798f32ff13908b53db43648cb2f7665e522af (patch) | |
tree | 9fab336e718c3f0cfd15eec707acda1cef04c5a8 /vcalendar | |
parent | Minor cleanups. (diff) | |
download | calp-1a1798f32ff13908b53db43648cb2f7665e522af.tar.gz calp-1a1798f32ff13908b53db43648cb2f7665e522af.tar.xz |
Fix compilation error.
Diffstat (limited to 'vcalendar')
-rw-r--r-- | vcalendar/recur.scm | 25 |
1 files changed, 11 insertions, 14 deletions
diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index 4ca71f29..5687fb7f 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -49,20 +49,17 @@ (define-syntax-rule (throw-returnable symb args ...) (call/cc (lambda (cont) (throw symb cont args ...)))) -;;; TODO -;;; something with this will only properly compiled if run interactively. -;;; But once compiled from the repl it stays compiled from script -;;; And script can run it, it just complains and keeps recompiling. -(define ((handle-case stx obj) key val proc) - (with-syntax ((skey (datum->syntax - stx (symbol-downcase (syntax->datum key))))) - #`((#,key) - (let ((v #,val)) - (cond ((not v) (throw-returnable 'invalid-value #,obj (quote #,key) v)) - ((#,proc #,val) (set! (skey #,obj) v)) - (else (set! (skey #,obj) - (throw-returnable 'unfulfilled-constraint - #,obj (quote #,key) v)))))))) +(eval-when (expand) + (define ((handle-case stx obj) key val proc) + (with-syntax ((skey (datum->syntax + stx (symbol-downcase (syntax->datum key))))) + #`((#,key) + (let ((v #,val)) + (cond ((not v) (throw-returnable 'invalid-value #,obj (quote #,key) v)) + ((#,proc #,val) (set! (skey #,obj) v)) + (else (set! (skey #,obj) + (throw-returnable 'unfulfilled-constraint + #,obj (quote #,key) v))))))))) (define-syntax quick-case (lambda (stx) |