Fixed versions of lineio.scm and hcons.scm

Andrew Archibald (aarchiba@undergrad.math.uwaterloo.ca)
Fri, 19 Jun 1998 17:19:31 -0400 (EDT)

lineio.scm and hcons.scm are broken (bitrotted). Here are the (very
short) patches. They are necessary for the lang package to be usable.
Note that lineio may not work correctly, since I just removed
everything referring to ungetc-chars. It appears to be behaving for
me...

Andrew
aarchiba@undergrad.math.uwaterloo.ca

*** new/lineio.scm Sat Jun 06 18:55:49 1998
--- guile-core-19980619/ice-9/lineio.scm Tue Jun 24 12:26:23 1997
***************
*** 90,99 ****

(unread-string (lambda (str)
(and (< 0 (string-length str))
! ;; (if (ungetc-char-ready? self)
! ;; (set! buffers (append! (list str (string (rea
d-char self))) buffers))
! ;; (set! buffers (cons str buffers))))))
! (set! buffers (cons str buffers)))))

(read-string (lambda ()
(cond
--- 90,98 ----

(unread-string (lambda (str)
(and (< 0 (string-length str))
! (if (ungetc-char-ready? self)
! (set! buffers (append! (list str (string (rea
d-char self))) buffers))
! (set! buffers (cons str buffers))))))

(read-string (lambda ()
(cond
***************
*** 101,115 ****
(let ((answer (car buffers)))
(set! buffers (cdr buffers))
answer))
! ;; ((ungetc-char-ready? self)
! ;; (read-line self 'concat))
(else
! (read-line underlying-port 'concat)))))) ;handle-newlin
e->concat

(set-object-property! self 'unread-string unread-string)
(set-object-property! self 'read-string read-string)
self))
-
-

--- 100,112 ----
(let ((answer (car buffers)))
(set! buffers (cdr buffers))
answer))
! ((ungetc-char-ready? self)
! (read-line self 'include-newline))
(else
! (read-line underlying-port 'include-newline))))))

(set-object-property! self 'unread-string unread-string)
(set-object-property! self 'read-string read-string)
self))

*** new/hcons.scm Fri Jun 12 22:28:19 1998
--- guile-core-19980619/ice-9/hcons.scm Tue Jun 24 12:26:22 1997
***************
*** 36,50 ****
n))

(define-public (hashq-cons-assoc key l)
! (if (eq? l '()) '() ; (not (eq? #f '())) -allover
! (and l
! (or (and (pair? l) ; If not a pair, use its cdr?
! (pair? (car l))
! (pair? (caar l))
! (eq? (car key) (caaar l))
! (eq? (cdr key) (cdaar l))
! (car l))
! (hashq-cons-assoc key (cdr l))))))

(define-public (hashq-cons-get-handle table key)
(hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f))
--- 36,48 ----
n))

(define-public (hashq-cons-assoc key l)
! (and l (or (and (pair? l)
! (pair? (car l))
! (pair? (caar l))
! (eq? (car key) (caaar l))
! (eq? (cdr key) (cdaar l))
! (car l))
! (hashq-cons-assoc key (cdr l)))))

(define-public (hashq-cons-get-handle table key)
(hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f))