diff options
Diffstat (limited to 'genwrite.scm')
| -rw-r--r-- | genwrite.scm | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/genwrite.scm b/genwrite.scm index 0bb4e56..2e4bf60 100644 --- a/genwrite.scm +++ b/genwrite.scm @@ -3,13 +3,15 @@ ;; Author: Marc Feeley (feeley@iro.umontreal.ca) ;; Distribution restrictions: none +(define genwrite:newline-str (make-string 1 #\newline)) + (define (generic-write obj display? width output) (define (read-macro? l) (define (length1? l) (and (pair? l) (null? (cdr l)))) (let ((head (car l)) (tail (cdr l))) (case head - ((QUOTE QUASIQUOTE UNQUOTE UNQUOTE-SPLICING) (length1? tail)) + ((quote quasiquote unquote unquote-splicing) (length1? tail)) (else #f)))) (define (read-macro-body l) @@ -18,10 +20,10 @@ (define (read-macro-prefix l) (let ((head (car l)) (tail (cdr l))) (case head - ((QUOTE) "'") - ((QUASIQUOTE) "`") - ((UNQUOTE) ",") - ((UNQUOTE-SPLICING) ",@")))) + ((quote) "'") + ((quasiquote) "`") + ((unquote) ",") + ((unquote-splicing) ",@")))) (define (out str col) (and col (output str) (+ col (string-length str)))) @@ -90,7 +92,7 @@ (define (indent to col) (and col (if (< to col) - (and (out (make-string 1 #\newline) col) (spaces to 0)) + (and (out genwrite:newline-str col) (spaces to 0)) (spaces (- to col) col)))) (define (pr obj col extra pp-pair) @@ -228,20 +230,20 @@ (define (style head) (case head - ((LAMBDA LET* LETREC DEFINE) pp-LAMBDA) - ((IF SET!) pp-IF) - ((COND) pp-COND) - ((CASE) pp-CASE) - ((AND OR) pp-AND) - ((LET) pp-LET) - ((BEGIN) pp-BEGIN) - ((DO) pp-DO) + ((lambda let* letrec define) pp-LAMBDA) + ((if set!) pp-IF) + ((cond) pp-COND) + ((case) pp-CASE) + ((and or) pp-AND) + ((let) pp-LET) + ((begin) pp-BEGIN) + ((do) pp-DO) (else #f))) (pr obj col 0 pp-expr)) (if width - (out (make-string 1 #\newline) (pp obj 0)) + (out genwrite:newline-str (pp obj 0)) (wr obj 0))) ; (reverse-string-append l) = (apply string-append (reverse l)) |