# HG changeset patch # User Steve Losh # Date 1470846232 0 # Node ID e6e8c6e2ef91485f0a5cc049756d768884ac3482 # Parent 939570d22350b97f1c4136af8c532ddd0bd23931 Fix system redefinition diff -r 939570d22350 -r e6e8c6e2ef91 beast.lisp --- a/beast.lisp Tue Aug 09 20:45:20 2016 +0000 +++ b/beast.lisp Wed Aug 10 16:23:52 2016 +0000 @@ -19,7 +19,6 @@ ;;; {system-symbol -> (system-function arity type-specifier-list)} ;;; ;;; TODO: Figure out the distinct problem. -;;; TODO: Unfuck redefining of systems. ;;;; Entities @@ -48,6 +47,10 @@ (mapc #'destroy-entity (hash-table-values *entity-index*))) +(defun entity-satisfies-system-type-specifier-p (entity specifier) + (every (lambda (aspect) (typep entity aspect)) + specifier)) + (defun index-entity (entity) (setf (gethash (entity-id entity) *entity-index*) entity)) @@ -58,17 +61,14 @@ entity))) (defun index-entity-systems (entity) - (flet ((satisfies-system-type-specifier-p (entity specifier) - (every (lambda (aspect) (typep entity aspect)) - specifier))) - (loop - :with id = (entity-id entity) - :for system :being :the hash-keys :of *systems* - :using (hash-value (function arity type-specifiers)) - :do (loop :for argument-index :in (gethash system *system-index*) - :for specifier :in type-specifiers - :when (satisfies-system-type-specifier-p entity specifier) - :do (setf (gethash id argument-index) entity))))) + (loop + :with id = (entity-id entity) + :for system :being :the hash-keys :of *systems* + :using (hash-value (function arity type-specifiers)) + :do (loop :for argument-index :in (gethash system *system-index*) + :for specifier :in type-specifiers + :when (entity-satisfies-system-type-specifier-p entity specifier) + :do (setf (gethash id argument-index) entity)))) (defun unindex-entity (id) @@ -155,13 +155,22 @@ (defvar *systems* (make-hash-table)) +(defun rebuild-system-index (arglist) + (loop + :for (argument-name . type-specifier) :in arglist + :for index = (make-hash-table) + :do (loop + :for entity :being :the hash-values :of *entity-index* + :when (entity-satisfies-system-type-specifier-p entity type-specifier) + :do (setf (gethash (entity-id entity) index) entity)) + :collect index)) + (defun initialize-system-index (name function arglist) (setf (gethash name *systems*) (list function (length arglist) (mapcar #'cdr arglist)) (gethash name *system-index*) - (loop :repeat (length arglist) - :collect (make-hash-table)))) + (rebuild-system-index arglist))) (defun build-system-runner-1 (name type-specifiers)