Want more features on Pastebin? Sign Up, it's FREE!
Guest

Robert Fisher

By: a guest on Mar 5th, 2009  |  syntax: Scheme  |  size: 3.85 KB  |  views: 145  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!r6rs
  2. (import (rnrs))
  3.  
  4. (define text '(("#!r6rs"
  5.                 "(import (rnrs))"
  6.                 ""
  7.                 "(define text '(")
  8.                #f
  9.                ("))"
  10.                 ""
  11.                 "(define (add-between lyst between)"
  12.                 "  (reverse (fold-left (lambda (a b)"
  13.                 "                        (cons* b between a))"
  14.                 "                      (list (car lyst))"
  15.                 "                      (cdr lyst))))"
  16.                 ""
  17.                 "(define (print-list PRINT-PROC LIST BETWEEN-PROC)"
  18.                 "  (for-each (lambda (thunk)"
  19.                 "              (thunk))"
  20.                 "            (add-between (map (lambda (subitem)"
  21.                 "                                (lambda ()"
  22.                 "                                  (PRINT-PROC subitem)))"
  23.                 "                              LIST)"
  24.                 "                         BETWEEN-PROC)))"
  25.                 ""
  26.                 "(define (for-each-if TRUE-PROC FALSE-PROC LIST)"
  27.                 "  (for-each (lambda (item)"
  28.                 "              (if item"
  29.                 "                  (TRUE-PROC item)"
  30.                 "                  (FALSE-PROC)))"
  31.                 "            LIST))"
  32.                 ""
  33.                 "(define (indent n)"
  34.                 "  (newline)"
  35.                 "  (display (make-string n #\\space)))"
  36.                 ""
  37.                 "(for-each-if (lambda (item)"
  38.                 "               (print-list display item newline))"
  39.                 "             (lambda ()"
  40.                 "               (for-each-if (lambda (item)"
  41.                 "                              (display \"(\")"
  42.                 "                              (print-list write"
  43.                 "                                          item"
  44.                 "                                          (lambda ()"
  45.                 "                                            (indent 16)))"
  46.                 "                              (display \")\"))"
  47.                 "                            (lambda ()"
  48.                 "                              (indent 15)"
  49.                 "                              (write #f)"
  50.                 "                              (indent 15))"
  51.                 "                            text))"
  52.                 "             text)"
  53.                 "")))
  54.  
  55. (define (add-between lyst between)
  56.   (reverse (fold-left (lambda (a b)
  57.                         (cons* b between a))
  58.                       (list (car lyst))
  59.                       (cdr lyst))))
  60.  
  61. (define (print-list PRINT-PROC LIST BETWEEN-PROC)
  62.   (for-each (lambda (thunk)
  63.               (thunk))
  64.             (add-between (map (lambda (subitem)
  65.                                 (lambda ()
  66.                                   (PRINT-PROC subitem)))
  67.                               LIST)
  68.                          BETWEEN-PROC)))
  69.  
  70. (define (for-each-if TRUE-PROC FALSE-PROC LIST)
  71.   (for-each (lambda (item)
  72.               (if item
  73.                   (TRUE-PROC item)
  74.                   (FALSE-PROC)))
  75.             LIST))
  76.  
  77. (define (indent n)
  78.   (newline)
  79.   (display (make-string n #\space)))
  80.  
  81. (for-each-if (lambda (item)
  82.                (print-list display item newline))
  83.              (lambda ()
  84.                (for-each-if (lambda (item)
  85.                               (display "(")
  86.                               (print-list write
  87.                                           item
  88.                                           (lambda ()
  89.                                             (indent 16)))
  90.                               (display ")"))
  91.                             (lambda ()
  92.                               (indent 15)
  93.                               (write #f)
  94.                               (indent 15))
  95.                             text))
  96.              text)
clone this paste RAW Paste Data