diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/l-system.lisp | 22 | ||||
-rw-r--r-- | src/package.lisp | 4 |
2 files changed, 20 insertions, 6 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)) diff --git a/src/package.lisp b/src/package.lisp index ee670e5..f765580 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3,4 +3,6 @@ (defpackage #:l-system (:use #:cl #:iter #:sb-cga) (:export #:l-system - #:->)) + #:-> + #:parametric-grammar + #:context-sensitive-grammar)) |