From 75a97b92240460a74aeb4206fa1d249c358d086f Mon Sep 17 00:00:00 2001 From: Gary Houston Date: Sat, 8 Mar 1997 19:02:20 +0000 Subject: [PATCH] * slib.scm: update read usage. * r4rs.scm: update primitive-load usage. Don't define read-sharp. * boot-9.scm: use read-hash-extend to install extra read syntax. (read-sharp): removed. Adjust usage of primitive-load-path, read, which no longer take case_i or read-sharp arguments. --- ice-9/ChangeLog | 16 ++++++++ ice-9/boot-9.scm | 99 +++++++++++++++++++++++++++++------------------- ice-9/r4rs.scm | 8 +--- ice-9/slib.scm | 2 +- 4 files changed, 78 insertions(+), 47 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index e016208c1..bf7807909 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,15 @@ +Sat Mar 8 04:32:44 1997 Gary Houston + + * slib.scm: update read usage. + + * r4rs.scm: update primitive-load usage. + Don't define read-sharp. + + * boot-9.scm: use read-hash-extend to install extra read syntax. + (read-sharp): removed. + Adjust usage of primitive-load-path, read, which no longer take + case_i or read-sharp arguments. + Sat Mar 8 00:07:54 1997 Mikael Djurfeldt * boot-9.scm: Added loading of session support module. @@ -8,6 +20,10 @@ Sat Mar 8 00:07:54 1997 Mikael Djurfeldt * boot-9.scm (beautify-user-module!): Don't add the root module interface to the end of the use-list of the root module. +Thu Mar 6 07:26:34 1997 Gary Houston + + * boot-9.scm: repl-quit, repl-abort: obsolete variables deleted. + Wed Mar 5 20:30:24 1997 Gary Houston * boot-9.scm: check use-emacs-interface for emacs support. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index ad5902168..db2d78f76 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -713,7 +713,7 @@ ;;; name extensions listed in %load-extensions. (define (load-from-path name) (start-stack 'load-stack - (primitive-load-path name #t read-sharp))) + (primitive-load-path name))) @@ -853,30 +853,59 @@ (map string->symbol fields)))) -(define (read-sharp c port) - (define (barf) - (error "unknown # object" c)) - - (case c - ((#\/) (let ((look (peek-char port))) - (if (or (eof-object? look) - (and (char? look) - (or (char-whitespace? look) - (string-index ")" look)))) - '() - (parse-path-symbol (read port #t read-sharp))))) - ((#\') (read port #t read-sharp)) - ((#\.) (eval (read port #t read-sharp))) - ((#\b) (read:uniform-vector #t port)) - ((#\a) (read:uniform-vector #\a port)) - ((#\u) (read:uniform-vector 1 port)) - ((#\e) (read:uniform-vector -1 port)) - ((#\s) (read:uniform-vector 1.0 port)) - ((#\i) (read:uniform-vector 1/3 port)) - ((#\c) (read:uniform-vector 0+i port)) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) - (read:array c port)) - (else (barf)))) +(read-hash-extend #\/ + (lambda (c port) + (let ((look (peek-char port))) + (if (or (eof-object? look) + (and (char? look) + (or (char-whitespace? look) + (string-index ")" look)))) + '() + (parse-path-symbol (read port)))))) +(read-hash-extend #\' (lambda (c port) + (read port))) +(read-hash-extend #\. (lambda (c port) + (eval (read port)))) + +(if (feature? 'array) + (begin + (let ((make-array-proc (lambda (template) + (lambda (c port) + (read:uniform-vector template port))))) + (for-each (lambda (char template) + (read-hash-extend char + (make-array-proc template))) + '(#\b #\a #\u #\e #\s #\i #\c) + '(#t #\a 1 -1 1.0 1/3 0+i))) + (let ((array-proc (lambda (c port) + (read:array c port)))) + (for-each (lambda (char) (read-hash-extend char array-proc)) + '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))))) + +;(define (read-sharp c port) +; (define (barf) +; (error "unknown # object" c)) + +; (case c +; ((#\/) (let ((look (peek-char port))) +; (if (or (eof-object? look) +; (and (char? look) +; (or (char-whitespace? look) +; (string-index ")" look)))) +; '() +; (parse-path-symbol (read port #t read-sharp))))) +; ((#\') (read port #t read-sharp)) +; ((#\.) (eval (read port #t read-sharp))) +; ((#\b) (read:uniform-vector #t port)) +; ((#\a) (read:uniform-vector #\a port)) +; ((#\u) (read:uniform-vector 1 port)) +; ((#\e) (read:uniform-vector -1 port)) +; ((#\s) (read:uniform-vector 1.0 port)) +; ((#\i) (read:uniform-vector 1/3 port)) +; ((#\c) (read:uniform-vector 0+i port)) +; ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) +; (read:array c port)) +; (else (barf)))) (define (read:array digit port) (define chr0 (char->integer #\0)) @@ -897,24 +926,14 @@ ((#\c) 0+i) (else (error "read:array unknown option " c))))))) (if (eq? (peek-char port) #\() - (list->uniform-array rank prot (read port #t read-sharp)) + (list->uniform-array rank prot (read port)) (error "read:array list not found")))) (define (read:uniform-vector proto port) (if (eq? #\( (peek-char port)) - (list->uniform-array 1 proto (read port #t read-sharp)) + (list->uniform-array 1 proto (read port)) (error "read:uniform-vector list not found"))) - - -;;; {Dynamic Roots} -;;; - -; mystery integers passed dynamic root error handlers -(define repl-quit -1) -(define repl-abort -2) - - ;;; {Command Line Options} ;;; @@ -2018,9 +2037,9 @@ ;;; (define (repl read evaler print) - (let loop ((source (read (current-input-port) #t read-sharp))) + (let loop ((source (read (current-input-port)))) (print (evaler source)) - (loop (read (current-input-port) #t read-sharp)))) + (loop (read (current-input-port))))) ;; A provisional repl that acts like the SCM repl: ;; @@ -2235,7 +2254,7 @@ (force-output) (repl-report-reset))) (run-hooks before-read-hook) - (let ((val (read (current-input-port) #t read-sharp))) + (let ((val (read (current-input-port)))) (run-hooks after-read-hook) (if (eof-object? val) (begin diff --git a/ice-9/r4rs.scm b/ice-9/r4rs.scm index 019968660..c1ab627cb 100644 --- a/ice-9/r4rs.scm +++ b/ice-9/r4rs.scm @@ -1,7 +1,7 @@ ;;;; r4rs.scm --- definitions needed for libguile to be R4RS compliant ;;;; Jim Blandy --- October 1996 -;;;; Copyright (C) 1996 Free Software Foundation, Inc. +;;;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -140,10 +140,6 @@ (set! %load-hook %load-announce) -;;; If we load boot-9.scm, it provides a definition for this which is -;;; more sophisticated. -(define read-sharp #f) - (define (load name) (start-stack 'load-stack - (primitive-load name #t read-sharp))) + (primitive-load name))) diff --git a/ice-9/slib.scm b/ice-9/slib.scm index c7ef4ee57..1ef5c5a87 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -10,7 +10,7 @@ (lambda (port) (let ((old-load-pathname *load-pathname*)) (set! *load-pathname* ) - (do ((o (read port #t read-sharp) (read port #t read-sharp))) + (do ((o (read port) (read port))) ((eof-object? o)) (evl o)) (set! *load-pathname* old-load-pathname))))) -- 2.20.1