Implement load-system

Author: ohler55

docs/notes.md

@@ -5,11 +5,26 @@
 ---------------------
 
 - expand-system
- - make sure require can load a system
- - add load-system (system-designator)
-  - :quux or 'quux or "quux"
+ - system (not ASDF but similar) https://asdf.common-lisp.dev/asdf.html
+  - add :pathname to system for the default location of component files
+  - components
+   - allow filename of (:file "filename")
+    - other keywords in (:file "quux" :pathname "src-dir" :description "has random stuff in it")
+     - :description string
+     - :pathname pathname-specifier
+    - if (:file quux) is used then file should be the file name only and :pathname indicates the dir
+
+ - require and load can not easily be made to do the same as load-system dues to circulat dependency
+  - load alway create some kind of interface but maybe best to leave them as just loading the def and not fetch and load
+ - load-system (system)
+  - don't bother with &rest keys &key force force-not verbose version &allow-other-keys
+
+  - :quux or 'quux or "quux" for system
+  - set *load-pathname* and *load-truename* during load and eval
+  - defer package back to before loading
  - system files can/should be .asd
   - one defsystem in file, read, compile, eval to get system
+   - other code before defsystem will not break
   - tell system fetch and load
  - use load-system to read in file, eval, and then call fetch and load
   - same as require and load but must receive system

pkg/gi/load-system.go

@@ -0,0 +1,87 @@
+// Copyright (c) 2026, Peter Ohler, All rights reserved.
+
+package gi
+
+import (
+	"fmt"
+	"os"
+
+	"github.com/ohler55/slip"
+	"github.com/ohler55/slip/pkg/flavors"
+)
+
+func defLoadSystem() {
+	slip.Define(
+		func(args slip.List) slip.Object {
+			f := LoadSystem{Function: slip.Function{Name: "load-system", Args: args}}
+			f.Self = &f
+			return &f
+		},
+		&slip.FuncDoc{
+			Name: "load-system",
+			Args: []*slip.DocArg{
+				{
+					Name: "system",
+					Type: "symbol|keyword|string",
+					Text: "System designator of the system to load.",
+				},
+				{Name: "&optional"},
+				{
+					Name: "pathname",
+					Type: "string",
+					Text: "Directory the system .asd file is located in.",
+				},
+			},
+			Return: "system",
+			Text: `__load-system__ load the _system_ by fetching the component files
+and loading them using the __:fetch__ and __:load__ methods of the system. Unlike ASDF,
+searching for the system is limited to the __*package-load-path*__ unless an oprional
+_pathname_ is provided. The search looks for _system_ with a '.asd' extension.`,
+			Examples: []string{
+				`(load-system  :quux "testdata") => #<system 12345>`,
+			},
+		}, &Pkg)
+}
+
+// LoadSystem represents the load-system function.
+type LoadSystem struct {
+	slip.Function
+}
+
+// Call the function with the arguments provided.
+func (f *LoadSystem) Call(s *slip.Scope, args slip.List, depth int) slip.Object {
+	slip.CheckArgCount(s, depth, f, args, 1, 2)
+	cys := slip.MustBeString(args[0], "system")
+	path, _ := s.Get(slip.Symbol("*package-load-path*")).(slip.String)
+	dir := string(path)
+	if 1 < len(args) {
+		dir = slip.MustBeString(args[1], "pathname")
+	}
+	filepath := fmt.Sprintf("%s/%s.asd", dir, cys)
+	currentPkg := slip.CurrentPackage
+	defer func() {
+		s.Set(slip.Symbol("*load-pathname*"), nil)
+		s.Set(slip.Symbol("*load-truename*"), nil)
+		slip.CurrentPackage = currentPkg
+	}()
+	s.Set(slip.Symbol("*load-pathname*"), slip.String(filepath))
+	s.Set(slip.Symbol("*load-truename*"), slip.String(filepath))
+	buf, err := os.ReadFile(filepath)
+	if err != nil {
+		slip.FilePanic(s, depth, slip.String(filepath), "loading system %s at %s: %s", cys, filepath, err)
+	}
+	code := slip.Read(buf, s)
+	code.Compile()
+	obj := code.Eval(s, nil)
+
+	sys, ok := obj.(*flavors.Instance)
+	if !ok || sys.Class() != system {
+		slip.ErrorPanic(s, depth, "The last expression in %s was not a defsystem.", filepath)
+	}
+	sys.Set(slip.Symbol("pathname"), slip.String(dir))
+
+	_ = sys.Receive(s, ":fetch", nil, depth+1)
+	_ = sys.Receive(s, ":load", nil, depth+1)
+
+	return sys
+}

pkg/gi/pkg.go

@@ -288,6 +288,7 @@ func init() {
 	defFindProcess()
 	defCommand()
 	defMakeCommand()
+	defLoadSystem()
 
 	Pkg.Initialize(nil, &Env{})
 

pkg/gi/system.go

@@ -32,6 +32,8 @@ Each list element starts with an operation name such as :test and is followed by
 to invoke to implement that operation. When system :run is called with key values those keys
 are bound to the values and are available to the function being called.
 `
+
+	systemPathnameDoc = "Filepath to the component files."
 )
 
 var system *flavors.Flavor
@@ -54,6 +56,7 @@ func defSystem() *flavors.Flavor {
 			"components":     nil,
 			"in-order-to":    nil,
 			"cache":          nil,
+			"pathname":       nil,
 		},
 		nil, // inherit
 		slip.List{ // options
@@ -64,7 +67,7 @@ func defSystem() *flavors.Flavor {
 				slip.String(`Instances of this Flavor define a system similar to ASDF in common LISP
 (https://asdf.common-lisp.dev) but with some differences. A __system__ instance
 captures the information associated with a code that implements the
-system. This includes providence variables such as author, version, and source
+system. This includes provenance variables such as author, version, and source
 location to name a few.
 
 Some of the differences when compared to ASDF are:
@@ -75,13 +78,13 @@ Some of the differences when compared to ASDF are:
  - The :components variable only allows for files and not modules.
  - The :depends-on variable differs to support git and other system sources.
  - The :in-order-to variable differs although it serves the same purpose.
- - The __system__ is a Flavor that also supports a :fetch method.
+ - The __system__ is a Flavor that also supports :fetch and :load methods.
  - A :cache variable is included.
 
 
 The usual use of a __system__ instance is to first send the instance a :fetch
-method to cache sources and then invoke one of the operations defined in the
-:in-order-to variable.
+method to cache sources, followed by :load, and then invoke one of the
+operations defined in the :in-order-to variable if desired.
 
 `),
 			},
@@ -92,6 +95,7 @@ method to cache sources and then invoke one of the operations defined in the
 	system.DefMethod(":load", "", systemLoadCaller{})
 	system.DefMethod(":run", "", systemRunCaller{})
 
+	system.Document("pathname", systemPathnameDoc)
 	system.Document("components", systemComponentsDoc)
 	system.Document("cache", systemCacheDoc)
 	system.Document("depends-on", systemDependsOnDoc)
@@ -179,6 +183,10 @@ func (caller systemLoadCaller) Call(s *slip.Scope, args slip.List, depth int) sl
 	}
 	gc := self.Get("components")
 	if gc != nil {
+		dir := "."
+		if pn, _ := self.Get("pathname").(slip.String); 0 < len(pn) {
+			dir = string(pn)
+		}
 		var components slip.List
 		components, ok := gc.(slip.List)
 		if !ok {
@@ -189,11 +197,12 @@ func (caller systemLoadCaller) Call(s *slip.Scope, args slip.List, depth int) sl
 			if path, ok = comp.(slip.String); !ok {
 				slip.TypePanic(s, depth, "component", comp, "string")
 			}
-			matches, _ := filepath.Glob(string(path))
+			compPath := filepath.Join(dir, string(path))
+			matches, _ := filepath.Glob(compPath)
 			if len(matches) == 0 {
-				matches, _ = filepath.Glob(string(path) + ".lisp")
+				matches, _ = filepath.Glob(compPath + ".lisp")
 				if len(matches) == 0 {
-					slip.ErrorPanic(s, depth, "%s not found.", path)
+					slip.ErrorPanic(s, depth, "%s.lisp not found.", compPath)
 				}
 			}
 			for _, m := range matches {

test/gi/testdata/sister/sister.asd

@@ -0,0 +1,13 @@
+(defsystem "sister"
+    :author "pete"
+    :maintainer "pete@ohler.com"
+    :license "MIT"
+    :version "v0.1.0"
+    :homepage "https://github.com/ohler55/slip"
+    :bug-tracker "https://github.com/ohler55/slip/issues"
+    :source-control "https://github.com/ohler55/slip"
+    :description "Just a sample."
+    :cache "testout"
+    :components '("sister")
+    :in-order-to '((:sample (+ (sys-test) six))
+                   (:just-eval 3)))