Re: How do I do this in dsssl/jade?

[Toby Speight <Toby.Speight@xxxxxxxxxxxxxx>]

Glenn> Glenn R. Kronschnabl <URL:mailto:grk@xxxxxxxxxxxxxxxx>

0> In article <199812141549.JAA19662@xxxxxxxxxxxxxxxxxxxx>, Glenn
0> wrote:

Glenn> I have tried to adapt the update-dict procedure that p. prescod
Glenn> posted some time back (thread was 'List of speakers'), but no
Glenn> success yet.

I've played with Paul's code a bit, as I've been implementing sorted
indexes for some of my documents.  I found that since they were linear
association-lists, that they didn't scale very well, so I wrote a
version using trees, maintained in sorted order (one must supply a
sort function).

The stuff I wrote is quite generic; when I want to use it, I create a
style-specification-body that implements specific functions for the
particular datatypes I'm indexing.  For an index of places, I want to
maintain a mapping from a string name to a node-list, so I define
functions like this:

     ------------------------------------------------------------

;; each value of a "place" index entry is a node-list of instances of
;; that place

(define (place-index-add dict place)
  (index-add-inorder dict place place
                     place=? place-name<=?
                     node-list))

(define (place=? snl1 snl2)
  (let ((n1 (data snl1))
        (n2 (data snl2)))
    (string=? n1 n2)))

(define (place-name<=? p1 p2)
  (string<=? (PLACE-MAGIC p1)
             (PLACE-MAGIC p2)))

(define (place-index-places places)
  (node-list-reduce
   places
   place-index-add
   '()))

(define (make-place-index)
  (place-index-places (q-element "place")))

     ------------------------------------------------------------


Anyway, here's the code to support this.  Some functions may be
defined in DSSSL but unimplemented in Jade, others are drawn from
the DSSSL Documentation Project Procedures Library - I won't repeat
their definitions here.  I think that what you want may be something
simpler, but you might be able to use the tree-manipulation code for
your purposes.


     ------------------------------------------------------------

;;; a dictionary is a tree of name,values pairs called "entries";
;;; each branch is (entry, prior, next)


;;; if a dictionary entry exists with the right key, it updates it
;;; otherwise, it adds one, maintaining the specified order.
(define (index-add-inorder dict key value key=? key<? value-list)
  (if (null? dict)
      (list (cons key (value-list value))
            '()
            '())
    (let* ((dict-entry (car dict))
           (dict-key (car dict-entry)))
      (cond
       ((key=? key dict-key)
        (cons (cons dict-key (value-list value (cdr dict-entry)))
              (cdr dict)))
       ((key<? key dict-key)
        (list dict-entry
              (index-add-inorder (cadr dict) key value
                                 key=? key<? value-list)
              (caddr dict)))
       (else
        (list dict-entry
              (cadr dict)
              (index-add-inorder
                       (caddr dict) key value key=? key<? value-list)))))))

(define (index-get dict key key=? #!optional key<?)
  (and (not (null? dict))
       (let* ((dict-entry (car dict))
              (dict-key (car dict-entry)))
         (cond
          ((key=? key dict-key)
           dict-entry)
          ((not key<?)
           (or (index-get (cadr dict) key key=?)
               (index-get (caddr dict) key key=?)))
          ((key<? key dict-key)
           (index-get (cadr dict) key key=?))
          (else
           (index-get (caddr dict) key key=?))))))

(define (index-length dict)
  (if (null? dict)
      0
    (+ 1 (index-length (cadr dict))
       (index-length (caddr dict)))))

(define (index-linearise dict)
  (append
   (index-linearise (cadr dict))
   (list (car dict))
   (index-linearise (caddr dict))))

(define (index-print index print-func)
  (apply sosofo-append
         (index-map print-func index)))

(define (index-map f dict)
  (let loop ((heads '()) (dict dict) (tails '()))
    (cond ((null? dict)
           (if (null? tails)
               (reverse heads)
             (loop heads (car tails) (cdr tails))))
          ((null? (cdr dict))
           (error "Null cdr in dict"))
          ((not (null? (cadr dict)))
           (loop heads
                 (cadr dict)
                 (cons (list (car dict) '() '())
                       (cons (caddr dict)
                             tails))))
          ((not (null? (car dict)))
           (loop (cons (f (car dict)) heads)
                 (caddr dict)
                 tails))
          (else
           (loop heads
                 (cddr dict)
                 tails)))))


(define (plural-string n sing plur)
  (string-append (number->string n)
                 " "
                 (if (= n 1) sing plur)))

-- 


 DSSSList info and archive:  http://www.mulberrytech.com/dsssl/dssslist