From 38e61b9e9a701968cc096c58d75cb2954a7484eb Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 21 Oct 2016 21:13:18 +0200 Subject: Ugrade paremeters of rules. --- examples/l-system-exemple.lisp | 2 +- src/l-system.lisp | 27 +++++++++++++-------------- 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/examples/l-system-exemple.lisp b/examples/l-system-exemple.lisp index bb16ecc..5f999c1 100644 --- a/examples/l-system-exemple.lisp +++ b/examples/l-system-exemple.lisp @@ -1,6 +1,6 @@ (in-package #:l-system-examples) -(-> f (x) +(-> f () (f 1) (j 1) (f 1)) diff --git a/src/l-system.lisp b/src/l-system.lisp index d1f782f..591f43f 100644 --- a/src/l-system.lisp +++ b/src/l-system.lisp @@ -14,28 +14,27 @@ (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 (apply func - (rest clause)))) - (when result - result)) - (list clause)))))) - -(defun setf-l-system-rule (symbol lambda) - (setf (gethash symbol *l-system-clauses*) - lambda)) + (iter (for (symbol . parameters) in clauses) + (for func = (gethash symbol *l-system-clauses*)) + (appending (if (functionp func) + (apply func parameters) + parameters)))) + +(defmacro setf-l-system-rule (symbol lambda) + `(setf (gethash ,symbol *l-system-clauses*) + ,lambda)) (defun make-l-system-expr (item) - `(list ',(first item) ,(second item))) + `(list ',(first item) ,@(rest 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)))) + `#'(lambda ,(append vars '(&rest rest)) + (declare (ignorable rest)) + (list ,@(make-l-system-list body)))) (defmacro -> (symbol vars &body body) `(setf-l-system-rule ',symbol -- cgit v1.2.3