changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra / autogen.lisp

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