[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Value history
From: |
Neil Jerram |
Subject: |
Re: Value history |
Date: |
02 Mar 2001 16:45:07 +0000 |
User-agent: |
Gnus/5.0808 (Gnus v5.8.8) Emacs/20.5 |
>>>>> "Dirk" == Dirk Herrmann <address@hidden> writes:
Dirk> On 2 Mar 2001, Neil Jerram wrote:
>> Should I repost it for comparison?
Dirk> Yes, please. I seem to remember that you had planned to
Dirk> extract the ring buffer code into a module of its own,
Dirk> right? In general, I like the idea to use hooks to extend
Dirk> the functionality of the repl, but this could be easily done
Dirk> with Keisuke's approach as well.
Indeed. Well, here's my implementation. I'm sure we will be able to
take and use the best bits of both.
Regards,
Neil
cd /home/neil/Guile/ice-9/
diff -c /home/neil/Guile/cvs/guile-core/ice-9/boot-9.scm
/home/neil/Guile/ice-9/boot-9.scm
*** /home/neil/Guile/cvs/guile-core/ice-9/boot-9.scm Tue Feb 27 18:41:21 2001
--- /home/neil/Guile/ice-9/boot-9.scm Fri Mar 2 16:42:55 2001
***************
*** 2326,2331 ****
--- 2326,2333 ----
(define before-read-hook (make-hook))
(define after-read-hook (make-hook))
+ (define before-print-value-hook (make-hook 1))
+ (define after-print-value-hook (make-hook 1))
;;; The default repl-reader function. We may override this if we've
;;; the readline library.
***************
*** 2414,2421 ****
(if (or scm-repl-print-unspecified
(not (unspecified? result)))
(begin
(write result)
! (newline))))))
(lambda (result)
(if (not scm-repl-silent)
(begin
--- 2416,2425 ----
(if (or scm-repl-print-unspecified
(not (unspecified? result)))
(begin
+ (run-hook before-print-value-hook
result)
(write result)
! (newline)
! (run-hook after-print-value-hook
result))))))
(lambda (result)
(if (not scm-repl-silent)
(begin
Diff finished at Fri Mar 2 16:43:02
;;;; value-history.scm --- value history for use in Guile REPL
;;;;
;;;; Copyright (C) 2000 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
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;;; Contributed by Neil Jerram <address@hidden>.
(define-module (ice-9 value-history)
:use-module (ice-9 ring-buffer)
:export (get-value-history-value
add-to-value-history
activate-value-history
value-history-activated))
;;; To use value history in a REPL, type:
;;;
;;; (use-modules (ice-9 value-history))
;;; (activate-value-history)
;;;
;;; Alternatively, add these lines to your .guile.
;;; Clearly we want to have separate value histories for separate
;;; simultaneously running REPLs. We can achieve this by making
;;; *value-history* a fluid, since separate simultaneously running
;;; REPLs must be running in different fluid contexts. In future, we
;;; may think of additional per-REPL properties, in which case it
;;; might be neater to make a fluid called *REPL* and use the
;;; make-object-property mechanism to associate a value history with
;;; one of that fluid's values.
(define *default-value-history-size* 10)
(define *value-history* (make-fluid))
(define (get-value-history-value index)
(cond
((fluid-ref *value-history*)
=>
(lambda (ring)
(ring-get ring index)))
(else
(error "Value history has not been activated!"))))
(define (add-to-value-history val)
(cond
((fluid-ref *value-history*)
=>
(lambda (ring)
(ring-add ring val)))
(else
(error "Value history has not been activated!"))))
(define (add-to-value-history-and-print-index val)
(let ((value-history-index (add-to-value-history val)))
(display "##")
(display value-history-index)
(display " ")))
(define activate-value-history
(let ((print-value-hooks-modified #f))
(lambda args
(if (fluid-ref *value-history*)
(error "Value history is already activated!"))
(fluid-set! *value-history*
(make-ring (if (= (length args) 1)
(car args)
*default-value-history-size*)))
(or print-value-hooks-modified
(begin
(add-hook! before-print-value-hook
add-to-value-history-and-print-index)
(set! print-value-hooks-modified #t))))))
(define (value-history-activated)
(not (not (fluid-ref *value-history*))))
(read-hash-extend #\#
(lambda (c port)
`(get-value-history-value ,(read port))))
;;; value-history.scm ends here
;;;; ring-buffer.scm --- simple implementation of a ring buffer
;;;;
;;;; Copyright (C) 2000 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
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
;;;; Contributed by Neil Jerram <address@hidden>.
(define-module (ice-9 ring-buffer)
:pure
:use-module (ice-9 r5rs)
:export (make-ring ring-add ring-get))
;;; A straightforward ring buffer implementation.
;;;
;;; A ring buffer is a storage object with room for a fixed number of
;;; values. The first value to be added to the ring goes into the
;;; first slot, the second value into the second slot, and so on.
;;; When all the available slots have been used once, the adding
;;; position wraps round to the first slot again, so the next added
;;; value will overwrite the value that was in the first slot before.
;;; With the next value, the second slot value gets overwritten, and
;;; so on, until the ring wraps round again...
;;;
;;; A value can be extracted from the ring in two ways. A positive
;;; ring index is used to get the value from the slot specified by the
;;; index. A negative ring index is used to get the value from the
;;; slot found by counting backwards from the next adding position;
;;; thus -1 always means the last added value.
;;;
;;; Note that, in this implementation, for a ring of size K, the set
;;; of valid ring indices is { i : (1 <= i <= K) or (-1 >= i >= -K) }.
;;; make-ring K
;;;
;;; Make and return a ring buffer with size K.
(define (make-ring k)
(let ((ring (make-vector (+ k 1) #f)))
(vector-set! ring 0 1)
ring))
;;; ring-add RING VAL
;;;
;;; Add a new value VAL to the ring RING. ring-add returns the ring
;;; index of the slot that the new value was put in.
(define (ring-add ring val)
(let ((next-slot-index (vector-ref ring 0)))
(vector-set! ring next-slot-index val)
(vector-set! ring 0 (let ((n (+ next-slot-index 1)))
(if (= n (vector-length ring))
1
n)))
next-slot-index))
;;; ring-get RING POS
;;;
;;; Extract and return the value from ring RING at index POS. POS
;;; should be a positive or negative integer whose absolute is between
;;; 1 and the size of the ring, both inclusive.
(define (ring-get ring pos)
(let ((vector-size (vector-length ring)))
(cond ((not (integer? pos))
(error "Invalid ring index!"))
((and (>= pos 1)
(< pos vector-size))
(vector-ref ring pos))
((and (>= (- pos) 0)
(< (- pos) vector-size))
(vector-ref ring (let ((n (+ (vector-ref ring 0) pos)))
(if (< n 1)
(- (+ vector-size n) 1)
n))))
(else
(error "Ring index out of range!")))))
;;; ring-buffer.scm ends here