changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra / autogen.lisp

changeset 295: 61f88f16e0f1
parent: 9c37db8ed167
child: 310cc699f766
author: Richard Westhaver <ellis@rwest.io>
date: Wed, 19 Jun 2024 22:38:17 +0000
permissions: -rw-r--r--
description: autogen updates 
     1 ;;; autogen.lisp --- Auto-generate CC Infrastructure
     2 
     3 ;; This script must be ran with a compliant CC lisp core image from a complian
     4 ;; CC lisp compiler. The easiest way to get started is by running the
     5 ;; 'bootstrap.sh' script first which will download these for you into the
     6 ;; local 'STASH' directory and run this script automatically.
     7 
     8 #|
     9 # download pre-compiled binaries and run autogen.lisp
    10 ./bootstrap.sh 
    11 
    12 # or run manually with local lisp runtime and core
    13 sbcl --core $LISP_HOME/user.core --script autogen.lisp \
    14 --eval "(infra/autogen:autogen)"
    15 |#
    16 
    17 ;;; Code:
    18 (in-package :std-user)
    19 
    20 (defpkg :infra/autogen
    21   (:use :cl :skel :log :std/named-readtables
    22         :dat/json :dat/sxp :net/fetch :net/util
    23         :cli/progress :cli/ansi :cli/ed :cli/prompt
    24         :cli/shell :std/hash-table :std/alien :std/macs
    25         :std/fmt)
    26   (:export :autogen))
    27 
    28 (in-package :infra/autogen)
    29 (in-readtable :shell)
    30 ;;; Vars
    31 (defvar *all-features*
    32   (list :default :org :demo :emacs-mini :ts :ts-langs :rust-tools :quicklisp :pod :box :packy))
    33 
    34 (defparameter *profile* (uiop:read-file-forms
    35                          (if-let ((profile (sb-posix:getenv "INFRA_PROFILE")))
    36                                  (probe-file profile)
    37                                  (when-let ((default (probe-file "default.sxp")))
    38                                            (sb-posix:setenv "INFRA_PROFILE" (namestring default) 1)
    39                                            default))))
    40 (defparameter *host* (uiop:read-file-forms
    41                       (let ((hcfg (format nil "~a.sxp" (sb-unix:unix-gethostname))))
    42                         (unless (probe-file hcfg)
    43                           (print #0$./check.sh$#))
    44                         hcfg)))
    45 (defparameter *host-env* (let ((table (make-hash-table :test 'equal))
    46                                (keys (list "STASH" "STORE" "DIST" "PACKY_URL" "VC_URL" "INSTALL_PREFIX"
    47                                            "CC" "AR" "HG" "GIT" "LISP" "RUSTC" "LD" "SHELL" "DEV" "DEV_HOME"
    48                                            "DEV_ID" "WORKER" "WORKER_ID" "WORKER_HOME" "CARGO_HOME" "RUSTUP_HOME"
    49                                            "LISP_HOME" "INFRA_PROFILE" "LOG_LEVEL")))
    50                            (dolist (k keys table)
    51                              (setf (gethash k table) (sb-posix:getenv k)))))
    52 
    53 ;;; Utils
    54 (defun gethost (k) (getf *host* k))
    55 (defun getprofile (k) (getf *profile* k))
    56 
    57 (defun getenv (k) (gethash *host-env* k))
    58 
    59 (defun setenv (k v)
    60   (sb-posix:setenv k v 1)
    61   (setf (gethash k *host-env*) v))
    62 
    63 (defmacro setenv* (&rest forms)
    64   `(progn
    65      ,@(loop for (k v) on forms by #'cddr while v
    66              collect `(setenv ,k (or ,v "")))))
    67 
    68 (defmacro check-err (is-warn ctrl &rest args)
    69   `(if ,is-warn
    70        (warn 'simple-warning 
    71              :format-control ,ctrl
    72              :format-arguments (list ,@args))
    73        (std:simple-program-error
    74         ,ctrl
    75         ,@args)))
    76 
    77 (defun setenv-exe (k v &optional warn)
    78   (if-let ((path (cli:find-exe v)))
    79           (setenv k (namestring path))
    80           (check-err warn "~A not found: ~A" k v)))
    81 
    82 (defun setenv-probe (k v &optional warn)
    83   (if-let ((path (probe-file v)))
    84           (setenv k (namestring path))
    85           (check-err warn "~A not found: ~A" k v)))
    86 
    87 (defun check-shared-lib (name &optional warn)
    88   "Check for a shared library by loading it in the current session with dlopen.
    89 When WARN is non-nil, signal a warning instead of an error."
    90   (let ((local-lib-name (format nil "/usr/local/lib/lib~a.so" name))
    91         (sys-lib-name (format nil "/usr/lib/lib~a.so" name)))
    92     (if-let ((lib (or (ignore-errors (sb-alien:load-shared-object local-lib-name))
    93                       (ignore-errors (sb-alien:load-shared-object sys-lib-name)))))
    94             (unwind-protect (format t "found shared lib: ~A~%" lib)
    95               (sb-alien:unload-shared-object lib))
    96             (check-err warn "shared library missing in /usr/lib/ or /usr/local/lib/: ~x" name))))
    97 
    98 (defun check-exe (name &optional warn)
    99   "Check for an executable in current $PATH by NAME. When WARN is non-nil, signal
   100 a warning instead of an error."
   101   (if-let ((bin (cli:find-exe name)))
   102           (progn (format t "found executable: ~A~%" bin) t)
   103           (check-err warn "executable missing: ~x" name)))
   104 
   105 (defun check-default ()
   106   (check-shared-lib "rocksdb")
   107   (check-shared-lib "uring")
   108   (check-shared-lib "zstd")
   109   (check-shared-lib "tree-sitter")
   110   (check-shared-lib "xkbcommon"))
   111 
   112 (defun check-org ()
   113   (check-exe "emacs" t))
   114 
   115 (defun check-pod ()
   116   (check-exe "podman"))
   117 
   118 (defun check-box ()
   119   (check-exe "qemu-system-x86_64"))
   120 
   121 (defun check-all ()
   122   (check-default)
   123   (check-org)
   124   (check-pod)
   125   (check-box))
   126 
   127 (defun check-feature (name)
   128   "Dispatch a host check based on feature NAME."
   129   (case name
   130     (:default (check-default))
   131     (:org (check-org))
   132     (:pod (check-pod))
   133     (:box (check-box))
   134     (:all (check-all))
   135     (t (warn "unsupported feature: ~A" name))))
   136 
   137 (defun getpro-else (k else) (or (getprofile k) else))
   138 
   139 ;;; Config
   140 (defun init-profile ()
   141   (info! "initializing profile...")
   142   (let* ((packy-url (uri:uri (getpro-else :packy-url "https://packy.compiler.company")))
   143          (vc-url (uri:uri (getpro-else :packy-url "https://vc.compiler.company")))
   144          (ar (getpro-else :ar "tar"))
   145          (git (getpro-else :git "git"))
   146          (hg (getpro-else :hg "hg"))
   147          (cc (getpro-else :cc "clang"))
   148          (ld (getpro-else :ld "lld"))
   149          (install-prefix (getpro-else :install-prefix "/usr/local"))
   150          (stash (getpro-else :stash ".stash"))
   151          (store (getpro-else :store (namestring (merge-pathnames "share/store" stash))))
   152          (dist (getpro-else :dist (namestring (merge-pathnames "dist" store))))
   153          (lisp (getpro-else :lisp (lisp-implementation-type)))
   154          (lisp-version (getpro-else :lisp-version (lisp-implementation-version)))
   155          (log-level (getprofile :log-level))
   156          (lisp-home (getprofile :lisp-home))
   157          (quicklisp-home (getprofile :quicklisp-home))
   158          (rustc (getpro-else :rustc "rustc"))
   159          (rust-home (getprofile :rust-home))
   160          (rustup-home (getprofile :rustup-home))
   161          (cargo-home (getprofile :cargo-home))
   162          (features (getprofile :features)))
   163     (setq *log-level* log-level)
   164     (when (log:trace-p)
   165       (trace! "env before update:")
   166       (loop for k being the hash-key
   167             using (hash-value v) of *host-env*
   168             do (format t "  ~A = ~A~%" k (or v ""))
   169             finally (terpri)))
   170     (setenv-probe "STASH" stash t)
   171     (setenv-probe "STORE" store t)
   172     (setenv-probe "DIST" dist t)
   173     (setenv-probe "INSTALL_PREFIX" install-prefix)
   174     (setenv-exe "CC" cc)
   175     (setenv-exe "LD" ld)
   176     (setenv-exe "AR" ar)
   177     (setenv-exe "GIT" git)
   178     (setenv-exe "HG" hg)
   179     (setenv-exe "RUSTC" rustc t)
   180     (setenv-exe "LISP" lisp t)
   181     (setenv*
   182      "PACKY_URL" (uri:uri-to-string packy-url)
   183      "VC_URL" (uri:uri-to-string vc-url)
   184      "LISP_VERSION" lisp-version
   185      "LISP_HOME" lisp-home
   186      "QUICKLISP_HOME" quicklisp-home
   187      "RUST_HOME" rust-home
   188      "RUSTUP_HOME" rustup-home
   189      "CARGO_HOME" cargo-home
   190      "INSTALL_PREFIX" install-prefix
   191      "LOG_LEVEL" (symbol-name log-level))
   192     (terpri)
   193     ;; process features
   194     (loop for f in features
   195           do (progn
   196                (format t "checking host for feature: ~A~%" f)
   197                (check-feature f)
   198                (terpri)))))
   199 
   200 (defun init-host ()
   201   )
   202 
   203 ;;; Build
   204 (defun make-default ()
   205   (std/thread:wait-for-threads
   206    (list (sb-thread:make-thread (lambda () (sk-call* *skel-project* :repos)) :name "repos")))
   207   (std/thread:wait-for-threads
   208    (list
   209     (sb-thread:make-thread (lambda () (vc:run-hg-command "clone" (list ".stash/src/core.hg" ".stash/src/core")))
   210                            :name "core")
   211     (sb-thread:make-thread (lambda () (vc:run-hg-command "clone" (list ".stash/src/home.hg" ".stash/src/home")))
   212                            :name "home")
   213     (sb-thread:make-thread (lambda () (vc:run-hg-command "clone" (list ".stash/src/etc.hg" ".stash/src/etc")))
   214                            :name "etc"))))
   215 
   216 (defun make-pods ()
   217   (vc:run-hg-command "clone" (list ".stash/src/pod.hg" ".stash/src/pod"))
   218   (std/thread:wait-for-threads
   219    (list (sb-thread:make-thread (lambda () (sk-call* *skel-project* :archlinux :box)))
   220          (sb-thread:make-thread (lambda () (sk-call* *skel-project* :alpine :worker))))))
   221 
   222 (defun make-boxes ()
   223   (vc:run-hg-command "clone" (list ".stash/src/box.hg" ".stash/src/box")))
   224 
   225 (defun make-packy ()
   226   (sk-call* *skel-project* :packy-repos))
   227 
   228 (defun make-org ()
   229   (vc:run-hg-command "clone" (list ".stash/src/org.hg" ".stash/src/org")))
   230 
   231 (defun make-demo ()
   232   (vc:run-hg-command "clone" (list ".stash/src/demo.hg" ".stash/src/demo")))
   233 
   234 (defun make-quicklisp ()
   235   (sk-call *skel-project* :quicklisp))
   236 
   237 (defun make-emacs-mini ()
   238   (sk-run (sk-find-script "install-emacs-mini-pack" *skel-project*)))
   239 
   240 (defun make-ts ()
   241   (sk-call *skel-project* :tree-sitter))
   242 
   243 (defun make-ts-langs ()
   244   (sk-call *skel-project* :tree-sitter-langs))
   245 
   246 (defun autogen ()
   247   (info! (machine-version)
   248          "starting autogen...")
   249   (in-readtable :shell)
   250   (terpri)
   251   (init-profile)
   252   (init-host)
   253   (init-skel-vars)
   254   (setq *skel-project* (find-skelfile *default-pathname-defaults* :load t))
   255   (unless (probe-file #p".stash")
   256     (sk-call* *skel-project* :bootstrap))
   257   (terpri)
   258   ;; print post-init info
   259   (when (log:info-p)
   260     (log:info! "")
   261     (format t "lisp: ~A ~A~%"(lisp-implementation-type) (lisp-implementation-version))
   262     (terpri)
   263     (format t "core: ~A~%" sb-ext:*core-pathname*)
   264     (terpri)
   265     (println "host:")
   266     (loop for (k v) on *host* by 'cddr
   267           do (format t "  ~A = ~A~%" k v))
   268     (terpri)
   269     (println "profile:")
   270     (loop for (k v) on *profile* by 'cddr
   271           do (format t "  ~A = ~A~%" k v))
   272     (terpri)
   273     (println "env:")
   274     (loop for k being the hash-key
   275           using (hash-value v) of *host-env*
   276           do (format t "  ~A = ~A~%" k (or v ""))))
   277   ;; process all features
   278   (let ((features (getprofile :features)))
   279     (when (member :all features) (setf features *all-features*))
   280     (when (member :default features) (make-default))
   281     (std/thread:wait-for-threads
   282      (std:flatten
   283       (list
   284        (when (member :org features) (sb-thread:make-thread #'make-org :name "org"))
   285        (when (member :pod features) (sb-thread:make-thread #'make-pods :name "pod"))
   286        (when (member :quicklisp features) (sb-thread:make-thread #'make-quicklisp :name "quicklisp"))
   287        (when (member :emacs-mini features) (sb-thread:make-thread #'make-emacs-mini :name "emacs-mini"))
   288        (when (member :ts features) (sb-thread:make-thread #'make-ts :name "ts"))
   289        (when (member :ts-langs features) (sb-thread:make-thread #'make-ts-langs :name "ts-langs"))
   290        (when (member :box features) (sb-thread:make-thread #'make-boxes :name "box"))
   291        (when (member :packy features) (sb-thread:make-thread #'make-packy :name "packy")))))))