bournish: Prevent inlining of run-time support procedures.
authorLudovic Courtès <ludo@gnu.org>
Thu, 2 Apr 2020 12:17:36 +0000 (14:17 +0200)
committerLudovic Courtès <ludo@gnu.org>
Thu, 2 Apr 2020 14:07:08 +0000 (16:07 +0200)
On Guile 3, those procedures could be inlined, leading to
unbound-variable errors:

  scheme@(guile-user)> ,bournish
  Welcome to Bournish, a minimal Bourne-like shell!
  To switch back, type `,L scheme'.
  bournish@(guile-user)> ls
  ice-9/boot-9.scm:1669:16: In procedure raise-exception:
  Unbound variable: ls-command-implementation

Reported by Ricardo Wurmus.

* guix/build/bournish.scm (define-command-runtime): New macro.
(ls-command-implementation, wc-command-implementation)
(wc-l-command-implementation, wc-c-command-implementation): Use it
instead of 'define'.

guix/build/bournish.scm

index 247a687..31fc493 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
@@ -83,7 +83,21 @@ TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
       (newline)
       (loop (map 1+ indexes)))))
 
-(define ls-command-implementation
+(define-syntax define-command-runtime
+  (syntax-rules ()
+    "Define run-time support of a Bournish command.  This macro ensures that
+the implementation is not subject to inlining, which would prevent compiled
+code from referring to it via '@@'."
+    ((_ (command . args) body ...)
+     (define-command-runtime command (lambda args body ...)))
+    ((_ command exp)
+     (begin
+       (define command exp)
+
+       ;; Prevent inlining of COMMAND.
+       (set! command command)))))
+
+(define-command-runtime ls-command-implementation
   ;; Run-time support procedure.
   (case-lambda
     (()
@@ -173,13 +187,13 @@ TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
                 (call-with-input-file file lines+chars)))
               (format #t "~a ~a~%" chars file)))
 
-(define (wc-command-implementation . files)
+(define-command-runtime (wc-command-implementation . files)
   (for-each wc-print (filter file-exists?* files)))
 
-(define (wc-l-command-implementation . files)
+(define-command-runtime (wc-l-command-implementation . files)
   (for-each wc-l-print (filter file-exists?* files)))
 
-(define (wc-c-command-implementation . files)
+(define-command-runtime (wc-c-command-implementation . files)
   (for-each wc-c-print (filter file-exists?* files)))
 
 (define (wc-command . args)