diff --git a/find-system.lisp b/find-system.lisp
index cee8d4a..3f217f0 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -260,11 +260,15 @@ Going forward, we recommend new users should be using the source-registry.
     (when *systems-being-defined*
       (gethash (coerce-name name) *systems-being-defined*)))
 
-  (defun call-with-system-definitions (thunk)
-    (if *systems-being-defined*
-        (call-with-asdf-cache thunk)
-        (let ((*systems-being-defined* (make-hash-table :test 'equal)))
-          (call-with-asdf-cache thunk))))
+  (defun call-with-system-definitions (thunk &optional name)
+    (flet ((fun ()
+             (when (and name (not (nth-value 1 (gethash name *systems-being-defined*))))
+               (setf (gethash name *systems-being-defined*) nil))
+             (funcall thunk)))
+      (if *systems-being-defined*
+          (call-with-asdf-cache #'fun)
+          (let ((*systems-being-defined* (make-hash-table :test 'equal)))
+            (call-with-asdf-cache #'fun)))))
 
   (defun clear-systems-being-defined ()
     (when *systems-being-defined*
@@ -272,12 +276,12 @@ Going forward, we recommend new users should be using the source-registry.
 
   (register-hook-function '*post-upgrade-cleanup-hook* 'clear-systems-being-defined)
 
-  (defmacro with-system-definitions ((&optional) &body body)
-    `(call-with-system-definitions #'(lambda () ,@body)))
+  (defmacro with-system-definitions ((&optional name) &body body)
+    `(call-with-system-definitions #'(lambda () ,@body) ,name))
 
   (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*))
     ;; Tries to load system definition with canonical NAME from PATHNAME.
-    (with-system-definitions ()
+    (with-system-definitions (name)
       (with-standard-io-syntax
         (let ((*package* (find-package :asdf-user))
               ;; Note that our backward-compatible *readtable* is
@@ -374,7 +378,10 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
       (values foundp found-system pathname previous previous-time)))
 
   (defmethod find-system ((name string) &optional (error-p t))
-    (with-system-definitions ()
+    (with-system-definitions (name)
+      (let ((primary-name (primary-system-name name)))
+        (unless (nth-value 1 (gethash primary-name *systems-being-defined*))
+          (find-system primary-name nil)))
       (loop
         (restart-case
             (multiple-value-bind (foundp found-system pathname previous previous-time)