Re: Value history

[Neil Jerram]

>>>>> "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