Subject: Re: DD: Cookbook procedure markup sample (Was: DD: Status) From: Tony Graham <tgraham@xxxxxxxxxxxxxxxx> Date: Thu, 17 Jul 1997 23:20:08 -0400 (EDT) |
**** 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 `<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
Current Thread |
---|
|
<- Previous | Index | Next -> |
---|---|---|
Re: DD: Cookbook procedure markup s, Dave Love | Thread | Re: DD: Cookbook procedure markup s, Dave Love |
Debugging Traceback, David Megginson | Date | Paper on Literate Programming For D, W. Eliot Kimber |
Month |