Re: DD: Cookbook procedure markup sample (Was: DD: Status)

[Tony Graham <tgraham@xxxxxxxxxxxxxxxx>]

**** Private message *****

At 2 Jul 1997 23:11 +0100, Dave Love wrote:
 > However, here's a collection of random stuff in case any of it is
 > useful, though not directly formatting-related.  Public domain, I
 > guess, but mostly `trad' anyhow.  I don't have time to mark it up and,
 > actually, for pedagogical purposes and guarantees of runnability I'd
 > prefer to use a literate programming system.  Corrections welcome
 > where I've messed up...

The remainder of this message is your procedures alphabetised and
marked up using DocBook 3.0.  What do you think?

Regards,


Tony Graham
=======================================================================
Tony Graham, Consultant
Mulberry Technologies, Inc.                         Phone: 301-231-6931
6010 Executive Blvd., Suite 608                     Fax:   301-231-6935
Rockville, MD USA 20852                 email: tgraham@xxxxxxxxxxxxxxxx
=======================================================================

<!DOCTYPE chapter PUBLIC "-//Davenport//DTD DocBook V3.0//EN">
<!-- $Id: cb-procedures.sgm,v 1.2 1997/07/17 23:09:01 tkg Exp $ -->
<chapter>
<title>Procedures</title>
<sect1>
<title>Debugging</title>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>my-debug</title>
<programlisting>(define debug
  (external-procedure "UNREGISTERED::James Clark//Procedure::debug"))

;; A version of debug that tries to print more helpful information
;; than `&lt;unknown object ...'.  Will need extending for any further
;; types added to Jade which don't have useful print methods.  Fixme:
;; should yield more information extracted from each type.
(define (my-debug x #!optional return-value)
  (debug (cond ((node-list? x)
		(if (node-list-empty? x)
		    (list 'empty-node-list x)
		    (list (if (named-node-list? x)
			      'named-node-list
			      'node-list)
			  (node-list-length x) x)))
	       ((sosofo? x)
		(list 'sosofo x))
	       ((procedure? x)
		(list 'procedure x))
	       ((style? x)
		(list 'style x))
	       ((address? x)
		(list 'address x))
	       ((color? x)
		(list 'color x))
	       ((color-space? x)
		(list 'color-space x))
	       ((display-space? x)
		(list 'display-space x))
	       ((inline-space? x)
		(list 'inline-space x))
	       ((glyph-id? x)
		(list 'glyph-id x))
	       ((glyph-subst-table? x)
		(list 'glyph-subst-table x))
	       (else x))))</programlisting>
</sect2>
</sect1>
<sect1>
<title>IEEE/R4RS stuff missing from Jade</title>
<para>It's possible stuff like this isn't optimally coded if
tail-call-modulo-cons isn't optimized.</para>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>assoc</title>
<programlisting>(define (assoc obj alist)
  (if (not (list? alist))
      (error "assoc: second arg not a list")
      (letrec ((assoc (lambda (obj alist)
			(if (not (null? alist))
			    (let ((cary (car alist)))
			      (if (equal? obj (car cary))
				  cary
				  (assoc obj (cdr alist))))
			    #f))))
	(assoc obj alist))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>caddr</title>
<programlisting>(define (caddr xs)
  (list-ref xs 2))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>cadr</title>
<programlisting>(define (cadr xs)
  (list-ref xs 1))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>cddr</title>
<programlisting>(define (cddr xs)
  (cdr (cdr xs)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>even?</title>
<programlisting>(define (even? n)
  (zero? (remainder n 2)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>expt</title>
<programlisting>(define (expt b n)			; safe for -ve n, c.f. Bosak
  (letrec ((expt1 (lambda (n)
		    (if (zero? n)
			1
			(* b (expt1 (- n 1)))))))
    (if (< n 1)
	(/ (expt1 (- n)))
	(expt1 n))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>list->string</title>
<programlisting>(define (list->string cs)
  (apply string cs))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>map</title>
<programlisting>(define (map f #!rest xs)
   (let ((map1 (lambda (f xs)		; bootstrap version for unary F
		 (let loop ((xs xs))
		   (if (null? xs)
		       '()
		       (cons (f (car xs))
			     (loop (cdr xs))))))))
     (cond ((null? xs)
	    '())
	   ((null? (cdr xs))
	    (map1 f (car xs)))
	   (else
	    (let loop ((xs xs))
	      (if (null? (car xs))
		  '()
		  (cons (apply f (map1 car xs))
			(loop (map1 cdr xs)))))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>odd?</title>
<programlisting>(define (odd? n)
  (not (even? n)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>string->list</title>
<programlisting>(define (string->list s)
  (let ((l (string-length s)))
    (let loop ((i 0))
      (if (=3D i l)
	  '()
	  (cons (string-ref s i)
		(loop (+ i 1)))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>zero?</title>
<programlisting>(define (zero? n)
  (equal? 0 n))</programlisting>
</sect2>
</sect1>
<sect1>
<title>Random utilities non-(DSSSL-)standard `standard' procedures</title>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>any?</title>
<programlisting>;; Return #t if predicate `pred?' returns #t when applied to any
;; element of the `xs'.
(define (any? pred? xs)
  (let loop ((xs xs))
    (and (not (null? xs))
	 (or (pred? (car xs))
	     (loop (cdr xs))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>break</title>
<programlisting>;; Like `span', but with the sense of the test reversed.
(define (break test? xs)
  (span (compose not test?) xs))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>compose</title>
<programlisting>;; Make a function equivalent to applying `f2' to its arguments and
;; `f1' to the result.
 (define (compose f1 f2)
   (lambda (#!rest rest) (f1 (apply f2 rest))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>const</title>
<programlisting>;; Constant function evaluating to `c'.
(define (const c)
  (lambda (#!rest rest) c))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>curry</title>
<programlisting>;; Partially apply two-argument function `f' to `arg', returning a
;; one-argument function.
(define (curry f arg)
  (lambda (a) (f arg a)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>curryn</title>
<programlisting>;; n-ary variant
(define (curryn f #!rest rest)
  (lambda (#!rest args)
    (apply f (append rest args))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>drop</title>
<programlisting>;; Return list `xs' less the first `n' elements.
(define (drop n xs)
  (list-tail xs n))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>dropwhile</title>
<programlisting>;; Remove leading elements of list `xs' for which `test?' returns
;; true.
(define (dropwhile test? xs)
  (cond ((null? xs)
	 '())
	((test? (car xs))
	 (dropwhile test? (cdr xs)))
	(else xs)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>foldl</title>
<programlisting>;; Fold left with function `f' over list `xs' with the given `zero'
;; value.  (Like DSSSL `reduce' but normal arg order.)
(define (foldl f zero xs)
  (if (null? xs)
      zero
      (foldl f (f zero (car xs)) (cdr xs))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>foldl1</title>
<programlisting>;; Fold left with list car as zero.
(define (foldl1 f xs)
  (cond ((null? xs)
	 '())
	((null? (cdr xs))
	 (car xs))
	(else (foldl f (car xs) (cdr xs)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>foldr</title>
<programlisting>;; Fold right, as above.
(define (foldr f zero xs)
  (if (null? xs)
      zero
      (f (car xs) (foldl f zero (cdr xs)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>id</title>
<programlisting>(define (id arg) arg)</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>node-list-reduce</title>
<programlisting>(define (node-list-reduce nl combine init)
  (if (node-list-empty? nl)
      init
      (node-list-reduce (node-list-rest nl)
                        combine
                        (combine init (node-list-first nl)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>node-list-some?</title>
<programlisting>(define (node-list-some? proc nl)
  (node-list-reduce nl
                    (lambda (result snl)
                      (if (or result (proc snl))
                          #t
                          #f))
                    #f))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>node-list-filter</title>
<programlisting>(define (node-list-filter proc nl)
  (node-list-reduce nl
                    (lambda (result snl)
                      (if (proc snl)
                          (node-list snl result)
                          result))
                    (empty-node-list)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>remove</title>
<programlisting>;; Remove any occurrences of `x' from list `ys'.
(define (remove x ys)
  (cond
   ((null? ys) ys)
   ((equal? x (car ys)) (remove x (cdr ys)))
   (else (cons (car ys) (remove x (cdr ys))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>remove-if</title>
<programlisting>;; Remove any elements  `x' from that answer #t to `pred?'.
(define (remove-if pred? ys)
  (cond
   ((null? ys) ys)
   ((pred? (car ys)) (remove-if pred? (cdr ys)))
   (else (cons (car ys) (remove-if pred? (cdr ys))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>sort</title>
<programlisting>;; O'Keefe's smooth applicative merge sort: sort list `l' using
;; comparison function `<=3D'.
(define (sort <=3D l)
  (letrec ((merge (lambda (xs ys)
		    (cond ((null? xs) ys)
			  ((null? ys) xs)
			  (else (if (<=3D (car xs)
					(car ys))
				    (cons (car xs)
					  (merge (cdr xs) ys))
				    (cons (car ys)
					  (merge xs (cdr ys))))))))
	   (mergepairs (lambda (l k)
			 (if (null? (cdr l))
			     l
			     (if (=3D 1 (modulo k 2))
				 l
				 (mergepairs (cons (merge  (car l)
							   (cadr l))
						   (cddr l))
					     (quotient k 2))))))
	   (sorting (lambda (l a k)
		      (if (null? l)
			  (car (mergepairs a 0))
			  (sorting (cdr l)
				   (mergepairs (cons (list (car l))
						     a)
					       (+ k 1))
				   (+ k 1))))))
    (cond ((not (list? l))
	   (error "sort: second arg not a list"))
	  ((not (procedure? <=3D))
	   (error "sort: first arg not a procedure"))
	  ((null? l)
	   '())
	  (else
	   (sorting l '() 0)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>span</title>
<programlisting>;; From the list `xs', return a pair of lists comprising the leading
;; elements of `xs' for which `test?' returns true and the rest of
;; `xs'.  After the Haskell prelude.
(define (span test? xs)
  (if (null? xs)
      (cons '() '())
      (let ((x (car xs))		; split the xs into head
	    (xss (cdr xs)))		; and tail
	(if (test? x)
	    (let* ((spanned (span test? xss))
		   ;; and split the result of span into head and tail
		   (ys (car spanned))
		   (zs (cdr spanned)))
	      (cons (cons x ys) zs))
	    (cons '() xs)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>string=3D?</title>
<programlisting>;; Is `a' an initial sibstring of `b'?
(define (initial-substring? a b)
  (string=3D? a (substring b 0 (string-length a))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>take</title>
<para>Return the first `n' elements of list `xs'.</para>
<programlisting>(define (take n xs)
  (let loop ((i 1) (xs xs))
    (if (or (> i n)
	    (null? xs))
	'()
	(cons (car xs)
	      (loop (+ 1 i) (cdr xs))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>whitespaced-words</title>
<programlisting>(define whitespaced-words
  (curry words char-whitespace?))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>words</title>
<programlisting>;; Split string `s' into words delimited by characters answering #t to
;; predicate `pred?'.  After the Haskell prelude.  See also Bird and
;; Wadler.
(define (words pred? s)
  (letrec ((words (lambda (s)
		    (let ((dropped (dropwhile pred? s)))
		      (if (null? dropped)
			  '()
			  (let ((broken (break pred? dropped)))
			    (cons (car broken)
				  (words (cdr broken)))))))))
    (map list->string (words (string->list s)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>zip-with</title>
<programlisting>;; List zipping with the given `zipper' function.  Like `map', but the
;; list args can be unequal lengths.
(define (zip-with zipper #!rest xs)
  (if (any? null? xs)
      '()
      (cons (apply zipper (map car xs) )
	    (apply zip-with zipper (map cdr xs)))))</programlisting>
</sect2>
</sect1>
<sect1>
<title>DSSSL conveniences</title>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>map-node-list->list</title>
<programlisting>;; Map function `f' over node list `nl', returning an ordinary list.
;; (No node list constructor in Jade.)
(define (map-node-list->list f nl)
  (if (node-list-empty? nl)
      '()
      (cons (f (node-list-first nl))
	    (map-node-list->list f (node-list-rest nl)))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>match-siblings</title>
<programlisting>;; Node list of siblings with the same GI as node
(define (matching-siblings #!optional (node (current-node)))
  (select-elements (siblings node) (gi node)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>maybe-not-sosofo</title>
<programlisting>(define (maybe-not-sosofo predicate sosofo)
  (if predicate (empty-sosofo) sosofo))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>maybe-sosofo</title>
<programlisting>;; Conditionally use the sosofo or the empty one.
(define (maybe-sosofo predicate sosofo)
  (if predicate sosofo (empty-sosofo)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>next-matching-node</title>
<programlisting>;; Return the following sibling with the same GI as `node' (or the
;; empty node list if none found).
(define (next-matching-node #!optional (node (current-node)))
  (node-list-ref (matching-siblings)
		 (child-number)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>prev-matching-node</title>
<programlisting>;; Return the preceding sibling with the same GI as `node' or the
;; empty node list.
(define (prev-matching-node #!optional (node (current-node)))
  (node-list-ref (matching-siblings)
		 (- (child-number node) 2)))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>previous-element</title>
<programlisting>;; In the absence of the full node machinery, return the preceding
;; sibling of `node' which is an element (or the empty node list if
;; none found).
(define (previous-element #!optional (node (current-node)))
  ;; cdr down the siblings keeping track of the last element node
  ;; visited and check the current car against `node'; if it matches,
  ;; return the noted previous.
  (let ((first (node-list-first (siblings))))
    (let loop ((previous (if (gi first)
			     first
			     (empty-node-list)))
	       (current (node-list-rest (siblings))))
      (cond ((node-list-empty? current)
	     (empty-node-list))
	    ((node-list=3D? node (node-list-first current)) ; got it
	     previous)
	    (else (loop (if (gi (node-list-first current))
			    (node-list-first current)
			    previous)
			(node-list-rest current)))))))</programlisting>
</sect2>
<sect2>
<sect2info>
<author>
<firstname>Dave</firstname><surname>Love</surname>
</author>
<revhistory>
<revision>
<revnumber>1.0</revnumber>
<date>19970716</date>
<authorinitials>Dave Love d.love@xxxxxxxx</authorinitials>
<revremark>Copied from David's DSSSList post of 19970702</revremark>
</revision>
</revhistory>
</sect2info>
<title>siblings</title>
<programlisting>(define (siblings #!optional (node (current-node)))
  (children (parent node)))</programlisting>
</sect2>
</sect1>


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