Re: Simple example program to illustrate Goops

[Julien Rousseau <le_douanier at yahoo dot com>]

--- Neil Jerram <neil@ossau.uklinux.net> wrote:
> Take a look at the following.  It's undocumented,
> sadly, but it does
> at least demonstrate
> - defining a class
> - defining methods for that class
> - use of slot accessors.
> 
> Does this help you at all?

Yes and no.

Yes because it illustrate well what is described in
the tutorial and in a compact manner, but also no
because what I am looking for is more a "small"
software that would explain its use in a bigger scale.
When I first came to Guile I used Gnu Robots as a
starting point to understand Guile's interaction with
C. This is this kind of program I am looking for.

What would help me would be a list of free software
project using or experimenting Goops so I can see if
one of them fits my criteria, a little bit like what
we can find for guile-gtk at
http://www.ping.de/sites/zagadka/guile-gtk/apps.html

"It's undocumented"

Ok, let me comment it to see if I have understood
goops correctly.

(define-module (ice-9 db file scm-alist)
  :use-module (ice-9 filesys)
  :use-module (oop goops))


;; define a class for database informations 
;; (file, I/O port, modified?, cache)
(define-class <db-file-scm-alist> ()
  (f #:init-value #f  #:accessor db-file-name)
  (p #:init-value #f  #:accessor db-port)
  (m #:init-value #f  #:accessor db-modified?)
  (c #:init-value '() #:accessor db-cache))

;; define a generic method db-open accepting 
;; an instance of the class <db-file-scm-alist> 
;; and a filename as arguments
(define-method db-open ((db <db-file-scm-alist>)
file-name)
  ;; first verify that the database object doesn't
have 
  ;; a file already associated with it.
  (if (db-file-name db)
      (error "Database already open for file:"
(db-file-name db)))
  ;; the database has no file yet, we set the 
  ;; database port with the port resulting from the 
  ;; opening of the file given in argument
  ;; for this we use the generalised set! (cf draft 
  ;;of the SRFI 17 at srfi.schemers.org)
  (set! (db-port db)
        ;; we verify that the file exists...
        (if (file-exists? file-name)
	    ;; ...and open it
            (open-input-file file-name)
            #f))
  ;; we store the name of the file in the object
  (set! (db-file-name db) file-name))

;; define a generic method closing a database file
(define-method db-close ((db <db-file-scm-alist>))
  ;; we verify that the file exists
  (if (db-file-name db)
      (begin
	;; we also verify that the associated port
        ;; exists, 
	;; if he doesn't then it is very weird.
        (if (db-port db)
            (begin
              (close-input-port (db-port db))
              (set! (db-port db) #f)))
	    ;; There probably should be something 
            ;; telling that the object wasn't 
	    ;; properly initialised
	;; if the database has been modified we save it
        (if (db-modified? db)
            (begin
	      ;; we create the file (well, i suppose :) 
              (mkpath (db-file-name db))
	      ;; open the file in output
              (let ((p (open-output-file 
                        (db-file-name db))))
		;; locally define the default output 
                ;; to be the port previously opened
                (with-output-to-port p
                  (lambda ()
		    ;; shouldn't it be for-each 
                    ;; rather than map???
		    ;; we write the content of the 
                    ;; database file on the standard 
                    ;; output (that is locally defined

                    ;; to be the port of the file)
                    (map (lambda (entry)
                           (write entry)
                           (newline))
                         (db-cache db))))
                (close-output-port p))
	      ;; reset the modified? flag
              (set! (db-modified? db) #f)))
	;; empty the cache
        (set! (db-cache db) '())
	;; we reinitialize the filename of 
        ;; the database object
        (set! (db-file-name db) #f))))

;; resync the database object with the file on the
disk
;; the database object MUST be initialized
(define-method db-sync ((db <db-file-scm-alist>))
  ;; verify that the database is initialized and emit
  ;; an error if it is not
  (if (not (db-file-name db))
      (error "Database is not open!"))
  ;; close and reopen the database file
  (let ((file-name (db-file-name db)))
    (db-close db)
    (db-open db file-name)))

;; read the next entry of the database given as
;; an argument
(define-method db-read-next ((db <db-file-scm-alist>))
  (let ((p (db-port db)))
    (if p
	;; read an s-expression from the input port
        (let ((next-entry (with-input-from-port p
                            read)))
          (cond
	   ;; if we are at the end of the file 
           ;; return false
           ((eof-object? next-entry) #f)
           ((pair? next-entry)
	    ;; entry correct, update the cache
            ;; correspondingly and return the entry
            (set! (db-cache db)
                  (append (db-cache db) 
                          (list next-entry)))
            next-entry)
	   ;; the entry exist but isn't a pair
           (else (error "Corrupt database entry!"))))
        #f)))

;; extract the keys of the database from the cache 
;; and the rest of the file
(define-method db-keys ((db <db-file-scm-alist>))
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (let loop ((keys (map car (db-cache db)))
             (next-entry (db-read-next db)))
    (if (not next-entry)
        keys
        (loop (append keys (list (car next-entry)))
              (db-read-next db)))))

;; retrieve the information associated with the given 
;; key in the given database
(define-method db-ref ((db <db-file-scm-alist>) key)
  (if (not (db-file-name db))
      (error "Database is not open!"))
      ;; first search in the cache
  (or (assoc-ref (db-cache db) key)
      ;; then in the file
      (let loop ((next-entry (db-read-next db)))
        (if (not next-entry)
            #f
            (if (equal? (car next-entry) key)
                (cdr next-entry)
                (loop (db-read-next db)))))))

;; create/modify a new pair key value in the database
(define-method db-set! ((db <db-file-scm-alist>) 
                        key value)
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (db-keys db)
  (set! (db-cache db)	
        (assoc-set! (db-cache db) key value))
  (set! (db-modified? db) #t))

;; list of symbols to be exported outside of the
module
(export <db-file-scm-alist>
        db-open
        db-close
        db-sync
        db-keys
        db-ref
        db-set!)

Now one or two questions:
 -I assume that assoc-set! first do assoc on the 
association list (db-cache db) using the key and then
sets its cdr (that is the value fo the association
pair) the its third argument. I also assume that when
their is no such association pair it creates one, but
does it create the pair in a sorted way (using the key
to sort the association list). I suppose so but givne
that you use map in db-close (see next question) I
wonder.
(set! (db-cache db)	
        (assoc-set! (db-cache db) key value))

 -Shouldn't the map of db-close be a for-each, given
that R5RS specify 
"The dynamic order in which proc is applied to the
elements of the lists is unspecified."
or is the possibility to have key-value pairs written
in any order not a problem?

-Why are the functions defined with define-method, I
understand that it is useful for 
overloading functions but in this case I don't see the
use (or maybe the usefulness of it is seen
in another part of the software).

__________________________________________________
Do You Yahoo!?
Talk to your friends online with Yahoo! Messenger.
http://im.yahoo.com