Re: On a Guile-based Build-Tool complimenting Guix

[Divya Ranjan <divya@subvertising.org>]

[-- Attachment #1: Type: text/plain, Size: 21234 bytes --]

Hello Oliver,

Thanks for the elaborate response and apologies for a delayed one from me, the holidays have been occupied.

The build system you present looks really interesting. But can you list down exactly how it works and how a developer can use it to build something in Guile using Guix?

Also, have you ever collected any stats on this? I trust you on the "orders of magnitude faster", but since you already have a project using it, if you can report some stats, that'd be nice.

I also read your blogpost from 2022, glad to see that this is something you've been using for 2-3 years, have you settled down on a uniform process? What sort of changes did you make?

From what I see in the code you sent is mostly a way to take care of libraries, defining their inputs, output (.so files) and the flags for the compiler. If you can elaborate or refer to some documentation, that'd be nice!

Regards,

On 19 December 2024 21:33:25 GMT, Olivier Dion <odion@efficios.com> wrote:
>Hi,
>
>For what it is worth, I have been using my own build system purely in
>Guile for a few years now.  I use it in my main project libpatch
>(https://git.sr.ht/~old/libpatch/tree).  It is compatible with the
>gnu-build-system (configure && make && make check && make install), but
>it does not have to if you want to diverge from this flow.
>
>However, it is order of magnitude faster than the autotools stuff.
>Configuration for example is a single Guile instance that may do some
>fork, but not that much.  Building is also fast, althought it would be
>optimal if fibers were available (I use par-map but the bottleneck is
>due to waitpid).  I have plan to add guile-parallel to it instead since
>it is also purely Guile based.
>
>My project is a mix of C, C++ and Guile.  Thus I've only added support
>for these, but I it is possible to extend it since it is base on GOOPS.
>
>It is tested on Ubuntu, Debian, Fedora, Arch Linux and Guix.
>
>Here are some snippets of what it looks like:
>
>project/libpatch/build/libraries.scm (C libraries):
>--8<---------------cut here---------------start------------->8---
>(define-module (project libpatch build libraries)
>  #:use-module ((config) #:prefix conf:)
>  #:use-module (ice-9 match)
>  #:use-module (project build c)
>  #:use-module (project utils list)
>  #:use-module (srfi srfi-26)
>  #:export (libpatch
>            libpatch-ftrace))
>
>(define libpatch-common
>  (c-binary
>   (inputs
>    '("src/lib/libpatch-common/io.c"
>      "src/lib/libpatch-common/read.c"
>      "src/lib/libpatch-common/sleep.c"
>      "src/lib/libpatch-common/write.c"))
>   (cppflags
>    (list
>     (string-append "-I" conf:srcdir "/src/lib/libpatch-common")))
>   (library? #t)
>   (shared? #f)
>   (output "src/lib/libpatch-common.a")))
>
>(define libpatch
>  (c-binary
>   (inputs
>    (cons
>      libpatch-common
>     (cond-list
>         '("src/lib/libpatch/core/address.c"
>           "src/lib/libpatch/core/attr.c"
>           "src/lib/libpatch/core/canon.c"
>           "src/lib/libpatch/core/commit.c"
>           "src/lib/libpatch/core/configure.c"
>           "src/lib/libpatch/core/const.c"
>           "src/lib/libpatch/core/coverage.c"
>           "src/lib/libpatch/core/disable.c"
>           "src/lib/libpatch/core/disasm.c"
>           "src/lib/libpatch/core/drop.c"
>           "src/lib/libpatch/core/dump.c"
>           "src/lib/libpatch/core/dwarf.c"
>           "src/lib/libpatch/core/dynamic.c"
>           "src/lib/libpatch/core/enable.c"
>           "src/lib/libpatch/core/fini.c"
>           "src/lib/libpatch/core/gc.c"
>           "src/lib/libpatch/core/global.c"
>           "src/lib/libpatch/core/init.c"
>           "src/lib/libpatch/core/integrity.c"
>           "src/lib/libpatch/core/last-error.c"
>           "src/lib/libpatch/core/make.c"
>           "src/lib/libpatch/core/olx.c"
>           "src/lib/libpatch/core/panic.c"
>           "src/lib/libpatch/core/patch.c"
>           "src/lib/libpatch/core/resolve.c"
>           "src/lib/libpatch/core/states.c"
>           "src/lib/libpatch/core/thread.c"
>           "src/lib/libpatch/core/tls.c"
>           "src/lib/libpatch/core/trampoline.c"
>           "src/lib/libpatch/core/wxe.c"
>           "src/lib/libpatch/core/page-allocator.c")
>       ((string=? conf:arch "x86_64")
>        "src/lib/libpatch/x86_64/const.c"
>        "src/lib/libpatch/x86_64/disasm.c"
>        "src/lib/libpatch/x86_64/dwarf.c"
>        "src/lib/libpatch/x86_64/dynamic.c"
>        "src/lib/libpatch/x86_64/generic-handlers.S"
>        "src/lib/libpatch/x86_64/init.c"
>        "src/lib/libpatch/x86_64/patch.c"
>        "src/lib/libpatch/x86_64/ret-handlers.S"))))
>   (external-dependencies
>    (list conf:capstone
>          conf:libdw
>          conf:libolx
>          conf:liburcu-bp))
>   (cppflags (list
>              (string-append "-I" conf:srcdir "/src/lib/libpatch")
>              (string-append "-I" conf:srcdir "/src/lib/libpatch-common")
>              (string-append "-I" conf:srcdir "/src/lib/libpatch/" conf:arch "/include")
>              "-DLIBPATCH_CORE"))
>   (cflags '("-fvisibility=hidden"))
>   (libs '("-pthread"))
>   (shared? #t)
>   (library? #t)
>   (output "src/lib/libpatch.so")
>   (install-location conf:libdir)))
>
>(define libpatch-ftrace
>  (c-binary
>   (enabled? conf:build-libpatch-ftrace)
>   (inputs
>    (list
>     libpatch
>     "src/lib/libpatch-ftrace/libpatch-ftrace.c"))
>   (external-dependencies
>    (list conf:lttng-ust))
>   (cppflags
>    (list (string-append "-I" conf:srcdir "/src/lib/libpatch-ftrace")))
>   (cflags (list "-fvisibility=hidden"))
>   (shared? #t)
>   (library? #t)
>   (output "src/lib/libpatch-ftrace.so")
>   (install-location conf:libdir)))
>--8<---------------cut here---------------end--------------->8---
>
>project/libpatch/build/bindings.scm (Guile bindings to Libpatch):
>--8<---------------cut here---------------start------------->8---
>(define-module (project libpatch build bindings)
>  #:use-module ((config) #:prefix conf:)
>  #:use-module (project build)
>  #:use-module (project build guile)
>  #:use-module (project libpatch build libraries)
>  #:export (bindings))
>
>(define guile-go-dir
>  (string-append conf:libdir "/guile/3.0/site-ccache/libpatch"))
>
>(define guile-sources
>  '("src/guile/libpatch/ffi.scm"
>    "src/guile/libpatch/patch.scm"))
>
>(define guile-modules
>  (map
>   (lambda (source)
>     (guile-module
>      (inputs (list source libpatch))
>      (load-paths (list
>                   (string-append
>                    (builddir) "/src/guile")
>                   (string-append
>                    (srcdir) "/src/guile")))
>      (install-location guile-go-dir)))
>   guile-sources))
>
>(define bindings
>  guile-modules)
>--8<---------------cut here---------------end--------------->8---
>
>
>configure (compatible with configure.ac):
>--8<---------------cut here---------------start------------->8---
>#!/bin/sh
>#-*-Scheme-*-
>GUILE="$(command -v guile || command -v guile3.0)"
>
>if [ -z "$GUILE" ]; then
>	echo "Missing guile executable."
>	exit 1
>fi
>
>DIR=$(dirname "$0")
>THIS_PATH=$(realpath "$DIR")
>
>exec $GUILE -L "$THIS_PATH" --no-auto-compile -e main -s "$0" "$@"
>!#
>
>(use-modules
> (ice-9 exceptions)
> (ice-9 match)
> (project configure)
> (project configure config-file)
> (project configure guess)
> (project configure option)
> (project configure package)
> (project configure template-file)
> (project configure toolchain)
> (project configure variable)
> (project file-system search)
> (project progress)
> (project utils colors)
> (srfi srfi-1)
> (srfi srfi-26)
> (system base target))
>
>(define (make-simple-action name value)
>  (lambda* (this-opt _ #:key variables #:allow-other-keys)
>    (let ((var (assoc-ref variables name)))
>      (if var
>          (set-variable-value! var value)
>          (raise-exception
>           (make-exception
>            (make-programming-error)
>            (make-exception-with-irritants name)
>            (make-exception-with-message
>             "Unknown variable")))))))
>
>(define dyninst-allowed? #t)
>(define liteinst-allowed? #t)
>(define lttng-allowed? #t)
>
>(define* (has-dyninst? #:key packages #:allow-other-keys)
>  (and
>   dyninst-allowed?
>   (package-exists?
>    (assoc-ref packages "dyninst"))))
>
>(define* (has-liteinst? #:key packages #:allow-other-keys)
>  (and
>   liteinst-allowed?
>   (package-exists?
>    (assoc-ref packages "liteinst"))))
>
>(define* (has-lttng-ust? #:key packages #:allow-other-keys)
>  (and
>   lttng-allowed?
>   (package-exists?
>    (assoc-ref packages "lttng-ust"))))
>
>(define (support-flags? . flags)
>  (lambda* (#:key variables #:allow-other-keys)
>    (apply
>     toolchain-support-flags?
>     (variable-value (assoc-ref variables "CC"))
>     flags)))
>
>(define libpatch-configuration
>  (configuration
>   (unique-file "dev-env")
>   (arguments (cdr (program-arguments)))
>   (packages
>    (list
>     (package
>       (name "capstone"))
>     (package
>       (name "libdw")
>       (minimum-version "0.158"))
>     (package
>       (name "libolx"))
>     (package
>       (name "liburcu-bp"))
>     (package
>       (name "lttng-ust")
>       (required? #f))
>     (package
>       (name "dyninst")
>       (resolver
>        (lambda (this)
>          (let* ((lib (find-library "libdyninstAPI.so"))
>                 (header (find-header "BPatch.h"))
>                 (exists? (and lib header #t)))
>            (set! (package-exists? this) exists?)
>            (when exists?
>              (set! (package-libs-only-l this) "-ldyninstAPI")
>              (set! (package-libs-only-L this)
>                    (string-append "-L" (dirname lib)))
>              (set! (package-cflags-only-I this)
>                    (string-append "-I" (dirname header)))))))
>       (required? #f))
>     (package
>       (name "liteinst")
>       (resolver
>        (lambda (this)
>          (let* ((lib (find-library "libliteinst.so"))
>                 (header (find-header "liteinst.hpp"))
>                 (exists? (and lib header #t)))
>            (set! (package-exists? this) exists?)
>            (when exists?
>              (set! (package-libs-only-l this) "-lliteinst")
>              (set! (package-libs-only-L this)
>                    (string-append "-L" (dirname lib)))
>              (set! (package-cflags-only-I this)
>                    (string-append "-I" (dirname header)))))))
>       (required? #f))))
>   (variables
>    (append
>     (list
>      (variable
>       (name "LIBPATCH_VERSION")
>       (value "1.0.0"))
>      (variable
>       (name "GUILE_BIN")
>       (value
>        (delay
>          (or
>           (find-binary/progress "guile")
>           (find-binary/progress "guile3.0")
>           (push-error!
>            (make-exception
>             (make-external-error)
>             (make-exception-with-irritants "guile")
>             (make-exception-with-message
>              "missing required binary")))))))
>      (variable
>       (name "GUILD_BIN")
>       (value
>        (delay
>          (or
>           (find-binary/progress "guild")
>           (find-binary/progress "guild3.0")
>           (push-error!
>            (make-exception
>             (make-external-error)
>             (make-exception-with-irritants "guild")
>             (make-exception-with-message
>              "missing required binary")))))))
>      (variable
>       (name "CC")
>       (value (delay (guess-c-toolchain))))
>      (variable
>       (name "CXX")
>       (value (delay (guess-c++-toolchain #:required? #f))))
>      (variable
>       (name "arch")
>       (value (delay (target-cpu))))
>      (variable
>       (name "build-benchmarks")
>       (value #t))
>      (variable
>       (name "tsan-native-benchmarks")
>       (value #f))
>      (variable
>       (name "build-libpatch-ftrace")
>       (value has-lttng-ust?))
>      (variable
>       (name "build-libpatch-coverage")
>       (value #t))
>      (variable
>       (name "build-libpatch-integrity")
>       (value #t))
>      (variable
>       (name "build-manpages")
>       (value
>        (delay (and (find-binary/progress "emacs") #t))))
>      (variable
>       (name "has-man")
>       (value
>        (delay (and (find-binary/progress "man") #t))))
>      (variable
>       (name "manpages-source-highlight")
>       (value
>        (delay (and (find-binary/progress "source-highlight") #t))))
>      (variable
>       (name "has-dyninst")
>       (value has-dyninst?))
>      (variable
>       (name "has-gdb-inproctrace")
>       (value (delay
>                (and (find-binary/progress "gdb")
>                     (find-library "libinproctrace.so")))))
>      (variable
>       (name "has-liteinst")
>       (value has-liteinst?))
>      (variable
>       (name "has-csmith")
>       (value
>        (delay (and (find-binary/progress "csmith") #t))))
>      (variable
>       (name "csmith-include-directory")
>       (value
>        (delay
>          (and=> (find-header "csmith/csmith.h") dirname))))
>      (variable
>       (name "environ")
>       (value (delay (environ)))))
>     %standard-directory-variables))
>   (options
>    (append
>     (list
>      (option
>       (switch "disable-ftrace-build")
>       (synopsis "do no build libpatch-ftrace.so")
>       (action (make-simple-action "build-libpatch-ftrace" #f)))
>      (option
>       (switch "disable-patch-coverage-build")
>       (synopsis "do not build libpatch-coverage.so")
>       (action (make-simple-action "build-libpatch-coverage" #f)))
>      (option
>       (switch "disable-patch-integrity-build")
>       (synopsis "do not build libpatch-integrity.so")
>       (action (make-simple-action "build-libpatch-integrity" #f)))
>      (option
>       (switch "enable-tsan-on-native-benchmarks")
>       (synopsis "enable TSAN for native benchmarks")
>       (action (make-simple-action "tsan-native-benchmarks" #t)))
>      (option
>       (switch "without-manpages")
>       (synopsis "disable manpages generation")
>       (action (make-simple-action "build-manpages" #f)))
>      (option
>       (switch "without-lttng")
>       (synopsis "disable any usage of LTTng")
>       (action (lambda _ (set! lttng-allowed? #f))))
>      (option
>       (switch "without-dyninst")
>       (synopsis "disable any usage of Dyninst for benchmarking")
>       (action (lambda _ (set! dyninst-allowed? #f))))
>      (option
>       (switch "without-liteinst")
>       (synopsis "disable any usage of LiteInst for benchmarking")
>       (action (lambda _ (set! liteinst-allowed? #f))))
>      (option
>       (switch "without-benchmarks")
>       (synopsis "do not compile benchmarks")
>       (action (make-simple-action "build-benchmarks" #f))))
>     %standard-directory-options))
>   (templates
>    (list
>     (template-file
>      (input "aux/Makefile.in")
>      (output "Makefile"))
>     (template-file
>      (input "aux/project-repl.in")
>      (output "project-repl")
>      (mode #o744))
>     (template-file
>      (input "src/lib/pkgconfig/libpatch.pc.in"))
>     (template-file
>      (input "src/bin/patch-ftrace.in")
>      (mode #o744))
>     (template-file
>      (input "src/bin/patch-coverage.in")
>      (mode #o744))
>     (template-file
>      (input "src/bin/patch-integrity.in")
>      (mode #o744))
>     (template-file
>      (input "scripts/debug-test.in")
>      (mode #o744))))
>   (config-files
>    (list
>     (c-config-file
>      (path ".config.h")
>      (namespace "CONFIG_"))
>     (scm-config-file
>      (path "config.scm")
>      (namespace "config"))))
>   (status-file
>    "config.status")))
>
>(define (main args)
>  (with-exception-handler
>      (lambda (exn)
>        (if (eq? 'quit (exception-kind exn))
>            (raise-exception exn)
>            (begin
>              (print-exception (current-error-port)
>                               #f
>                               (exception-kind exn)
>                               (exception-args exn))
>              (primitive-exit EXIT_FAILURE))))
>    (lambda ()
>      (call-with-values
>          (lambda ()
>            (configure libpatch-configuration))
>        (lambda (variables _ errors)
>          (with-nest-progress
>              "features summary"
>              (for-each
>               (match-lambda
>                 ((feature-name . feature-description)
>                  (let ((name+feature (assoc feature-name variables)))
>                    (if name+feature
>                        (progress "~a ~a"
>                                  (if (cdr name+feature)
>                                      (colorize-string "OK" %enabled-color)
>                                      (colorize-string "NO" %disabled-color))
>                                  feature-description)
>                        (raise-exception
>                         (make-exception
>                          (make-exception-with-origin
>                           "Features summary")
>                          (make-programming-error)
>                          (make-exception-with-irritants feature-name)
>                          (make-exception-with-message
>                           "Unknown feature")))))))
>               '(("build-benchmarks" . "compile benchmarks")
>                 ("build-libpatch-ftrace" . "compile libpatch-ftace.so")
>                 ("build-libpatch-coverage" . "compile libpatch-coverage.so")
>                 ("build-libpatch-integrity" . "compile libpatch-integrity.so")
>                 ("build-manpages" . "generate man pages"))))
>          (exit (if (null? errors)
>                    EXIT_SUCCESS
>                    EXIT_FAILURE)))))))
>--8<---------------cut here---------------end--------------->8---
>
>
>On Thu, 19 Dec 2024, Divya Ranjan <divya@subvertising.org> wrote:
>> Hello Guix,
>>
>> The other day, after being frustrated of build systems (auto-tools, meson, maven etc.), I wondered why doesn’t Guix which has such powerful tools within it (`guix build`, `guix pack` etc.) also not have a purely Guile-based build tool? After all, our goal is to make deployment, and building both more declarative and away from the all-too-familiar “dependency hell”.
>>
>> I am not exactly sure how I want to go with this, but I want to extend (if needed) the capabilities of Guix, to allow the developer of a package to use it also to build the package effectively replacing existing build tools. Since we already have build-system, instead of executing make (or whatever other tool) commands from it, we could modify it to itself have all those things that a Makefile would have.
>>
>> The developer would use Guile to declare their build config, I am again not sure what this might exactly look like, but can’t we have it such that we provide the developer with some tools to _declare_ a custom and package-specific build-system in Guile (just like our familiar gnu-build-system), but this is purely in Guile and executes whatever commands, path declarations and other interactions (such as calling gcc) directly from Guile and not by just calling `make`. I haven’t thought through this clearly, but even if this doesn’t work, the main idea I’d like to propose is to fully replace existing build-tools by making a new Guile build tool to work alongside Guix.
>>
>> Ideally, once the developer has a build config ready, one can just wrap it up with a package definition in Guile, just like the ones we create to package something upstream. This package definition can then be used in `guix build -f package.scm` to result in a fully transactional building process that focuses not on getting out of dependency hell, but just declaring your config right. And all of this without having to learn yet another build tool that might disappear, and of course, without leaving the comfortable world of Lisp (Scheme).
>>
>> I was indicated by others that such an idea has previously been conceievd among Guix developers themselves, namely as a GSoC proposal[0]. I couldn’t find if that has progressed towards anything, nor could find anything in the mailing list. I did see Pjotr volunteering to mentor for it, I’ve CC-ed them to see if they’re still interested in such a project. Meanwhile, I’d like input from other Guix core developers on what they think of this, and if they could provide me with some leads on where to go with this.
>>
>>
>> [0]: https://libreplanet.org/wiki/Group:Guix/GSoC-2024
>>
>> Regards,
>> -- 
>> Divya Ranjan,
>> Philosophy, Mathematics, Libre Software.
>>
>-- 
>Olivier Dion
>EfficiOS Inc.
>https://www.efficios.com

Divya Ranjan, Mathematics, Philosophy and Libre Software

[-- Attachment #2: Type: text/html, Size: 22365 bytes --]