Created
March 26, 2010 10:38
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; append1 | |
;; fold-right | |
(use srfi-1) | |
(define (append1 l1 l2) | |
(fold-right cons l2 l1)) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; fold | |
(define (append1 l1 l2) | |
(fold cons l2 (reverse l1))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again recur | |
(define (append1 l1 l2) | |
(if (null? l1) | |
l2 | |
(cons (car l1) | |
(append1 (cdr l1) l2)))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again named-let | |
(define (append1 l1 l2) | |
(let loop ((l l1) | |
(acc l2)) | |
(if (null? l) | |
acc | |
(cons (car l) | |
(loop (cdr l) acc))))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again letrec | |
(define (append1 l1 l2) | |
(letrec | |
((rec (lambda (l acc) | |
(if (null? l) | |
acc | |
(cons (car l) | |
(rec (cdr l) acc)))))) | |
(rec l1 l2))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again accumulate | |
(define (append1 l1 l2) | |
(letrec | |
((rec (lambda (l acc) | |
(if (null? l) | |
acc | |
(rec (cdr l)(cons (car l) | |
acc)))))) | |
(rec (reverse l1) l2))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again cps | |
(define (append1 l1 l2) | |
(letrec | |
((rec/cps (lambda (l seed cont) | |
(if (null? l) | |
(cont seed) | |
(rec/cps (cdr l) | |
seed | |
(lambda (ls) | |
(cont (cons (car l) | |
ls)))))))) | |
(rec l1 l2 identity))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; again call/cc | |
(define (append1 l1 l2) | |
(let/cc return | |
(let* ((continue #f) | |
(l (reverse l1)) | |
(acc l2)) | |
(let/cc cont | |
(set! continue cont)) | |
(when (null? l) | |
(return acc)) | |
(set! acc (cons (car l) | |
acc)) | |
(set! l (cdr l)) | |
(continue '())))) | |
(append1 '(1 2 3)'(4 5 6)) | |
;; append | |
(use srfi-1) | |
(define (append . l) | |
(fold (lambda (e acc) | |
(fold-right cons e acc)) | |
'() l)) | |
(append '(1 2 3)'(4 5 6)'(7 8 9)) | |
;; again letrec | |
(define (append . l) | |
(if (null? l) | |
'() | |
(letrec | |
((a1 (lambda (l acc) | |
(if (null? l) | |
acc | |
(cons (car l)(a1 (cdr l) acc))))) | |
(rec (lambda (l) | |
(if (null? (cdr l)) | |
(car l) | |
(a1 (car l)(rec (cdr l))))))) | |
(rec l)))) | |
(append '(1 2 3)'(4 5 6)'(7 8 9)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; again unfold | |
;; http://practical-scheme.net/gauche/man/gauche-refj_225.html | |
;; (unfold p f g seed tail-gen) == | |
;; (if (p seed) | |
;; (tail-gen seed) | |
;; (cons (f seed) | |
;; (unfold p f g (g seed)))) | |
(define (append1 l1 l2) | |
(unfold null? car cdr l1 (lambda (l) | |
l2))) | |
;; again unfold-right | |
;; http://practical-scheme.net/gauche/man/gauche-refj_225.html | |
;; (unfold-right p f g seed tail) == | |
;; (let lp ((seed seed) (lis tail)) | |
;; (if (p seed) | |
;; lis | |
;; (lp (g seed) (cons (f seed) lis)))) | |
(use srfi-1) | |
(define (append1 l1 l2) | |
(unfold-right null? car cdr (reverse l1) l2)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment