From: Jim Date: Wed, 29 Apr 2015 22:46:28 +0000 (-0400) Subject: update refunct zippers code X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=27eb9f9e70d526895797ac831defb79ac3769b2e;ds=sidebyside update refunct zippers code --- diff --git a/code/refunctionalizing_zippers.rkt b/code/refunctionalizing_zippers.rkt index 3b51ce99..cac0916b 100644 --- a/code/refunctionalizing_zippers.rkt +++ b/code/refunctionalizing_zippers.rkt @@ -17,19 +17,26 @@ [else (tz1 (pair (cons (nextchar z) (saved z)) (rest z)))])) ; using explicit continuations -(define (tc1 l k) +(define (tc0 l k) (cond [(null? l) (reverse (k '()))] + [(eqv? #\S (car l)) (tc0 (cdr l) (compose k k))] + [else (tc0 (cdr l) (lambda (tail) (cons (car l) (k tail))))])) + +; improvement: if we flip the order of cons and k in the last line, we can avoid the need to reverse +(define (tc1 l k) + (cond + [(null? l) (k '())] [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))] - [else (tc1 (cdr l) (lambda (tail) (cons (car l) (k tail))))])) + [else (tc1 (cdr l) (lambda (tail) (k (cons (car l) tail))))])) ; using implicit continuations (reset/shift) (define (tr1 l) (shift k (cond - [(null? l) (reverse (k '()))] + [(null? l) (k '())] [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))] - [else ((lambda (tail) (cons (car l) (k tail))) (tr1 (cdr l)))]))) + [else ((lambda (tail) (k (cons (car l) tail))) (tr1 (cdr l)))]))) ; wrapper functions, there's a (test) function at the end @@ -59,23 +66,21 @@ [else (tz3 (pair (cons (nextchar z) (saved z)) (rest z)))])) ; using explicit continuations -; there are several working solutions -; but it's a bit tricky to get the reverses in the right place, and the order of appending right (define (tc3 l k) (cond - [(null? l) (reverse (k '()))] - [(eqv? #\# (car l)) (append (reverse (k '())) (tc3 (cdr l) identity))] + [(null? l) (k '())] + [(eqv? #\# (car l)) (append (k '()) (tc3 (cdr l) identity))] [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))] - [else (tc3 (cdr l) (lambda (tail) (cons (car l) (k tail))))])) + [else (tc3 (cdr l) (lambda (tail) (k (cons (car l) tail))))])) ; using implicit continuations (reset/shift) (define (tr3 l) (shift k (cond - [(null? l) (reverse (k '()))] - [(eqv? #\# (car l)) (append (reverse (k '())) (reset (tr3 (cdr l))))] + [(null? l) (identity (k '()))] + [(eqv? #\# (car l)) (append (k '()) (reset (tr3 (cdr l))))] [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))] - [else ((lambda (tail) (cons (car l) (k tail))) (tr3 (cdr l)))]))) + [else ((lambda (tail) (k (cons (car l) tail))) (tr3 (cdr l)))]))) (define (tz4 s) (list->string (tz3 (cons '() (string->list s))))) @@ -93,9 +98,11 @@ (equal? (t1 inp) (t2 inp))) (and (equal? (tz2 "abSd") "ababd") + (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd") (cmp tc2 tz2 "abSd") (cmp tr2 tz2 "abSd") (equal? (tz2 "aSbS") "aabaab") + (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "aSbS") (cmp tc2 tz2 "aSbS") (cmp tr2 tz2 "aSbS") (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")