Re: [PATCH] gnu: Add SBCL.

[Mark H Weaver <mhw@netris.org>]

taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes:

> This wasn't as difficult as I feared but still caused some difficulties.
>
> Most notably, the sb-executable module has been patched in such a way
> that the executables it generates are only guaranteed work as long as
> you still have the SBCL package which generated them in your store.
> After it's garbage-collected, they will fail to run because they will
> try running themselves with the /gnu/store/.../bin/sbcl that was used to
> generate them.  (Also they will contain a #!/.../bin/sh shebang pointing
> to the Bash package that was input to the SBCL version they were
> generated with; that Bash package could get garbage-collected too.)

This is generally how things work in Guix.  Similarly, when you compile
a C program on Guix, the resulting executable depends on the precise
dynamic linker and shared libraries linked in, and will fail if those
are garbage collected.  The solution is to either build things as guix
packages or add an explicit GC root.

> From 13388cb42a79d9a59597b3b8b38c7d65ac2ad68f Mon Sep 17 00:00:00 2001
> From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?=
>  <taylanbayirli@gmail.com>
> Date: Sat, 14 Feb 2015 19:04:12 +0100
> Subject: [PATCH] gnu: Add SBCL.
>
> * gnu/packages/lisp.scm (sbcl): New variable.
> ---
>  gnu/packages/lisp.scm | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++-
>  1 file changed, 88 insertions(+), 1 deletion(-)
>
>
> diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm
> index 26914a6..fe48f41 100644
> --- a/gnu/packages/lisp.scm
> +++ b/gnu/packages/lisp.scm
> @@ -34,7 +34,9 @@
>    #:use-module (gnu packages libffi)
>    #:use-module (gnu packages libffcall)
>    #:use-module (gnu packages readline)
> -  #:use-module (gnu packages libsigsegv))
> +  #:use-module (gnu packages libsigsegv)
> +  #:use-module (gnu packages admin)
> +  #:use-module (gnu packages ed))
>  
>  (define-public gcl
>    (package
> @@ -188,3 +190,88 @@ readline.")
>      ;; a lot of gpl3+.  (Also some parts are under non-copyleft licenses, such
>      ;; as CLX by Texas Instruments.)  In that case gpl3+ wins out.
>      (license license:gpl3+)))
> +
> +(define-public sbcl
> +  (package
> +    (name "sbcl")
> +    (version "1.2.8")
> +    (source
> +     (origin
> +       (method url-fetch)
> +       (uri (string-append "mirror://sourceforge/sbcl/sbcl/" version "/sbcl-"
> +                           version "-source.tar.bz2"))
> +       (sha256
> +        (base32 "0ab9lw056yf6y0rjmx3iirn5n59pmssqxf00fbmpyl6qsnpaja1d"))))
> +    (build-system gnu-build-system)
> +    ;; Bootstrap with CLISP.
> +    (native-inputs
> +     `(("clisp" ,clisp)
> +       ("which" ,which)
> +       ("inetutils" ,inetutils)         ;for hostname(1)
> +       ("ed" ,ed)))
> +    (arguments
> +     '(#:phases
> +       (alist-delete
> +        'configure
> +        (alist-cons-before
> +         'build 'patch-unix-tool-paths
> +         (lambda* (#:key outputs inputs #:allow-other-keys)
> +           (let ((out (assoc-ref outputs "out"))
> +                 (bash (assoc-ref inputs "bash"))
> +                 (coreutils (assoc-ref inputs "coreutils"))
> +                 (ed (assoc-ref inputs "ed")))
> +             (define (quoted-path input path)
> +               (string-append "\"" input path "\""))
> +             ;; Patch absolute paths in string literals.  Note that this
> +             ;; occurs in some .sh files too (which contain Lisp code).
> +             (substitute* (find-files "." "\\.(lisp|sh)$")
> +               (("\"/bin/sh\"") (quoted-path bash "/bin/sh"))
> +               (("\"/usr/bin/env\"") (quoted-path coreutils "/usr/bin/env"))
> +               (("\"/bin/cat\"") (quoted-path coreutils "/bin/cat"))
> +               (("\"/bin/ed\"") (quoted-path ed "/bin/ed"))
> +               (("\"/bin/echo\"") (quoted-path coreutils "/bin/echo"))
> +               (("\"/bin/uname\"") (quoted-path coreutils "/bin/uname")))
> +             ;; This one script has a non-string occurrence of /bin/sh.
> +             (substitute* '("tests/foreign.test.sh")
> +               ;; Leave whitespace so we don't match the shebang.
> +               ((" /bin/sh ") " sh "))
> +             ;; This file contains a module that can create executable files
> +             ;; which depend on the presence of SBCL.  It generates shell
> +             ;; scripts doing "exec sbcl ..." to achieve this.  We patch both
> +             ;; the shebang and the reference to "sbcl", tying the generated
> +             ;; executables to the exact SBCL package that generated them.
> +             (substitute* '("contrib/sb-executable/sb-executable.lisp")
> +               (("/bin/sh") (string-append bash "/bin/sh"))
> +               (("exec sbcl") (string-append "exec " out "/bin/sbcl")))))
> +         (alist-replace
> +          'build
> +          (lambda _
> +            (setenv "CC" "gcc")
> +            ;; Note: this will run tests as well, of which there are 5 total
> +            ;; expected failures: GET-PROTOCOL-BY-NAME/ERROR (because there is
> +            ;; no /etc/protocols file), GETPWUID, GETPWNAM, GETGRID, GETGRNAM
> +            ;; (because certain common users and groups which the tests assume
> +            ;; to exist don't exist in the build environment).  These failures
> +            ;; won't make the build process fail so we just leave them be.
> +            (system* "sh" "make.sh" "clisp"))

Please write (zero? (system* "sh" "make.sh" "clisp")) instead, to detect
errors.  It's possible that this will cause the test failures mentioned
above to cause the build process to fail now.  In that case, those
particular tests will have to be disabled.

> +          (alist-replace
> +           'install
> +           (lambda* (#:key outputs #:allow-other-keys)
> +             (let ((out (assoc-ref outputs "out")))
> +               (setenv "INSTALL_ROOT" out)
> +               (system* "sh" "install.sh")

To detect errors, how about this:

               (unless (zero? (system* "sh" "install.sh"))
                 (error "install.sh failed"))

> +               (wrap-program (string-append out "/bin/sbcl")
> +                 `("SBCL_HOME" = ,(list (string-append out "/lib/sbcl"))))))

It would be preferable to avoid this wrapper.  I looked into this a bit.
It looks like you can pass --prefix=<out> to 'make.sh', and that will
become hardcoded into the executable via SBCL_PREFIX and SBCL_HOME (see
make-config.sh and runtime.c).  It looks like this will also remove the
need to set INSTALL_ROOT (which will be SBCL_PREFIX by default).

Also, if you don't wrap, then the 'install.sh' call will be at the end
and you can avoid the 'unless' and 'error' and just put (zero? (system*
...)) as the last expression.

The one remaining bit that I'm unsure about is 'sbcl-homedir-pathname'
in src/code/filesys.lisp.  If it doesn't work nicely, we might consider
replacing the call to (posix-getenv "SBCL_HOME") with a string literal.

Would you like to try this and see if you run into other problems?

> +           %standard-phases))))
> +       ;; No 'check' target, though "make.sh" (build phase) runs tests.
> +       #:tests? #f))
> +    (home-page "http://www.sbcl.org/")
> +    (synopsis "Common Lisp implementation")
> +    (description "Steel Bank Common Lisp (SBCL) is a high performance Common
> +Lisp compiler.  In addition to the compiler and runtime system for ANSI Common
> +Lisp, it provides an interactive environment including a debugger, a
> +statistical profiler, a code coverage tool, and many other extensions.")
> +    ;; Public domain in jurisdictions that allow it, bsd-2 otherwise.  MIT
> +    ;; loop macro has its own license.  See COPYING file for further notes.
> +    (license (list license:public-domain license:bsd-2
> +                   (license:x11-style "file://src/code/loop.lisp")))))

Can you look into this and send an updated patch?

    Thank you!
       Mark