diff options
| author |  Peter McGoron
| 2024-12-30 09:52:23 -0500 |
|---|---|---|
| committer | Peter McGoron
| 2024-12-30 09:52:23 -0500 |
| commit | 27eaddbc13849e5b0e214bca956048c22fadb1c8 (patch) | |
| tree | 1eff0fa16a776b43d5dccd8fb44fee85e0795722 /mcgoron.cond-thunk.values.scm | |
| parent | define-record-type/destructor (diff) | |
fix define-record-type/destructor and refactor tests
Diffstat (limited to 'mcgoron.cond-thunk.values.scm')
| -rw-r--r-- | mcgoron.cond-thunk.values.scm | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/mcgoron.cond-thunk.values.scm b/mcgoron.cond-thunk.values.scm index 8330ba1..7ca5236 100644 --- a/mcgoron.cond-thunk.values.scm +++ b/mcgoron.cond-thunk.values.scm @@ -45,7 +45,7 @@ (after ((when (pair? x))) (values (car x) (cdr x))))) -(define (list-length-destructor whole-list num final-call) +(define (list-length-destructor whole-list num kont) (cond-thunk (when-ct (not (integer? num)) (error "must be integer" num)) @@ -57,16 +57,17 @@ (num num)) (cond-values (after ((when (= num 0))) - (final-call collected iterator)) + (kont collected iterator)) (after ((let (pair=> iterator) => (head rest))) - (loop (cdr rest) (cons head collected) (- num 1)))))))) + (loop rest (cons head collected) (- num 1)))))))) (define (length-at-least=> whole-list num) (list-length-destructor whole-list num (lambda (reverse-seen rest) - (when-ct (or (null? rest) (pair? rest)) - (apply values - (reverse (cons rest reverse-seen))))))) + (cond-values + (when-ct (or (null? rest) (pair? rest)) + (apply values + (reverse (cons rest reverse-seen)))))))) (define (length=> whole-list num) (list-length-destructor whole-list num @@ -77,13 +78,13 @@ (define-syntax define-record-type/destructor (syntax-rules () ((_ type-name cstr predicate? destructor=> - (arg-name accessor . rest) + (arg-name accessor setter ...) ...) (begin (define-record-type type-name - str + cstr predicate? - (arg-name accessor . rest) + (arg-name accessor setter ...) ...) (define (destructor=> record) (cond-values |