diff options
| author | 2024-12-27 22:55:30 -0500 | |
|---|---|---|
| committer | 2024-12-27 22:58:52 -0500 | |
| commit | cc1b6ef1bf392b158eb3e16e0a1998959f382385 (patch) | |
| tree | d4510e5a5ca3b9573b5cb2faa2e6fbf333117963 | |
| parent | chicken (diff) | |
Rewrite cond-thunk to be in terms of cond, and rename tests for
chicken
| -rw-r--r-- | mcgoron.cond-thunk.scm | 15 | ||||
| -rw-r--r-- | tests/cas.scm (renamed from test/cas.scm) | 0 | ||||
| -rw-r--r-- | tests/run.scm (renamed from test/cond-thunk-test.scm) | 2 |
3 files changed, 8 insertions, 9 deletions
diff --git a/mcgoron.cond-thunk.scm b/mcgoron.cond-thunk.scm index ff7171e..ebd8bfd 100644 --- a/mcgoron.cond-thunk.scm +++ b/mcgoron.cond-thunk.scm @@ -16,14 +16,13 @@ (define-syntax cond-thunk (syntax-rules (else) - ((cond-thunk (else body ...)) - (begin body ...)) - ((cond-thunk expr rest ...) - (let ((value expr)) - (if value - (value) - (cond-thunk rest ...)))) - ((cond-thunk) #f))) + ((cond-thunk expr ... (else body ...)) + (cond + (expr => (lambda (x) (x))) + ... + (else body ...))) + ((cond-thunk expr ...) + (cond-thunk expr ... (else #f))))) (define any-thunk (letrec ((loop diff --git a/test/cas.scm b/tests/cas.scm index 5d87632..5d87632 100644 --- a/test/cas.scm +++ b/tests/cas.scm diff --git a/test/cond-thunk-test.scm b/tests/run.scm index df620d0..c98e76f 100644 --- a/test/cond-thunk-test.scm +++ b/tests/run.scm @@ -71,4 +71,4 @@ (on-pair #f) (on-boolean #f) (else #f)))) - +(test-exit) |
