From 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2d2

---
 genwrite.scm | 32 +++++++++++++++++---------------
 1 file changed, 17 insertions(+), 15 deletions(-)

(limited to 'genwrite.scm')

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))
-- 
cgit v1.2.3