[CM] Generalized rewrite pattern

Torsten Anders t.anders@qub.ac.uk
12 Feb 2003 16:34:56 +0000


For my own purposes a wrote a somewhat generalized rewrite pattern.
Perhaps somebody else is interested, so I send it in.

Kind regards,


(defun mappend (func &rest inlists)
  "Apply func to each element of inlist and append the result."
  (apply #'append (apply #'mapcar func inlists)))

(defun rewriter (fn)
  "Defines a function for make-rewrite-fn for a context free rewrite.
Only the rewrite function for a single stream item without its context
need to be specified. The given function always needs to return a list."
  #'(lambda (vals)
      (mappend fn vals)))
(defmethod make-rewrite-fn ((init list) (fn function))
  "Returns a function for a function item which recursively rewrites
generations as specified by the given function."
  (let ((curr init))
    #'(lambda ()
	(let ((old curr))
	  (setf curr (funcall fn curr))
#| ;; example: 

(next (new funcall
	   :of (make-rewrite-fn
		 (let ((factor 1.3))
		   #'(lambda (x)
		       (cond ((< x (/ 1 factor))
			      (list (* x factor)))
			     ((>= x (/ 1 factor))
			      (list (/ x (expt factor 3))
				    (/ x (expt factor 5))))))))))
-> (1 0.4551662 0.26932913 0.59171605 0.35012785 0.76923084 0.4551662
0.35012788 0.20717627 0.59171605 0.45516622 0.26932913 0.76923084
0.59171605 0.35012785 0.35012788 0.20717627 0.76923084 0.4551662

;; rewrite can be defined this way, if you want:

(defmacro defrewriter-case (&rest clauses)
  "Defines a function for make-rewrite-fn for a context free rewerite.
Only case clauses need to be specified."
  ;; just a demo to show a rewrite pattern can be defined this way
  `(rewriter #'(lambda (val)
		 (case val

#| ;; example:

(next (new funcall
	   :of (make-rewrite-fn '(b)
				  (a '(a b a)) 
				  (b '(b b a)))))
-> (B B B A B B A B B A A B A B B A B B A A)

Torsten Anders
Sonic Arts Research Centre
Queens University Belfast
Tel: +44 28 9027 4831 (office)
     +44 28 9066 7439 (private)