summaryrefslogtreecommitdiffstats
path: root/genwrite.scm
diff options
context:
space:
mode:
authorJames LewisMoss <dres@debian.org>2001-07-27 23:45:29 -0400
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commitf559c149c83da84d0b1c285f0298c84aec564af9 (patch)
treef1c91bcb9bb5e6dad87b643127c3f878d80d89ee /genwrite.scm
parentc394920caedf3dac1981bb6b10eeb47fd6e4bb21 (diff)
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-f559c149c83da84d0b1c285f0298c84aec564af9.tar.gz
slib-f559c149c83da84d0b1c285f0298c84aec564af9.zip
Import Debian changes 2d2-1debian/2d2-1
slib (2d2-1) unstable; urgency=low * New upstream version * Revert back to free. Is now so. slib (2d1-1) unstable; urgency=low * New upstream version. * Move to non-free. FSF pointed out license doesn't allow modified versions to be distributed. * Get a complete list of copyrights that apply to the source into copyright file. * Remove setup for guile 1.3. * Remove postrm. Just calling install-info (lintian) Move install-info call to prerm since doc-base doesn't do install-info. slib (2c9-3) unstable; urgency=low * Change info location to section "The Algorithmic Language Scheme" to match up with where guile puts it's files. * Postinst is running slibconfig now. (Closes: #75891) slib (2c9-2) unstable; urgency=low * Stop installing slibconfig (for guile). * In postinst if /usr/sbin/slibconnfig exists call it (Close: #75843 #75891). slib (2c9-1) unstable; urgency=low * New upstream (Closes: #74760) * replace string-index with strsrch:string-index in http-cgi.scm. * Add doc-base support (Closes: #31163)
Diffstat (limited to 'genwrite.scm')
-rw-r--r--genwrite.scm32
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))