WIP fixing bugs in rewrite

sources/commands/utils.dylan

@@ -7,7 +7,7 @@ Synopsis: Utilities for use by deft commands
 // Using the comment markers enables recovery if someone commits a string
 // other than "HEAD" by accident. git's `ident` attribute doesn't use tag
 // names and `filter` looks more complex than it's worth.
-define constant $deft-version :: <string> = /*__*/ "HEAD" /*__*/;
+define constant $deft-version :: <string> = /*__*/ "v0.12.0-23-g939c51c 2024-12-30T10:11:06-05:00" /*__*/;
 
 
 // Run an executable or shell command. `command` may be a string or a sequence

sources/pacman/packages.dylan

@@ -156,9 +156,16 @@ end function;
 // they are all specified in one table and here we extract them and put them in
 // the right place. There is no conflict since the file doesn't contain
 // multiple releases.
+define variable *count* = 0;
 define function load-dylan-package-file
     (file :: <file-locator>) => (release :: <release>)
   debug("Reading package file %s", file);
+  if (ends-with?(as(<string>, file), "deft/dylan-package.json"))
+    inc!(*count*);
+    if (*count* == 2)
+      break();
+    end;
+  end;
   fs/with-open-file (stream = file)
     let json = block ()
                  parse-json(stream, table-class: <istring-table>, strict?: #f)

sources/workspaces/lid.dylan

@@ -83,6 +83,10 @@ define function add-lid
   let library-name = lid-value(lid, $library-key);
   if (library-name)
     let lids = element(ws.%lids-by-library, library-name, default: #());
+    if (member?(lid, lids))
+      note("re-adding %s", lid);
+      break();
+    end;
     ws.%lids-by-library[library-name] := pair(lid, lids);
   end;
   ws.%lids-by-pathname[as(<string>, lid.lid-locator)] := lid;
@@ -116,12 +120,12 @@ end function;
 define function skip-lid?
     (ws :: <workspace>, lid :: <lid>) => (skip? :: <bool>)
   if (string-equal-ic?("hdp", lid.lid-locator.locator-extension))
-    let library-name = lid-value(lid, $library-key, error?: #t);
+    let library = lid-value(lid, $library-key, error?: #t);
     let directory = lid.lid-locator.locator-directory;
     let existing = choose(method (x)
                             x.lid-locator.locator-directory = directory
                           end,
-                          element(ws.%lids-by-library, library-name, default: #[]));
+                          element(ws.%lids-by-library, library, default: #[]));
     // Why only size = 1?  Shouldn't I be looking for exactly lid.locator-name + ".lid"
     existing.size = 1
       & string-equal-ic?("lid", existing[0].lid-locator.locator-extension)

sources/workspaces/registry.dylan

@@ -66,6 +66,7 @@ define function update-registry
   let written = 0;
   let no-platform = make(<stretchy-vector>);
   for (lids keyed-by library in ws.lids-by-library)
+    note("*** %20s => %s", library, lids);
     let candidates
       = choose(method (lid)
                  let platform = lid-value(lid, $platforms-key);

sources/workspaces/workspaces.dylan

@@ -90,12 +90,11 @@ define function registry-directory
   subdirectory-locator(ws.workspace-directory, "registry")
 end function;
 
-// Loads the workspace definition by looking up from `directory` to find the
-// workspace root and loading the workspace.json file. If no workspace.json
-// file exists, the workspace is created using the dylan-package.json file (if
-// any) and default values. As a last resort `directory` is used as the
-// workspace root. Signals `<workspace-error>` if either JSON file is found but
-// is invalid.
+// Loads the workspace definition by looking up from `directory` to find the workspace
+// root and loading the workspace.json file. If no workspace.json file exists, the
+// workspace is created using the dylan-package.json file (if any) and default values. As
+// a last resort `directory` is used as the workspace root. Signals `<workspace-error>`
+// if either JSON file is found but is invalid.
 define function load-workspace
     (#key directory :: <directory-locator> = fs/working-directory())
  => (workspace :: <workspace>)
@@ -123,19 +122,25 @@ end function;
 define function scan-workspace
     (ws :: <workspace>) => ()
   // First do active packages to populate %lids-by-active-package.
-  for (package in find-active-packages(ws.workspace-directory))
-    let directory = active-package-directory(ws, package);
-    fs/do-directory(curry(scan-workspace-file, ws, package), directory);
+  for (release in ws.workspace-active-packages)
+    let directory = active-package-directory(ws, release);
+    verbose("Scanning active package in %s", directory);
+    fs/do-directory(curry(scan-workspace-file, ws, release), directory);
   end;
   ws.active-packages-scanned? := #t; // Prevent infinite recursion in empty workspaces.
   // Install dependencies and further update the %lids-by-* tables with them.
   let (releases, actives) = ensure-deps-installed(ws);
   for (release in releases)
-    let directory = active-package-directory(ws, pm/release-package(release));
+    let directory = pm/source-directory(release);
+    verbose("Scanning release in %s", directory);
     fs/do-directory(curry(scan-workspace-file, ws, release), directory);
   end;
 end function;
 
+// Directories that should never be scanned for LID files.
+define variable *skip-directories*
+  = list(".git", "_build", "_packages", "registry");
+
 define function scan-workspace-file
     (ws, active-package, dir, name, type) => ()
   select (type)
@@ -153,15 +158,19 @@ define function scan-workspace-file
         end;
       end;
     #"directory" =>
-      // TODO: Git submodules could indicate a project in transition from Git
-      // submodules to Deft, or they could indicate use of a repository that isn't
-      // available in the package catalog. Ignore them and assume all packages are
-      // available in the catalog for now. Ultimately we should have an escape hatch
-      // like the ability to use a local package catalog IN ADDITION to the main
-      // catalog. Or just make this configurable?
+      // TODO: Git submodules could indicate use of a repository that isn't available in
+      // the package catalog. Ignore them and assume all packages are available in the
+      // catalog for now. Ultimately we should have an escape hatch like the ability to
+      // use a local package catalog in addition to the main catalog, and/or make this
+      // configurable?
       let subdir = subdirectory-locator(dir, name);
-      let subdir/git = subdirectory-locator(subdir, ".git");
-      if (name ~= ".git" & ~fs/file-exists?(subdir/git))
+      if (member?(name, *skip-directories*, test: \=))
+        verbose("  Skipping %s", subdir);
+      elseif (fs/file-exists?(file-locator(subdir, ".git")))
+        // Note that .git may be a directory or a regular file. Using file-locator
+        // here works for both.
+        verbose("  Skipping Git submodule %s", subdir);
+      else
         fs/do-directory(curry(scan-workspace-file, ws, active-package), subdir);
       end;
     #"link" =>
@@ -297,6 +306,11 @@ define function find-active-packages
     | map(pm/load-dylan-package-file, subdir-files)
 end function;
 
+define method active-package-directory
+    (ws :: <workspace>, release :: pm/<release>) => (d :: <directory-locator>)
+  active-package-directory(ws, pm/package-name(release))
+end method;
+
 define method active-package-directory
     (ws :: <workspace>, package :: pm/<package>) => (d :: <directory-locator>)
   active-package-directory(ws, pm/package-name(package))