1.1--- a/emacs/lib/graph.el	Mon Sep 16 21:28:33 2024 -0400
     1.2+++ b/emacs/lib/graph.el	Tue Sep 17 22:19:19 2024 -0400
     1.3@@ -66,15 +66,13 @@
     1.4   :type 'hook
     1.5   :group 'graph)
     1.6 
     1.7-(defvar-local org-graph nil
     1.8-  "The currently active graph of org nodes.")
     1.9-
    1.10 (defcustom org-graph-db-init-script (join-paths company-source-directory "infra/scripts/org-db-init.lisp")
    1.11   "Path to a lisp script responsible for initializing the `org-graph-db-directory'.")
    1.12 
    1.13 (cl-defstruct org-graph-db-handle
    1.14   (type :rocksdb)
    1.15   (name "org-graph-db")
    1.16+  init
    1.17   get
    1.18   put
    1.19   delete
    1.20@@ -101,12 +99,70 @@
    1.21       org-graph-locations))
    1.22    org-graph))
    1.23 
    1.24-(defun org-dblock-write:links ()
    1.25-  "Generate a 'links' block for the designated node.")
    1.26+(defun org-graph-files ()
    1.27+  (org-list-files org-graph-locations org-agenda-extensions))
    1.28+
    1.29+(cl-defstruct org-graph
    1.30+  ;; TODO 2024-09-17: use integers instead of string
    1.31+  (nodes (make-hash-table :test 'equal))
    1.32+  (edges (make-hash-table :test 'equal)))
    1.33+
    1.34+(defvar org-graph (make-org-graph)
    1.35+  "The Emacs-native org-graph. Should be assigned to an `org-graph' instance.")
    1.36+
    1.37+(cl-defstruct org-graph-node id name file point)
    1.38+(cl-defstruct org-graph-edge (type 'link) in properties timestamp out)
    1.39+
    1.40+(defun org-graph--file-hash (file)
    1.41+  "Compute the hash of FILE."
    1.42+  (with-temp-buffer
    1.43+    (set-buffer-multibyte nil)
    1.44+    (insert-file-contents-literally file)
    1.45+    (secure-hash 'md5 (current-buffer))))
    1.46 
    1.47-(defun org-dblock-write:graph ()
    1.48-  "Generate a 'graph' block for the designated set of nodes.")
    1.49+(defun org-graph-node-at-point (&optional update)
    1.50+  "Return the `org-graph-node' at point. When UPDATE is non-nil insert or
    1.51+update the node into the currently active org-graph."
    1.52+  (let* ((file (buffer-file-name))
    1.53+         (node (make-org-graph-node :point (point) :file file)))
    1.54+    (if (derived-mode-p 'org-mode)
    1.55+        (progn
    1.56+          (if (org-before-first-heading-p)
    1.57+              (setf (org-graph-node-name node) (org-get-title)
    1.58+                    ;; use the filename, create a hash as id
    1.59+                    (org-graph-node-id node) (org-graph--file-hash file))
    1.60+            (setf (org-graph-node-id node) (org-id-get)
    1.61+                  (org-graph-node-name node) (cadddr (org-heading-components)))))
    1.62+          (setf (org-graph-node-id node) (org-graph--file-hash file)
    1.63+                (org-graph-node-name node) (file-name-nondirectory file)))
    1.64+    (when update
    1.65+      (puthash (org-graph-node-id node) node (org-graph-nodes org-graph)))
    1.66+    (message "%s" node)))
    1.67 
    1.68+;; TODO 2024-09-17: 
    1.69+(defun org-graph-edges-at-point (&optional update)
    1.70+  "Return a list of `org-graph-edge' instances associated with the node at
    1.71+point. When UPDATE is non-nil insert or update the edges into the
    1.72+currently active org-graph."
    1.73+  (interactive)
    1.74+  (let ((edges))
    1.75+    (if (derived-mode-p 'org-mode))
    1.76+    (when update
    1.77+      (dolist (edge edges)
    1.78+        (puthash (org-graph-edge-in edge) edge (org-graph-edges org-graph))))
    1.79+    (message "%s" edge)))
    1.80+
    1.81+(defun org-graph-buffer-update (&optional buffer)
    1.82+  "Map over an org buffer adding all nodes to the active org-graph."
    1.83+  (interactive)
    1.84+    (save-excursion
    1.85+      (with-current-buffer (or buffer (current-buffer))
    1.86+        ;; capture file node
    1.87+        (goto-char (point-min))
    1.88+        (org-graph-node-at-point t)
    1.89+        (when (derived-mode-p 'org-mode)
    1.90+          (org-map-entries (lambda () (org-graph-node-at-point t)))))))
    1.91+  
    1.92 ;;; Links
    1.93 ;; See https://github.com/toshism/org-super-links/blob/develop/org-super-links.el
    1.94 (declare-function org-make-link-description-function "ext:org-mode")
    1.95@@ -449,39 +505,31 @@
    1.96               (message "No edge found. Deleting active only.")))))))
    1.97   (org-graph-edge--delete-link (org-element-context)))
    1.98 
    1.99-;;;###autoload
   1.100-(defun org-graph-edge-store-link (&optional GOTO KEYS)
   1.101+(defvar org-graph-stored-mark nil
   1.102+  "mark stored with `org-graph-edge-store'.")
   1.103+
   1.104+(defun org-graph-edge-store ()
   1.105   "Store a point to register for use in function `org-graph-edge-insert-link'.
   1.106 This is primarily intended to be called before `org-capture', but
   1.107 could possibly even be used to replace `org-store-link' IF
   1.108 function `org-graph-edge-insert-link' is used to replace
   1.109 `org-insert-link'.  This has not been thoroughly tested outside
   1.110-of links to/form org files.  GOTO and KEYS are unused."
   1.111+of links to/form org files."
   1.112   (interactive "P")
   1.113-  (ignore GOTO)
   1.114-  (ignore KEYS)
   1.115-  (save-excursion
   1.116-    ;; this is a hack. if the point is at the first char of a heading
   1.117-    ;; the marker is not updated as expected when text is inserted
   1.118-    ;; above the heading. for example a capture template inserted
   1.119-    ;; above. that results in the link being to the heading above the
   1.120-    ;; expected heading.
   1.121-    (goto-char (line-end-position))
   1.122-    (let ((c1 (make-marker)))
   1.123-      (set-marker c1 (point) (current-buffer))
   1.124-      (set-register ?^ c1)
   1.125-      (message "Link copied"))))
   1.126+  (let ((c1 (make-marker)))
   1.127+    (set-marker c1 (point) (current-buffer))
   1.128+    (setq org-graph-stored-mark c1)
   1.129+    (message "Mark stored.")))
   1.130 
   1.131 ;;;###autoload
   1.132 (defun org-graph-edge-insert-link ()
   1.133-  "Insert an edge link from the register."
   1.134+  "Insert an edge from the list `org-graph-stored-marks'."
   1.135   (interactive)
   1.136-  (let* ((target (get-register ?^)))
   1.137-    (if target
   1.138-        (progn
   1.139-          (org-graph-edge--insert-link target)
   1.140-          (set-register ?^ nil))
   1.141-      (message "No link to insert!"))))
   1.142+  (if org-graph-stored-mark
   1.143+      (progn 
   1.144+        (org-graph-edge--insert-link org-graph-stored-mark)
   1.145+        (setq org-graph-stored-mark nil))
   1.146+    (org-graph-edge-link)))
   1.147 
   1.148 ;;;###autoload
   1.149 (defun org-graph-edge-link ()
   1.150@@ -489,5 +537,11 @@
   1.151   (interactive)
   1.152   (org-graph-edge-search-function))
   1.153 
   1.154+(defun org-dblock-write:links ()
   1.155+  "Generate a 'links' block for the designated node.")
   1.156+
   1.157+(defun org-dblock-write:graph ()
   1.158+  "Generate a 'graph' block for the designated set of nodes.")
   1.159+
   1.160 (provide 'graph)
   1.161 ;; graph.el ends here

     2.1--- a/lisp/lib/obj/graph/pkg.lisp	Mon Sep 16 21:28:33 2024 -0400
     2.2+++ b/lisp/lib/obj/graph/pkg.lisp	Tue Sep 17 22:19:19 2024 -0400
     2.3@@ -29,7 +29,7 @@
     2.4 
     2.5 ;;; Edge
     2.6 (defclass edge (node)
     2.7-  ((a :initarg :in) (b :initarg :out))
     2.8+  ((in :initarg :in) (out :initarg :out))
     2.9   (:documentation "generic edge mixin. Compatible with the NODE and ID protocols."))
    2.10 
    2.11 (defclass edgex (edge id)

     3.1--- a/readme.org	Mon Sep 16 21:28:33 2024 -0400
     3.2+++ b/readme.org	Tue Sep 17 22:19:19 2024 -0400
     3.3@@ -62,125 +62,30 @@
     3.4 Building the core will produce its output to the =.stash= directory by
     3.5 default. You can then test, run, and install the resulting files or
     3.6 package them up to be shipped elsewhere.
     3.7-
     3.8-The core produces a collection of native program binaries, compiled
     3.9-lisp modules in FASL format, as well as web distributions containing
    3.10-the usual suspects (html, css, js) as well as wasm modules.
    3.11-
    3.12 ** From Source
    3.13 *** Lisp
    3.14 The Lisp Core can be found under the =lisp= directory. It is the
    3.15 largest system, most actively developed, and is intended to cover the
    3.16 complete surface of the user-facing APIs contained in the core.
    3.17 
    3.18-Starting from a standard Common Lisp environment with at least
    3.19-[[https://www.quicklisp.org/beta/][Quicklisp]] installed, you can execute =./x.lisp build skel= to build
    3.20-the project compiler and =./x.lisp run skel= to run it. This tool is a
    3.21-convenience for building and testing different parts of the core from
    3.22-a minimal dependency set.
    3.23-
    3.24-#+name: x-help
    3.25-#+begin_src shell :exports both :results output
    3.26-# bootstrap the core build tool
    3.27-./x.lisp --help
    3.28-#+end_src
    3.29-
    3.30-#+RESULTS: x-help
    3.31-#+begin_example
    3.32-This is SBCL 2.4.7:76bbecb68, an implementation of ANSI Common Lisp.
    3.33-More information about SBCL is available at <http://www.sbcl.org/>.
    3.34-
    3.35-SBCL is free software, provided as is, with absolutely no warranty.
    3.36-It is mostly in the public domain; some portions are provided under
    3.37-BSD-style licenses.  See the CREDITS and COPYING files in the
    3.38-distribution for more information.
    3.39-To load "rt":
    3.40-  Load 1 ASDF system:
    3.41-    rt
    3.42-; Loading "rt"
    3.43-
    3.44-x.lisp --- core build tool
    3.45-x.lisp [CMD]
    3.46-CMDS:
    3.47-test
    3.48-compile
    3.49-build
    3.50-make
    3.51-test
    3.52-run
    3.53-save
    3.54-install
    3.55-#+end_example
    3.56-
    3.57-To test the lisp standard library:
    3.58-#+begin_src shell :results output :exports both
    3.59-# test systems
    3.60-./x.lisp test std
    3.61-#+end_src
    3.62-
    3.63-#+RESULTS:
    3.64-#+begin_example
    3.65-This is SBCL 2.4.7:dc890089a, an implementation of ANSI Common Lisp.
    3.66-More information about SBCL is available at <http://www.sbcl.org/>.
    3.67+The core is self-hosted in the sense that it is intended to be built
    3.68+from one of its own programs - the =skel= project compiler. You may
    3.69+also load any part of the core individually as long as you have [[https://www.sbcl.org/][SBCL]]
    3.70+and [[https://www.quicklisp.org/beta/][Quicklisp]] installed.
    3.71+*** Rust
    3.72+Today, the Rust components of the core are quite small and
    3.73+isolated. We like Rust right now for the reasonable memory safety
    3.74+guarantees, as an interface to (W)GPU, WASM, LLVM, etc, and because it
    3.75+has an industry-sponsored ecosystem (guaranteed future). 
    3.76 
    3.77-SBCL is free software, provided as is, with absolutely no warranty.
    3.78-It is mostly in the public domain; some portions are provided under
    3.79-BSD-style licenses.  See the CREDITS and COPYING files in the
    3.80-distribution for more information.
    3.81-To load "rt":
    3.82-  Load 1 ASDF system:
    3.83-    rt
    3.84-; Loading "rt"
    3.85-
    3.86-To load "rt":
    3.87-  Load 1 ASDF system:
    3.88-    rt
    3.89-; Loading "rt"
    3.90-
    3.91-To load "std/tests":
    3.92-  Load 1 ASDF system:
    3.93-    std/tests
    3.94-; Loading "std/tests"
    3.95-
    3.96-in suite STD:
    3.97-; with 15 tests
    3.98-#<PASS READTABLES> 
    3.99-#<PASS SYM> 
   3.100-#<PASS STRING> 
   3.101-#<PASS LIST> 
   3.102-#<PASS ERR> 
   3.103-#<PASS THREADS> 
   3.104-#<PASS TIMERS> 
   3.105-#<PASS FMT> 
   3.106-#<PASS ANA> 
   3.107-#<PASS PAN> 
   3.108-#<PASS ALIEN> 
   3.109-#<PASS CURRY> 
   3.110-#<PASS BITS> 
   3.111-#<PASS LEB128> 
   3.112-#<PASS TASKS> 
   3.113-No tests failed.
   3.114-#+end_example
   3.115-
   3.116-To save the prelude to =.stash/prelude.core=:
   3.117-#+begin_src shell :results output :noeval t
   3.118-# save cores
   3.119-./x save prelude
   3.120-#+end_src
   3.121-
   3.122-And to install binaries (defaults to =/usr/local/bin/=):
   3.123-#+begin_src shell :results none :noeval t
   3.124-# install binaries
   3.125-sudo ./x install
   3.126-#+end_src
   3.127-
   3.128-*** Rust
   3.129-The Core Rust system can be found under the =rust= directory.
   3.130+Our Rust code is far less concerned with being completely from
   3.131+scratch - dependencies are imported freely and at will - adapting to
   3.132+whatever FOTM is hot right now.
   3.133 
   3.134 A workspace is configured such that you can build all components with
   3.135 the following command (~NOTE~ - takes a long time):
   3.136 #+begin_src shell :exports both :results output
   3.137-  cd rust && cargo build --release
   3.138+  cd rust && cargo build
   3.139 #+end_src
   3.140 
   3.141 *** Emacs

     4.1--- a/skelfile	Mon Sep 16 21:28:33 2024 -0400
     4.2+++ b/skelfile	Tue Sep 17 22:19:19 2024 -0400
     4.3@@ -17,7 +17,7 @@
     4.4        psl.dat parquet.json rgb.txt
     4.5        save-std save-prelude save-user
     4.6        save-infra save-core save-tests
     4.7-       build-tree-sitter-alien build-core fasl
     4.8+       build-tree-sitter-alien build-core fasls
     4.9        ;; build-skel build-organ build-homer build-packy build-rdb
    4.10        ;; rust-bin
    4.11        ))
    4.12@@ -140,7 +140,7 @@
    4.13         (:compile () 
    4.14                   (compile-lisp :core/tests :force t :verbose t)))
    4.15  (bench () (:compile () (compile-lisp :core/bench :force t :verbose t)))
    4.16- (fasl (compile-core #+nil compile-tests compile-bench compile-user compile-prelude))
    4.17+ (fasls (compile-core #+nil compile-tests compile-bench compile-user compile-prelude))
    4.18  ;; rust
    4.19  (mailman () #$cd rust && cargo build -Z unstable-options --bin mailman --artifact-dir ../.stash/$#)
    4.20  (alik () #$cd rust && cargo build -Z unstable-options --bin alik --artifact-dir ../.stash/$#)

     5.1--- a/x.lisp	Mon Sep 16 21:28:33 2024 -0400
     5.2+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3@@ -1,319 +0,0 @@
     5.4-#!/usr/bin/env -S sbcl --no-sysinit --no-userinit --script
     5.5-;;; core build tool
     5.6-
     5.7-;; 
     5.8-
     5.9-;;; Code:
    5.10-(in-package :cl-user)
    5.11-#-(or sbcl cl) (error "unsupported Lisp compiler")
    5.12-#-quicklisp
    5.13-(let ((quicklisp-init (or (probe-file #p"~/.stash/quicklisp/setup.lisp")
    5.14-                          (probe-file #p"/usr/local/share/lisp/quicklisp/setup.lisp")
    5.15-                          (probe-file #p "~/quicklisp/setup.lisp"))))
    5.16-  (when (probe-file quicklisp-init)
    5.17-    (load quicklisp-init)))
    5.18-(require 'sb-rotate-byte)
    5.19-(require 'sb-introspect)
    5.20-(require 'sb-grovel)
    5.21-(require 'sb-cltl2)
    5.22-(require 'sb-cover)
    5.23-(require 'sb-sprof)
    5.24-
    5.25-(asdf:load-system (asdf:find-system :cl-ppcre))
    5.26-(asdf:load-asd (probe-file (merge-pathnames "std.asd" "lisp/std/")))
    5.27-(asdf:load-system :std)
    5.28-
    5.29-(defpackage :x
    5.30-  (:use :cl :std :std/named-readtables :cl-user)
    5.31-  (:export :*core-path* :*lisp-path* :*lib-path* :*std-path* :*ffi-path* :*stash-path* :*web-path* :*bin-path*
    5.32-           :*compression-level*))
    5.33-
    5.34-(in-package :x)
    5.35-(use-package :sb-gray)
    5.36-;; (require 'sb-aclrepl)
    5.37-(sb-ext:enable-debugger)
    5.38-(defvar *core-path* (directory-namestring #.(or *load-truename* *compile-file-truename* (error "run me as an executable!"))))
    5.39-
    5.40-(defvar *lisp-path* (merge-pathnames "lisp/" *core-path*))
    5.41-(defvar *bin-path* (merge-pathnames "bin/" *lisp-path*))
    5.42-(defvar *web-path* (merge-pathnames "web/" *lisp-path*))
    5.43-(defvar *lib-path* (merge-pathnames "lib/" *lisp-path*))
    5.44-(defvar *std-path* (merge-pathnames "std/" *lisp-path*))
    5.45-(defvar *ffi-path* (merge-pathnames "ffi/" *lisp-path*))
    5.46-(defvar *stash-path* (merge-pathnames ".stash/" *core-path*))
    5.47-
    5.48-(defvar *compression-level* nil)
    5.49-
    5.50-(push *core-path* asdf:*central-registry*)
    5.51-(push *lisp-path* ql:*local-project-directories*)
    5.52-(push *lib-path* ql:*local-project-directories*)
    5.53-(push *bin-path* ql:*local-project-directories*)
    5.54-(push *ffi-path* ql:*local-project-directories*)
    5.55-
    5.56-(ql:register-local-projects)
    5.57-
    5.58-(unless (asdf:find-system :log nil)
    5.59-  (asdf:load-asd (probe-file (merge-pathnames "log/log.asd" *lib-path*))))
    5.60-
    5.61-(asdf:load-system :log)
    5.62-(use-package :log)
    5.63-
    5.64-(unless (asdf:find-system :rocksdb nil)
    5.65-  (asdf:load-asd (probe-file (merge-pathnames "rocksdb/rocksdb.asd" *ffi-path*)))
    5.66-  (asdf:load-system :rocksdb))
    5.67-
    5.68-(unless (asdf:find-system :cli nil)
    5.69-  (asdf:load-asd (probe-file (merge-pathnames "cli/cli.asd" *lib-path*))))
    5.70-
    5.71-(asdf:load-system :cli)
    5.72-(use-package :cli)
    5.73-
    5.74-(defun done () (print :OK))
    5.75-
    5.76-(defmethod asdf:perform ((o asdf:image-op) (c asdf:system))
    5.77-  (uiop:dump-image (merge-pathnames (car (last (std::ssplit #\/ (asdf:component-name c)))) *stash-path*) :executable t :compression *compression-level*))
    5.78-
    5.79-(defun compile-std (&optional force save)
    5.80-  (ql:quickload :std)
    5.81-  (when save
    5.82-    (in-package :std-user)
    5.83-    (sb-ext:save-lisp-and-die (merge-pathnames "std.core" *stash-path*) :compression *compression-level*)))
    5.84-
    5.85-(defun compile-prelude (&optional force save)
    5.86-  ;; (compile-std)
    5.87-  (asdf:compile-system :prelude :force force)
    5.88-  (asdf:load-system :prelude :force force)
    5.89-  ;; (rocksdb:load-rocksdb save)
    5.90-  (when save
    5.91-    (in-package :std-user)
    5.92-    (use-package :cl-user)
    5.93-    (sb-ext:save-lisp-and-die (merge-pathnames "prelude.core" *stash-path*) :compression *compression-level*)))
    5.94-
    5.95-(defun compile-user (&optional force save compression (name "user.core"))
    5.96-  (asdf:compile-system :user :force force)
    5.97-  (asdf:load-system :user :force force)
    5.98-  (when save
    5.99-    (in-package :user)
   5.100-    (use-package :cl-user)
   5.101-    (sb-ext:save-lisp-and-die (merge-pathnames name *stash-path*) :compression (or compression *compression-level*))))
   5.102-
   5.103-
   5.104-(defun compile-tests (&optional force save)
   5.105-  (asdf:compile-system :core/tests :force force)
   5.106-  (asdf:load-system :core/tests :force force)
   5.107-  (when save
   5.108-    (in-package :core/tests)
   5.109-    (sb-ext:save-lisp-and-die (merge-pathnames "tests.core" *stash-path*) :compression *compression-level*)))
   5.110-
   5.111-(defun compile-core (&optional force save)
   5.112-  (asdf:compile-system :core :force force)
   5.113-  (asdf:load-system :core :force force)
   5.114-  (when save
   5.115-    (in-package :core)
   5.116-    (sb-ext:save-lisp-and-die (merge-pathnames "core.core" *stash-path*) :compression *compression-level*)))
   5.117-
   5.118-(defun save-foreign (name exports &rest args)
   5.119-  (apply #'sb-ext:save-lisp-and-die name (append `(:executable nil :callable-exports ,exports) args)))
   5.120-
   5.121-(sb-alien:define-alien-callable compile-prelude sb-alien:void () (compile-prelude))
   5.122-(sb-alien:define-alien-callable compile-std sb-alien:void () (compile-std))
   5.123-(sb-alien:define-alien-callable compile-user sb-alien:void () (compile-user))
   5.124-
   5.125-(defvar *thunk* nil)
   5.126-
   5.127-(setq *print-level* 32
   5.128-      *print-length* 64)
   5.129-;; collect args from shell
   5.130-(defvar *args* (cdr sb-ext:*posix-argv*))
   5.131-(defvar *flags*
   5.132-  '((version "0.1.0")
   5.133-    (help "x.lisp --- core build tool
   5.134-x.lisp [CMD]
   5.135-CMDS:
   5.136-test
   5.137-compile
   5.138-build
   5.139-make
   5.140-test
   5.141-run
   5.142-save
   5.143-install")))
   5.144-
   5.145-(defun getflag (k)
   5.146-  (cadar
   5.147-   (member
   5.148-    (string-upcase k)
   5.149-    *flags*
   5.150-    :test #'string=
   5.151-    :key #'car)))
   5.152-
   5.153-(defun bail (msg)
   5.154-  (log::fatal! msg))
   5.155-
   5.156-(defun parse-flag (arg)
   5.157-  (flet ((f (k)
   5.158-           (if (or (characterp k) (= (length k) 1))
   5.159-               (case (char-downcase (character k))
   5.160-                 (#\v "VERSION")
   5.161-                 (#\h "HELP"))
   5.162-               k)))
   5.163-    (if (char-equal (aref arg 0) #\-)
   5.164-        (if (= (length arg) 2) ;; short
   5.165-            (f (aref arg 1))
   5.166-            (if (char-equal (aref arg 1) #\-) ;; long
   5.167-                (f (subseq arg 2))
   5.168-                (bail "invalid flag"))))))
   5.169-
   5.170-;; (defun parse-arg (arg))
   5.171-(defun x-compile (args)
   5.172-  (if args
   5.173-      (let ((name (car args)))
   5.174-        (ql:quickload name)
   5.175-        (asdf:compile-system name :force t))
   5.176-      (compile-prelude t nil)))
   5.177-
   5.178-(defun %build (name)
   5.179-  (format t "saving ~A to: ~A~%" name (merge-pathnames name *stash-path*))
   5.180-  (let ((sys (sb-int:keywordicate (format nil "BIN/~A" (string-upcase name)))))
   5.181-    (ql:quickload sys)
   5.182-    (push :ssl *features*)
   5.183-    ;; (std/sys:forget-shared-objects)
   5.184-    (asdf:make sys)))
   5.185-
   5.186-(defun x-build (args)
   5.187-  (if args
   5.188-      (let ((name (car args)))
   5.189-        (ensure-directories-exist *stash-path*)
   5.190-        (%build name))
   5.191-      (std:wait-for-threads (mapcar
   5.192-                             (lambda (x)
   5.193-                               (sb-thread:make-thread
   5.194-                                (lambda ()
   5.195-                                  (sb-ext:run-program "x.lisp" (list "build" x) :wait t :output t))
   5.196-                                :name x))
   5.197-                             (list "skel" "rdb" "organ" "homer" "packy")))))
   5.198-
   5.199-(defun stash-output (name)
   5.200-  (let* ((sys (asdf:find-system name))
   5.201-         (fasl (make-pathname
   5.202-                :name (asdf/system:component-build-pathname sys)
   5.203-                :type (if (string-equal name "std")
   5.204-                          "lisp"
   5.205-                          "fasl"))))
   5.206-    (uiop:rename-file-overwriting-target
   5.207-     (merge-pathnames fasl (asdf:system-source-directory sys))
   5.208-     (merge-pathnames fasl *stash-path*))))
   5.209-
   5.210-(defun %make (name)
   5.211-  (let ((sys (sb-int:keywordicate (string-upcase name))))
   5.212-    (std/sys:forget-shared-objects)
   5.213-    (asdf:load-system sys)
   5.214-    (in-package :std-user)
   5.215-    (asdf:make sys)
   5.216-    (stash-output sys)
   5.217-    (println :OK)))
   5.218-
   5.219-(defun x-make (args)
   5.220-  (if args
   5.221-      (let ((name (car args)))
   5.222-        (ensure-directories-exist *stash-path*)
   5.223-        (%make name))
   5.224-      (std:wait-for-threads (mapcar
   5.225-                             (lambda (x)
   5.226-                               (sb-thread:make-thread
   5.227-                                (lambda ()
   5.228-                                  (sb-ext:run-program "x.lisp" (list "make" x) :wait t :output t))
   5.229-                                :name x))
   5.230-                             (list "core" "user" "prelude" "core/tests" "core/bench" "core/lib" "core/ffi")))))
   5.231-
   5.232-(defun x-save (args)
   5.233-  (if args
   5.234-      (let ((name (car args)))
   5.235-        (ensure-directories-exist *stash-path*)
   5.236-        (format t "saving core to: ~A~%" (merge-pathnames name *stash-path*))
   5.237-        (string-case (name)
   5.238-          ("prelude" (compile-prelude t t))
   5.239-          ("core" (compile-core t t))
   5.240-          ("std" (compile-std t t))
   5.241-          ("user" (compile-user t t))
   5.242-          ("infra" (compile-user t t 22 "infra.core"))
   5.243-          ("tests" (compile-tests t t))))
   5.244-      ;; (sb-ext:run-program "x.lisp" nil :input t :output t)
   5.245-      ))
   5.246-
   5.247-(asdf:load-asd (probe-file (merge-pathnames "log.asd" "lisp/lib/log/")))
   5.248-(asdf:load-asd (probe-file (merge-pathnames "rt.asd" "lisp/lib/rt/")))
   5.249-(asdf:load-system :log)
   5.250-(asdf:load-system :rt)
   5.251-(ql:quickload :rt)
   5.252-
   5.253-(defun x-test (args)
   5.254-  (if args
   5.255-      (let ((name (car args)))
   5.256-        (ql:quickload :rt)
   5.257-        (ql:quickload (string-upcase (format nil "~A/tests" name)))
   5.258-        (rt:do-tests (string-upcase name) t))
   5.259-      (bail "missing arg")))
   5.260-
   5.261-(defun x-run (args)
   5.262-  (if args
   5.263-      (let* ((name (car args))
   5.264-             (path (merge-pathnames name *stash-path*)))
   5.265-        (unless (probe-file path)
   5.266-          (sb-ext:run-program "x" (list "build" name) :wait t :output t))
   5.267-        (sb-ext:run-program path (cdr args) :output t))
   5.268-      (bail "missing arg")))
   5.269-
   5.270-(defun %install (name)
   5.271-  (let ((path (merge-pathnames name *stash-path*)))
   5.272-    (unless (probe-file path)
   5.273-      (sb-ext:run-program "x" (list "build" name) :wait t :output t))
   5.274-    (sb-ext:run-program "/bin/sudo"
   5.275-                        (list "install" "-C" "-m" "755" (namestring path) "/usr/local/bin/")
   5.276-                        :input t
   5.277-                        :wait t
   5.278-                        :output t)
   5.279-    (format t "installed ~A to ~A~%" name (merge-pathnames name "/usr/local/bin/"))))
   5.280-
   5.281-(defun x-install (args)
   5.282-  (mapc #'%install
   5.283-        (or args
   5.284-            (list "skel" "rdb" "organ" "homer" "packy"))))
   5.285-
   5.286-(defun x-parse-args ()
   5.287-  (if (null *args*)
   5.288-      (progn
   5.289-        (println "Welcome to CORE/X")
   5.290-        (use-package :cl-user)
   5.291-        (use-package :sb-ext)
   5.292-        (use-package :std-user)
   5.293-        (sb-impl::toplevel-repl nil))
   5.294-      (let ((cmd (pop *args*)))
   5.295-        (cond
   5.296-          ((equal cmd "compile") (setq *thunk* #'x-compile))
   5.297-          ((equal cmd "build") (setq *thunk* #'x-build))
   5.298-          ((equal cmd "run") (setq *thunk* #'x-run))
   5.299-          ((equal cmd "test") (setq *thunk* #'x-test))
   5.300-          ((equal cmd "save") (setq *thunk* #'x-save))
   5.301-          ((equal cmd "make") (setq *thunk* #'x-make))
   5.302-          ((equal cmd "install") (setq *thunk* #'x-install))
   5.303-          (t (princ (getflag (parse-flag cmd))) (terpri) (sb-ext:exit :code 0))))))
   5.304-
   5.305-(defun x-init ()
   5.306-  (in-package :x)
   5.307-  (let ((*args* (cdr sb-ext:*posix-argv*))
   5.308-        (*log-level* :info))
   5.309-    (x-parse-args)
   5.310-    (log:debug! "running command" *thunk* *args*)
   5.311-    (funcall *thunk* *args*)))
   5.312-
   5.313-;; (format t "saving self to ./x~%")
   5.314-;; (sb-ext:save-lisp-and-die
   5.315-;;  "x"
   5.316-;;  :toplevel #'x-init
   5.317-;;  ;; :callable-exports '("compile_std" "compile_prelude")
   5.318-;;  :purify nil
   5.319-;;  :executable t
   5.320-;; :save-runtime-options t)
   5.321-
   5.322-(x-init)