diff options
| author | Bruno Cichon <ebrasca.ebrasca@openmailbox.org> | 2016-11-03 19:38:59 +0100 |
|---|---|---|
| committer | Bruno Cichon <ebrasca.ebrasca@openmailbox.org> | 2016-11-03 19:38:59 +0100 |
| commit | 17efba28080150674d6ab1c9ea0b5e9fea1e3908 (patch) | |
| tree | 37537b128c2ed92e4ebbbab48d71ebd6fd4b5baf | |
| parent | bdb5e6cb89d2bebc94fa5ab01e4539af0adf0b5c (diff) | |
Add context sensitive grammars.
| -rw-r--r-- | examples/l-system-exemple.lisp | 9 | ||||
| -rw-r--r-- | src/l-system.lisp | 22 | ||||
| -rw-r--r-- | src/package.lisp | 4 |
3 files changed, 28 insertions, 7 deletions
diff --git a/examples/l-system-exemple.lisp b/examples/l-system-exemple.lisp index 5f999c1..4d8a53a 100644 --- a/examples/l-system-exemple.lisp +++ b/examples/l-system-exemple.lisp @@ -1,5 +1,6 @@ (in-package #:l-system-examples) +;;;Parametric grammars (-> f () (f 1) (j 1) @@ -8,4 +9,10 @@ (-> j (x) (j (* 3 x))) -(l-system '((f 1.0)) 2) +(l-system #'parametric-grammar '((f 1.0)) 2) + +;;;Context sensitive grammars +(-> (f j f) (x) + (j (* 2 x))) + +(l-system #'context-sensitive-grammar '((f 1.0)) 2) 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)) |