
Robert Fisher
By: a guest on
Mar 5th, 2009 | syntax:
Scheme | size: 3.85 KB | hits: 127 | expires: Never
#!r6rs
(import (rnrs))
(define text '(("#!r6rs"
"(import (rnrs))"
""
"(define text '(")
#f
("))"
""
"(define (add-between lyst between)"
" (reverse (fold-left (lambda (a b)"
" (cons* b between a))"
" (list (car lyst))"
" (cdr lyst))))"
""
"(define (print-list PRINT-PROC LIST BETWEEN-PROC)"
" (for-each (lambda (thunk)"
" (thunk))"
" (add-between (map (lambda (subitem)"
" (lambda ()"
" (PRINT-PROC subitem)))"
" LIST)"
" BETWEEN-PROC)))"
""
"(define (for-each-if TRUE-PROC FALSE-PROC LIST)"
" (for-each (lambda (item)"
" (if item"
" (TRUE-PROC item)"
" (FALSE-PROC)))"
" LIST))"
""
"(define (indent n)"
" (newline)"
" (display (make-string n #\\space)))"
""
"(for-each-if (lambda (item)"
" (print-list display item newline))"
" (lambda ()"
" (for-each-if (lambda (item)"
" (display \"(\")"
" (print-list write"
" item"
" (lambda ()"
" (indent 16)))"
" (display \")\"))"
" (lambda ()"
" (indent 15)"
" (write #f)"
" (indent 15))"
" text))"
" text)"
"")))
(define (add-between lyst between)
(reverse (fold-left (lambda (a b)
(cons* b between a))
(list (car lyst))
(cdr lyst))))
(define (print-list PRINT-PROC LIST BETWEEN-PROC)
(for-each (lambda (thunk)
(thunk))
(add-between (map (lambda (subitem)
(lambda ()
(PRINT-PROC subitem)))
LIST)
BETWEEN-PROC)))
(define (for-each-if TRUE-PROC FALSE-PROC LIST)
(for-each (lambda (item)
(if item
(TRUE-PROC item)
(FALSE-PROC)))
LIST))
(define (indent n)
(newline)
(display (make-string n #\space)))
(for-each-if (lambda (item)
(print-list display item newline))
(lambda ()
(for-each-if (lambda (item)
(display "(")
(print-list write
item
(lambda ()
(indent 16)))
(display ")"))
(lambda ()
(indent 15)
(write #f)
(indent 15))
text))
text)