(defun dojo-core-dep-register-dependency-by-classes (own-class dep-class type origin-class) "Registers a dependencies in the corresponding maps. Assume PageChooser importing the ApplicationContext. Then, PageChooser is the own-class, ApplicationContext the dep-class." (let* ((own-resource-id (dojo-class-resource-id own-class)) (dep-resource-id (dojo-class-resource-id dep-class))) (dojo-core-dep-register-dependency-by-resources own-resource-id dep-resource-id type origin-class))) (defun dojo-core-dep-register-dependency-by-resources (own-resource-id dep-resource-id type origin-class) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (own-resource (gethash own-resource-id id-to-resource)) (dep-resource (gethash dep-resource-id id-to-resource)) (own-project (if own-resource (dojo-resource-project own-resource) nil)) (dep-project (if dep-resource (dojo-resource-project dep-resource) nil)) (project-to-dep-maps (progn ; Ensure that the dependency data for the project at hand is loaded. (dojo-core-dep-load-for-project-if-necessary own-project) (dojo-workspace-project-to-dep-maps dojo-current-workspace))) ; Map>> (project-to-inverse-dep-maps (progn ; Ensure that the dependency data for the project at hand is loaded. (dojo-core-dep-load-for-project-if-necessary dep-project) (dojo-workspace-project-to-inverse-dep-maps dojo-current-workspace))) (dep-map (if own-project (gethash own-project project-to-dep-maps) nil)) ; Map> (inverse-dep-map (if dep-project (gethash dep-project project-to-inverse-dep-maps) nil)) (origin (if origin-class (dojo-class-resource-id origin-class) nil)) (dirty-dep-projects (dojo-workspace-dirty-dep-projects dojo-current-workspace))) (log-dep (format "Called register-dependency-by-classes for own-resource-id [%s], dep-resource-id [%s], type [%s], origin [%s]" own-resource-id dep-resource-id type origin)) (if (or (null own-project) (null dep-project)) (progn (log-dep (format "[WARNING] register-dependency-by-resources did not find project; own-resource-id [%s], own-project [%s], dep-resource-id [%s], dep-project [%s]" own-resource-id own-project dep-resource-id dep-project)) nil) (puthash own-project t dirty-dep-projects) (puthash dep-project t dirty-dep-projects) (if (null dep-map) (progn (setq dep-map (make-hash-table :test 'equal)) (puthash own-project dep-map project-to-dep-maps))) (if (null inverse-dep-map) (progn (setq inverse-dep-map (make-hash-table :test 'equal)) (puthash dep-project inverse-dep-map project-to-inverse-dep-maps))) (let* ((dep-resource-id-to-dependencies (gethash own-resource-id dep-map)) ; Map (own-resource-id-to-dependencies (gethash dep-resource-id inverse-dep-map))) (if (null dep-resource-id-to-dependencies) (progn (setq dep-resource-id-to-dependencies (make-hash-table :test 'equal)) (puthash own-resource-id dep-resource-id-to-dependencies dep-map))) (if (null own-resource-id-to-dependencies) (progn (setq own-resource-id-to-dependencies (make-hash-table :test 'equal)) (puthash dep-resource-id own-resource-id-to-dependencies inverse-dep-map))) (let* ((dependencies (gethash dep-resource-id dep-resource-id-to-dependencies)) ; List (..., ApplicationContext, ...) (inverse-dependencies (gethash own-resource-id own-resource-id-to-dependencies)) (old-dependency-count (length dependencies)) (old-inverse-dependency-count (length inverse-dependencies)) (new-dependencies (dojo-core-dep-register-in-dep-list-by-resources dependencies own-resource type origin nil dep-resource origin-class)) (new-inverse-dependencies (dojo-core-dep-register-in-dep-list-by-resources inverse-dependencies dep-resource type origin t own-resource origin-class))) (puthash dep-resource-id new-dependencies dep-resource-id-to-dependencies) (puthash own-resource-id new-inverse-dependencies own-resource-id-to-dependencies) ; Report wether we changed anything (not (and (= old-dependency-count (length new-dependencies)) (= old-inverse-dependency-count (length new-inverse-dependencies))))))))) (defun dojo-core-dep-register-in-dep-list-by-classes (deps class type origin inverse inverse-class origin-class) (let* ((found nil) (resource-id (dojo-class-resource-id class)) (inverse-resource-id (dojo-class-resource-id inverse-class)) (project (dojo-class-project class)) (inverse-project (dojo-class-project inverse-class)) (path (dojo-class-path class)) (inverse-path (dojo-class-path inverse-class))) (dojo-core-dep-register-in-dep-list deps resource-id inverse-resource-id project inverse-project path inverse-path type origin inverse origin-class))) (defun dojo-core-dep-register-in-dep-list-by-resources (deps resource type origin inverse inverse-resource origin-class) (let* ((found nil) (resource-id (dojo-resource-id resource)) (inverse-resource-id (dojo-resource-id inverse-resource)) (project (dojo-resource-project resource)) (inverse-project (dojo-resource-project inverse-resource)) (path (dojo-resource-path resource)) (inverse-path (dojo-resource-path inverse-resource))) (dojo-core-dep-register-in-dep-list deps resource-id inverse-resource-id project inverse-project path inverse-path type origin inverse origin-class))) (defun dojo-core-dep-register-in-dep-list (deps resource-id inverse-resource-id project inverse-project path inverse-path type origin inverse origin-class) (let* ((found nil) (origin-project (if origin-class (dojo-class-project origin-class) nil)) (origin-path (if origin-class (dojo-class-path origin-class) nil))) (dolist (dep deps) (let* ((old-resource-id (dojo-dependency-resource-id dep)) (old-type (dojo-dependency-type dep)) (old-origin (dojo-dependency-origin dep))) (if (and (eq old-resource-id inverse-resource-id) (eq old-type type) (eq old-origin origin)) (setq found t)))) (if (not found) (progn (push (construct-dojo-dependency inverse-resource-id type origin) deps) (if inverse (log-dep (format "Registered inverse dependency: Resource [%s:%s:%s] is now in dependency list of resource [%s:%s:%s]; type [%s], origin [%s:%s:%s]" inverse-resource-id inverse-project inverse-path resource-id project path type origin origin-project origin-path)) (log-dep (format "Registered dependency: Resource [%s:%s:%s] now has a dependency to resource [%s:%s:%s]; type [%s], origin [%s:%s:%s]" resource-id project path inverse-resource-id inverse-project inverse-path type origin origin-project origin-path)))) (if inverse (log-dep (format "No need to register inverse dependency: Resource [%s:%s:%s] is already in dependency list of resource [%s:%s:%s] with type [%s] and origin [%s:%s:%s]" inverse-resource-id inverse-project inverse-path resource-id project path type origin origin-project origin-path)) (log-dep (format "No need to register dependency: Resource [%s:%s:%s] already has a dependency to resource [%s:%s:%s]; type [%s], origin [%s:%s:%s]" resource-id project path inverse-resource-id inverse-project inverse-path type origin origin-project origin-path)))) deps)) (defun dojo-core-dep-log-deps () (log-dep (format "=========================")) (log-dep (format "Current dependency state:")) (log-dep (format "=========================")) (let* ((project-to-dep-maps (dojo-workspace-project-to-dep-maps dojo-current-workspace))) (maphash (lambda (project dep-map) (log-dep (format "Project %s" project)) (dojo-core-dep-log-dep-map dep-map)) project-to-dep-maps))) (defun dojo-core-dep-register-function-call-dependency (function-symbol arg-ret-symbol origin-class) "Registers an API dependency triggered by either calling the given function with the given argument, or by gaining the given return symbol from such a call. The goal is, that the class of the function-symbol depends on the class(es) gained from the arg-ret-symbol. The latter class(es) are gained by recursively inspecting the arg-ret-symbol. E.g., if an argument object containing the ApplicationContext reference is passed, a dependency to ApplicationContext is registered. This especially means, that a call to this function may set up multiple dependencies --- if multiple classes are referred to by a complex arg-ret-symbol, e.g. a parameter object containing instances of several classes." (let* ((is-api (dojo-symbol-is-api-symbol function-symbol)) (class-id (dojo-symbol-class-id function-symbol)) (function-class (dojo-core-util-get-class is-api class-id)) (own-resource-id (if function-class (dojo-class-resource-id function-class) nil))) (dojo-core-dep-register-dependency-to-symbol own-resource-id arg-ret-symbol origin-class))) (defun dojo-core-dep-register-dependency-to-symbol (own-resource-id symbol origin-class &optional already-processed-symbol-ids) (let ((anything-changed nil)) (if (null already-processed-symbol-ids) (setq already-processed-symbol-ids (make-hash-table :test 'equal))) (if (dojo-symbol-p symbol) (puthash (dojo-symbol-id symbol) t already-processed-symbol-ids)) (log-dep (format "Called register-dependency-to-symbol for own-resource-id [%s], symbol %s" own-resource-id (dojo-core-util-symbol-to-short-string symbol))) (cond ((null own-resource-id) (log-dep (format "[WARNING] register-dependency-to-symbol called with null own-resource-id."))) ((null symbol) ()) ; (log-dep (format "[WARNING] null symbol passed to register-dependency-to-symbol."))) ((gethash (dojo-symbol-id symbol) already-processed-symbol-ids) (log-dep (format "[WARNING] symbol [%s] was already processed, maybe we have a cycle, will do nothing." (dojo-symbol-id symbol)))) ((dojo-core-util-is-instance-symbol symbol) (let* ((dep-resource-id (dojo-symbol-get-import-resource-id symbol))) (log-dep (format "[REGISTER] Dependency from own-resource-id [%s] to dep-resource-id [%s], based on symbol %s" own-resource-id dep-resource-id (dojo-core-util-symbol-to-short-string symbol))) (setq anything-changed (or anything-changed (dojo-core-dep-register-dependency-by-resources own-resource-id dep-resource-id 'DOJO-DEP-API origin-class))))) ((dojo-core-util-is-object-symbol symbol) (let* ((name-to-symbol (dojo-symbol-get-object-members symbol))) (maphash (lambda (name object-member-symbol) (if object-member-symbol (setq anything-changed (or anything-changed (dojo-core-dep-register-dependency-to-symbol own-resource-id object-member-symbol origin-class already-processed-symbol-ids))))) name-to-symbol)))) anything-changed)) (defun dojo-core-dep-log-dep-map (dep-map) (maphash (lambda (own-resource-id dest-resource-id-to-deps ) (log-dep (format " Resource [%s] has the following dependencies:" own-resource-id)) (maphash (lambda (dest-resource-id deps) (log-dep (format " - Resource [%s] (%s times)" dest-resource-id (length deps)))) dest-resource-id-to-deps)) dep-map)) (defun dojo-core-dep-insert-into-dep-map (dep-map resource-id dep-resource-id type origin) (let* ((dep-resource-id-to-deps (gethash resource-id dep-map))) (if (null dep-resource-id-to-deps) (progn (setq dep-resource-id-to-deps (make-hash-table :test 'equal)) (puthash resource-id dep-resource-id-to-deps dep-map))) (let* ((deps (gethash dep-resource-id dep-resource-id-to-deps)) (found nil)) (dolist (dep deps) (let* ((old-resource-id (dojo-dependency-resource-id dep)) (old-type (dojo-dependency-type dep)) (old-origin (dojo-dependency-origin dep))) (if (and (eq old-resource-id resource-id) (eq old-type type) (eq old-origin origin)) (setq found t)))) (if (not found) (progn (push (construct-dojo-dependency dep-resource-id type origin) deps))) (puthash dep-resource-id deps dep-resource-id-to-deps)))) (defun dojo-core-dep-load-for-project-if-necessary (project) (if project (let* ((project-to-dep-maps (dojo-workspace-project-to-dep-maps dojo-current-workspace)) (project-to-inverse-dep-maps (dojo-workspace-project-to-inverse-dep-maps dojo-current-workspace)) (dep-map (gethash project project-to-dep-maps)) (inverse-dep-map (gethash project project-to-inverse-dep-maps))) (if (or (null dep-map) (null inverse-dep-map)) (progn (log-dep (format "load-for-project-if-necessary: null dep-map [%s]; null inverse-dep-map [%s]" (null dep-map) (null inverse-dep-map))) (log-dep (format "... Loading for project [%s]" project)) (dojo-core-load-parse-dependency-file-if-exists project)))) (log-dep (format "[WARNING] Called dojo-core-dep-load-for-project-if-necessary for project [nil]")))) (defun dojo-core-dep-get-dep-resource-ids (resource-id) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (resource (gethash resource-id id-to-resource)) (project (if resource (dojo-resource-project resource) nil)) (project-to-dep-maps (progn (dojo-core-dep-load-for-project-if-necessary project) (dojo-workspace-project-to-dep-maps dojo-current-workspace))) (dep-map (if project (gethash project project-to-dep-maps) nil)) (dep-resource-id-to-deps (if dep-map (gethash resource-id dep-map) nil))) (if dep-resource-id-to-deps (hash-table-get-all-keys dep-resource-id-to-deps) ()))) (defun dojo-core-dep-get-all-inverse-dep-resource-ids (resource-id &optional inverse-dep-sets found-resource-ids depth) "Given some resource id, returns the resource ids of all inverse dependencies. Works in a recursive manner. Avoids cycles by registering (and in the future ignoring) already found resources. Returns a list of hashtables. The first hashtable will contain the inverse dependency resource ids of the given resource, the second hashtable their inverse dependency resource ids. I.e., the leaves of the inverse dependency tree (most far away from the given resource id) will be contained in the very last hashtable." (if (null found-resource-ids) (progn (setq found-resource-ids (make-hash-table :test 'equal)) (setq depth 0))) (puthash resource-id t found-resource-ids) ; Enlarge inverse-dep-sets list if necessary, and register resource. (if (> depth 0) (progn (while (< (length inverse-dep-sets) depth) (setq inverse-dep-sets (append inverse-dep-sets (list (make-hash-table :test 'equal))))) (let* ((inverse-dep-set (nth (1- depth) inverse-dep-sets))) (log-extract-prio (format "...... Registering inverse dep resource [%s] at index [%s] of inverse-dep-sets" resource-id (1- depth))) (puthash resource-id t inverse-dep-set)))) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (resource (gethash resource-id id-to-resource)) (project (if resource (dojo-resource-project resource) nil)) (project-to-inverse-dep-maps (progn (dojo-core-dep-load-for-project-if-necessary project) (dojo-workspace-project-to-inverse-dep-maps dojo-current-workspace))) (inverse-dep-map (if project (gethash project project-to-inverse-dep-maps) nil)) (inverse-dep-resource-id-to-deps (if inverse-dep-map (gethash resource-id inverse-dep-map) nil))) (if inverse-dep-resource-id-to-deps (maphash (lambda (inverse-dep-resource-id deps) (log-extract-prio (format "...... Considering inverse-dep-resource [%s] of resource [%s]" inverse-dep-resource-id resource-id)) (if (null (gethash inverse-dep-resource-id found-resource-ids)) (progn (log-extract-prio (format "......... Will do a recursive call for it.")) (setq inverse-dep-sets (dojo-core-dep-get-all-inverse-dep-resource-ids inverse-dep-resource-id inverse-dep-sets found-resource-ids (1+ depth)))) (log-extract-prio (format "......... Will ignore it since it was already processed.")))) inverse-dep-resource-id-to-deps))) ; (log-workspace (format "Returning %s" inverse-dep-sets)) ; (log-workspace (format "found-resource-ids is %s" found-resource-ids)) inverse-dep-sets) (defun dojo-core-dep-log-inverse-dep-sets (inverse-dep-sets) (log-extract-prio (format "... Inverse dependencies:")) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (depth 1)) (dolist (inverse-dep-set inverse-dep-sets) (log-extract-prio (format " - Depth [%s]:" depth)) (maphash (lambda (inverse-resource-id ignored) (let* ((inverse-resource (gethash inverse-resource-id id-to-resource)) (project (if inverse-resource (dojo-resource-project inverse-resource) "---")) (path (if inverse-resource (dojo-resource-path inverse-resource) "---"))) (log-extract-prio (format " - Resource [%s:%s:%s]" inverse-resource-id project path)))) inverse-dep-set) (incf depth)))) (provide 'dojo-core-dependency)