From 3f9aa7b6a4264189e4566e1d643c91e3e9d5bff4 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 15 Oct 1988 17:19:29 +0000 Subject: [PATCH] Change `char->string' to `string'. `char->string' still defined as alias. --- v7/src/runtime/char.scm | 6 +++--- v7/src/runtime/parse.scm | 18 +++++++++--------- v7/src/runtime/string.scm | 6 ++++-- v7/src/runtime/strott.scm | 20 +++++++++++++++----- v7/src/runtime/strout.scm | 10 +++++----- v7/src/runtime/unpars.scm | 8 ++++---- 6 files changed, 40 insertions(+), 28 deletions(-) diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm index e792675c2..34636532a 100644 --- a/v7/src/runtime/char.scm +++ b/v7/src/runtime/char.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/char.scm,v 14.1 1988/06/13 11:41:03 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/char.scm,v 14.2 1988/10/15 17:19:05 cph Rel $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -250,9 +250,9 @@ MIT in each case. |# (or (char=? base-char backslash-char) (char-set-member? char-set/atom-delimiters base-char))) - (string-append "\\" (char->string base-char))) + (string-append "\\" (string base-char))) ((char-graphic? base-char) - (char->string base-char)) + (string base-char)) (else (string-append "string #\# char) (read-atom))))) + (string-append (string #\# char) (read-atom))))) (or (parse-number number) (parse-error "Bad number syntax" number)))) @@ -407,9 +407,9 @@ MIT in each case. |# (define (parse-object/string-quote) (discard-char) (let loop () - (let ((string (read-string char-set/string-delimiters))) + (let ((head (read-string char-set/string-delimiters))) (if (char=? #\" (read-char)) - string + head (let ((char (let ((char (read-char))) (cond ((char-ci=? char #\t) #\Tab) @@ -417,11 +417,11 @@ MIT in each case. |# ((char-ci=? char #\f) #\Page) ((char->digit char 8) (octal->char - (string-append (char->string char) + (string-append (string char) (read-string char-set/not-octal)))) (else char))))) - (string-append string - (char->string char) + (string-append head + (string char) (loop))))))) (define (octal->char string) @@ -448,9 +448,9 @@ MIT in each case. |# (let loop () (cond ((char=? #\\ (peek-char)) (discard-char) - (char->string (read-char))) + (string (read-char))) ((char-set-member? char-set/char-delimiters (peek-char)) - (char->string (read-char))) + (string (read-char))) (else (let ((string (read-string char-set/char-delimiters))) (if (let ((char (peek-char/eof-ok))) diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm index 339b36465..c21a76796 100644 --- a/v7/src/runtime/string.scm +++ b/v7/src/runtime/string.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/string.scm,v 14.1 1988/06/13 11:51:44 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/string.scm,v 14.2 1988/10/15 17:19:16 cph Rel $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -195,9 +195,11 @@ MIT in each case. |# (loop (1+ index) (cdr chars))))) (loop 0 chars))) -(define (char->string . chars) +(define (string . chars) (list->string chars)) +(define char->string string) + (define (string->list string) (substring->list string 0 (string-length string))) diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm index 6fce9150c..3a396db92 100644 --- a/v7/src/runtime/strott.scm +++ b/v7/src/runtime/strott.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strott.scm,v 14.2 1988/06/13 11:51:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strott.scm,v 14.3 1988/10/15 17:19:21 cph Rel $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -66,6 +66,19 @@ MIT in each case. |# accumulator counter) +(define (operation/write-char port char) + (let ((state (output-port/state port))) + (let ((accumulator (output-string-state/accumulator state)) + (counter (output-string-state/counter state))) + (if (zero? counter) + ((output-string-state/return state) + (cons true (apply string-append (reverse! accumulator)))) + (begin + (set-output-string-state/accumulator! + state + (cons (string char) accumulator)) + (set-output-string-state/counter! state (-1+ counter))))))) + (define (operation/write-string port string) (let ((state (output-port/state port))) (let ((accumulator (cons string (output-string-state/accumulator state))) @@ -81,9 +94,6 @@ MIT in each case. |# (set-output-string-state/accumulator! state accumulator) (set-output-string-state/counter! state counter)))))) -(define (operation/write-char port char) - (operation/write-string port (char->string char))) - (define (operation/print-self state port) port - (unparse-string state "to string (truncated)")) \ No newline at end of file + (unparse-string state "to string (truncating)")) \ No newline at end of file diff --git a/v7/src/runtime/strout.scm b/v7/src/runtime/strout.scm index 670da734c..452085b74 100644 --- a/v7/src/runtime/strout.scm +++ b/v7/src/runtime/strout.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strout.scm,v 14.2 1988/06/13 11:52:01 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strout.scm,v 14.3 1988/10/15 17:19:25 cph Rel $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -53,11 +53,11 @@ MIT in each case. |# (define output-string-template) -(define-integrable (operation/write-string port string) - (set-output-port/state! port (cons string (output-port/state port)))) - (define (operation/write-char port char) - (operation/write-string port (char->string char))) + (set-output-port/state! port (cons (string char) (output-port/state port)))) + +(define (operation/write-string port string) + (set-output-port/state! port (cons string (output-port/state port)))) (define (operation/print-self state port) port diff --git a/v7/src/runtime/unpars.scm b/v7/src/runtime/unpars.scm index 353e3743b..e894efd92 100644 --- a/v7/src/runtime/unpars.scm +++ b/v7/src/runtime/unpars.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.5 1988/07/16 18:54:39 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unpars.scm,v 14.6 1988/10/15 17:19:29 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -315,9 +315,9 @@ MIT in each case. |# (define (char->octal char) (let ((qr1 (integer-divide (char->ascii char) 8))) (let ((qr2 (integer-divide (integer-divide-quotient qr1) 8))) - (char->string (digit->char (integer-divide-quotient qr2) 8) - (digit->char (integer-divide-remainder qr2) 8) - (digit->char (integer-divide-remainder qr1) 8))))) + (string (digit->char (integer-divide-quotient qr2) 8) + (digit->char (integer-divide-remainder qr2) 8) + (digit->char (integer-divide-remainder qr1) 8))))) (define string-delimiters) -- 2.25.1