diff options
author | Bruno Cichon <ebrasca.ebrasca@openmailbox.org> | 2016-10-20 23:35:48 +0200 |
---|---|---|
committer | Bruno Cichon <ebrasca.ebrasca@openmailbox.org> | 2016-10-20 23:35:48 +0200 |
commit | c14d5f24617c0c4bde337ba163a33fb4276166a2 (patch) | |
tree | 72817a273ef8b44840945b237633e60a7dc570b6 | |
parent | d8d80c1cf6e4ae51e90d064f2a854be07ce99079 (diff) |
Better syntax.Miscellaneous rename.Update example.
-rw-r--r-- | examples/l-system-exemple.lisp | 8 | ||||
-rw-r--r-- | src/l-system.lisp | 26 |
2 files changed, 19 insertions, 15 deletions
diff --git a/examples/l-system-exemple.lisp b/examples/l-system-exemple.lisp index cbe4c99..bb16ecc 100644 --- a/examples/l-system-exemple.lisp +++ b/examples/l-system-exemple.lisp @@ -1,11 +1,11 @@ (in-package #:l-system-examples) (-> f (x) - '((f 1) - (j 1) - (f 1))) + (f 1) + (j 1) + (f 1)) (-> j (x) - `((j ,(* 3 x)))) + (j (* 3 x))) (l-system '((f 1.0)) 2) diff --git a/src/l-system.lisp b/src/l-system.lisp index 80d6f81..d1f782f 100644 --- a/src/l-system.lisp +++ b/src/l-system.lisp @@ -6,11 +6,6 @@ (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 l-system (axiom depth) (iter (repeat depth) (with result = axiom) @@ -28,11 +23,20 @@ result)) (list clause)))))) -(defmacro -> (symbol vars &body body) - `(def-l-system-clause ',symbol - (lambda ,vars - ,@body))) - -(defun def-l-system-clause (symbol lambda) +(defun setf-l-system-rule (symbol lambda) (setf (gethash symbol *l-system-clauses*) lambda)) + +(defun make-l-system-expr (item) + `(list ',(first item) ,(second item))) + +(defun make-l-system-list (rest) + (iter (for item in rest) + (collecting (make-l-system-expr item)))) + +(defmacro make-l-system-rule (vars &body body) + `#'(lambda ,vars (list ,@(make-l-system-list body)))) + +(defmacro -> (symbol vars &body body) + `(setf-l-system-rule ',symbol + (make-l-system-rule ,vars ,@body))) |