diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-10-03 14:15:41 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-10-03 14:15:41 +0200 |
commit | 9a6094444fbfa31301e046fb84659d042b441a18 (patch) | |
tree | 433fb1914bd8c26a1912371c3075ec09dc23bc2a /module | |
parent | Improve lens documentation. (diff) | |
download | calp-9a6094444fbfa31301e046fb84659d042b441a18.tar.gz calp-9a6094444fbfa31301e046fb84659d042b441a18.tar.xz |
Cleanup in lens.
Diffstat (limited to '')
-rw-r--r-- | module/hnh/util/coverage.scm | 8 | ||||
-rw-r--r-- | module/hnh/util/lens.scm | 13 |
2 files changed, 11 insertions, 10 deletions
diff --git a/module/hnh/util/coverage.scm b/module/hnh/util/coverage.scm index 9349c3a1..2517e81f 100644 --- a/module/hnh/util/coverage.scm +++ b/module/hnh/util/coverage.scm @@ -63,14 +63,14 @@ (fold (lambda (line state) (match (parse-coverage-line line) (('DA line hits) - (modify state (compose-lenses car* lines) + (modify state (compose-lens car* lines) (lambda (lines) (cons (cons line hits) lines)))) (('SF source) - (set state (compose-lenses car* filename) source)) + (set state car* filename source)) (('LH hit) - (set state (compose-lenses car* hit-lines) hit)) + (set state car* hit-lines hit)) (('LF lines) - (set state (compose-lenses car* total-lines) lines)) + (set state car* total-lines lines)) (('end-of-record) (cons (coverage-info) state)))) (list (coverage-info)) diff --git a/module/hnh/util/lens.scm b/module/hnh/util/lens.scm index 26c75be7..00f7fe1e 100644 --- a/module/hnh/util/lens.scm +++ b/module/hnh/util/lens.scm @@ -42,10 +42,6 @@ -(define (make-lens getter setter) - (case-lambda ((datum) (getter datum)) - ((datum new-value) (setter datum new-value)))) - (define-syntax build-lens (syntax-rules () ((_ (getter gargs ...) @@ -97,8 +93,13 @@ (build-lens (list-ref idx) (list-change idx))) -(define car* (make-lens car (lambda (pair value) (cons value (cdr pair))))) -(define cdr* (make-lens cdr (lambda (pair value) (cons (car pair) value)))) +(define car* + (case-lambda ((pair) (car pair)) + ((pair value) (cons value (cdr pair))))) + +(define cdr* + (case-lambda ((pair) (cdr pair)) + ((pair value) (cons (car pair) value)))) (define (each obj lens proc) (modify obj lens |