l-system is now parametric

1 files changed, 17 insertions, 21 deletions

diff --git a/src/l-system.lisp b/src/l-system.lisp
index 79122c7..0fcf0ce 100644
--- a/src/l-system.lisp
+++ b/src/l-system.lisp
@@ -7,33 +7,29 @@
 
 ;;; "l-system" goes here. Hacks and glory await!
 
+(defparameter *l-system-clauses* (make-hash-table :test 'eq))
+
 (defun iterconcat (fn list)
   "Applies fn on each element of list, and concatenate a copy of the resulting lists."
   (iter (for item in list)
 	(appending (funcall fn item))))
 
-(defun make-case-clause (keys value)
-  "Make one CASE clause mapping a list of KEYS to one VALUE"
-  `((,@keys) ',value))
-
-(defun make-case-clauses-from-rules (rules)
-  "Makes a list of CASE clauses from the RULES."
-  (mapcar (lambda (rule) (make-case-clause (list (first rule)) (rest rule)))
-          rules))
-
-(defun generate-l-system (rules)
-  "Make lambda Lindenmayer system"
-  `(lambda (atom) (case atom
-		    ,@(make-case-clauses-from-rules rules)
-		    (t (list atom)))))
-
-(defmacro l-system (&rest rules)
-  (generate-l-system rules))
-
-(defun iter-l-system (rules axiom depth)
+(defun l-system (axiom depth)
   (iter (repeat depth)
 	(with result = axiom)
 	(setf result
-	      (iterconcat rules
-			  result))
+	      (map-l-system result))
 	(finally (return result))))
+
+(defun map-l-system (clauses)
+  (iter (for clause in clauses)
+	(appending (let ((func (gethash (car clause) *l-system-clauses*)))
+		     (if (functionp func)
+			 (let ((result (funcall func (rest clause))))
+			   (when result
+			     result))
+			 (list clause))))))
+
+(defun def-l-system-clause (symbol lambda)
+  (setf (gethash symbol *l-system-clauses*)
+	lambda))