Skip to content

Instantly share code, notes, and snippets.

@valvallow
Created March 26, 2010 10:38
;; 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))
;; 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