From b404c4e92b9bb7b5c59f3b1183c0fc314f484418 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Mon, 17 Aug 2015 10:46:38 -0400 Subject: [PATCH 1/3] add lens-if --- unstable/lens/if.rkt | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 unstable/lens/if.rkt diff --git a/unstable/lens/if.rkt b/unstable/lens/if.rkt new file mode 100644 index 0000000..c12173d --- /dev/null +++ b/unstable/lens/if.rkt @@ -0,0 +1,26 @@ +#lang racket/base + +(provide lens-if) + +(require lens/base/main) +(module+ test + (require rackunit lens/list/main lens/vector/main)) + +(define (lens-if pred lens1 lens2) + (make-lens + (λ (tgt) + (if (pred tgt) + (lens-view lens1 tgt) + (lens-view lens2 tgt))) + (λ (tgt nvw) + (if (pred tgt) + (lens-set lens1 tgt nvw) + (lens-set lens2 tgt nvw))))) + +(module+ test + (define if-lens (lens-if list? first-lens (vector-ref-lens 0))) + (check-equal? (lens-view if-lens '(1 2 3)) 1) + (check-equal? (lens-view if-lens '#(1 2 3)) 1) + (check-equal? (lens-set if-lens '(1 2 3) 'a) '(a 2 3)) + (check-equal? (lens-set if-lens '#(1 2 3) 'a) '#(a 2 3)) + ) From f0d3e30dc27e4cc4934cd1c36c2e25970d3f606a Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Mon, 17 Aug 2015 12:01:27 -0400 Subject: [PATCH 2/3] add lens-cond --- unstable/lens/if.rkt | 41 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/unstable/lens/if.rkt b/unstable/lens/if.rkt index c12173d..2fe7108 100644 --- a/unstable/lens/if.rkt +++ b/unstable/lens/if.rkt @@ -1,10 +1,16 @@ #lang racket/base -(provide lens-if) +(provide lens-if + lens-cond + ) -(require lens/base/main) +(require lens/base/main + racket/function + (for-syntax racket/base + syntax/parse + )) (module+ test - (require rackunit lens/list/main lens/vector/main)) + (require rackunit lens/list/main lens/vector/main lens/string)) (define (lens-if pred lens1 lens2) (make-lens @@ -17,10 +23,39 @@ (lens-set lens1 tgt nvw) (lens-set lens2 tgt nvw))))) +(define (any? x) #t) + +(define-syntax lens-cond + (syntax-parser #:literals (else) + [(lens-cond [pred-expr:expr lens-expr:expr] ... [else else-lens-expr:expr]) + #'(lens-cond [pred-expr lens-expr] ... [any? else-lens-expr])] + [(lens-cond [pred-expr:expr lens-expr:expr] ...) + #:with [pred ...] (generate-temporaries #'[pred-expr ...]) + #:with [lens ...] (generate-temporaries #'[lens-expr ...]) + #'(let ([pred pred-expr] ... [lens lens-expr] ...) + (make-lens + (λ (tgt) + (cond [(pred tgt) (lens-view lens tgt)] + ... + [else (error 'lens-cond "expected ~a, given: ~v" '(or/c pred-expr ...) tgt)])) + (λ (tgt nvw) + (cond [(pred tgt) (lens-set lens tgt nvw)] + ... + [else (error 'lens-cond "expected ~a, given: ~v" '(or/c pred-expr ...) tgt)]))))])) + (module+ test (define if-lens (lens-if list? first-lens (vector-ref-lens 0))) (check-equal? (lens-view if-lens '(1 2 3)) 1) (check-equal? (lens-view if-lens '#(1 2 3)) 1) (check-equal? (lens-set if-lens '(1 2 3) 'a) '(a 2 3)) (check-equal? (lens-set if-lens '#(1 2 3) 'a) '#(a 2 3)) + (define cond-lens (lens-cond [list? first-lens] + [vector? (vector-ref-lens 0)] + [string? (string-ref-lens 0)])) + (check-equal? (lens-view cond-lens '(1 2 3)) 1) + (check-equal? (lens-view cond-lens '#(1 2 3)) 1) + (check-equal? (lens-view cond-lens "123") #\1) + (check-equal? (lens-set cond-lens '(1 2 3) 'a) '(a 2 3)) + (check-equal? (lens-set cond-lens '#(1 2 3) 'a) '#(a 2 3)) + (check-equal? (lens-set cond-lens "123" #\a) "a23") ) From e1778bc512f287fae9ba97f0ac13da4fd5e868ae Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Mon, 17 Aug 2015 12:08:07 -0400 Subject: [PATCH 3/3] add lens-match --- unstable/lens/if.rkt | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/unstable/lens/if.rkt b/unstable/lens/if.rkt index 2fe7108..d12aec7 100644 --- a/unstable/lens/if.rkt +++ b/unstable/lens/if.rkt @@ -2,10 +2,11 @@ (provide lens-if lens-cond + lens-match ) (require lens/base/main - racket/function + racket/match (for-syntax racket/base syntax/parse )) @@ -43,6 +44,19 @@ ... [else (error 'lens-cond "expected ~a, given: ~v" '(or/c pred-expr ...) tgt)]))))])) +(define-syntax lens-match + (syntax-parser + [(lens-cond [pat:expr lens-expr:expr] ...) + #'(make-lens + (λ (tgt) + (match tgt + [pat (lens-view lens-expr tgt)] + ...)) + (λ (tgt nvw) + (match tgt + [pat (lens-set lens-expr tgt nvw)] + ...)))])) + (module+ test (define if-lens (lens-if list? first-lens (vector-ref-lens 0))) (check-equal? (lens-view if-lens '(1 2 3)) 1) @@ -58,4 +72,16 @@ (check-equal? (lens-set cond-lens '(1 2 3) 'a) '(a 2 3)) (check-equal? (lens-set cond-lens '#(1 2 3) 'a) '#(a 2 3)) (check-equal? (lens-set cond-lens "123" #\a) "a23") + (define match-lens (lens-match [(list a) first-lens] + [(list a b) second-lens] + [(list a b c) third-lens] + [(list a ... b) (list-ref-lens (length a))])) + (check-equal? (lens-view match-lens '(1)) 1) + (check-equal? (lens-view match-lens '(1 2)) 2) + (check-equal? (lens-view match-lens '(1 2 3)) 3) + (check-equal? (lens-view match-lens '(1 2 3 4 5 6)) 6) + (check-equal? (lens-set match-lens '(1) 'a) '(a)) + (check-equal? (lens-set match-lens '(1 2) 'a) '(1 a)) + (check-equal? (lens-set match-lens '(1 2 3) 'a) '(1 2 a)) + (check-equal? (lens-set match-lens '(1 2 3 4 5 6) 'a) '(1 2 3 4 5 a)) )