Add context sensitive grammars.

1 files changed, 17 insertions, 5 deletions

diff --git a/src/l-system.lisp b/src/l-system.lisp
index 13d9992..c3f47d0 100644
--- a/src/l-system.lisp
+++ b/src/l-system.lisp
@@ -4,22 +4,34 @@
 
 ;;; "l-system" goes here. Hacks and glory await!
 
-(defparameter *l-system-clauses* (make-hash-table :test 'eq))
+(defparameter *l-system-clauses* (make-hash-table :test 'equal))
 
-(defun l-system (axiom depth)
+(defun l-system (fn axiom depth)
   (iter (repeat depth)
 	(with result = axiom)
 	(setf result
-	      (map-l-system result))
+	      (funcall fn result))
 	(finally (return result))))
 
-(defun map-l-system (clauses)
-  (iter (for (symbol . parameters) in clauses)
+(defun parametric-grammar (elements)
+  (iter (for (symbol . parameters) in elements)
 	(for func = (gethash symbol *l-system-clauses*))
 	(appending (if (functionp func)
 		       (apply func parameters)
 		       (list `(,symbol ,@parameters))))))
 
+(defun context-sensitive-grammar (elements)
+  (iter (for elt on elements)
+	(with symbol0 = nil)
+	(for (symbol1 . parameters1) = (first elt))
+	(for symbol2 = (first (second elt)))
+	(for func = (or (gethash (list symbol0 symbol1 symbol2) *l-system-clauses*)
+			(gethash symbol1 *l-system-clauses*)))
+	(appending (if (functionp func)
+		       (apply func parameters1)
+		       (list `(,symbol1 ,@parameters1))))
+	(setf symbol0 (first (first elt)))))
+
 (defmacro setf-l-system-rule (symbol lambda)
   `(setf (gethash ,symbol *l-system-clauses*)
 	 ,lambda))