Subject: [PATCH v4 07/15] gnu: Add chez-nanopass.

From: Philip McGrath <[email-masked]>
Date: Sun, 20 Feb 2022 01:06:02 -0500

* gnu/packages/chez-and-racket-bootstrap.scm (nanopass): Rename to ...
(chez-nanopass-bootstrap): ... this new variable, and promote it from an
origin to a package.
(chez-scheme)[native-inputs]: Add it.
[arguments]<#:phases>: Adapt 'unpack-nanopass+stex'.
(chez-nanopass): New variable.
* gnu/packages/racket.scm
(racket-bootstrap-chez-bootfiles)[native-inputs]: Adapt accordingly.
---
 gnu/packages/chez-and-racket-bootstrap.scm | 96 ++++++++++++++++++----
 gnu/packages/racket.scm                    |  2 +-
 2 files changed, 81 insertions(+), 17 deletions(-)

diff --git a/gnu/packages/chez-and-racket-bootstrap.scm b/gnu/packages/chez-and-racket-bootstrap.scm
index 83bf15b5fb..d66955d50d 100644
--- a/gnu/packages/chez-and-racket-bootstrap.scm
+++ b/gnu/packages/chez-and-racket-bootstrap.scm
@@ -207,9 +207,7 @@ (define-public chez-scheme
       ;; for X11 clipboard support in expeditor:
       ;; https://github.com/cisco/ChezScheme/issues/9#issuecomment-222057232
       libx11))
-    (native-inputs
-     (list nanopass ; source only
-           stex-bootstrap))
+    (native-inputs (list chez-nanopass-bootstrap stex-bootstrap))
     (native-search-paths
      (list (search-path-specification
             (variable "CHEZSCHEMELIBDIRS")
@@ -228,10 +226,12 @@ (define-public chez-scheme
       #:phases
       #~(modify-phases %standard-phases
           (add-after 'unpack 'unpack-nanopass+stex
-            (lambda args
-              (copy-recursively #$nanopass
-                                "nanopass"
-                                #:keep-mtime? #t)
+            (lambda* (#:key native-inputs inputs #:allow-other-keys)
+              (copy-recursively
+               (dirname (search-input-file (or native-inputs inputs)
+                                           "lib/chez-scheme/nanopass.ss"))
+               "nanopass"
+               #:keep-mtime? #t)
               (mkdir-p "stex")
               (with-output-to-file "stex/Mf-stex"
                 (lambda ()
@@ -454,12 +454,76 @@ (define-public stex
     (outputs '("out" "doc"))
     (properties '())))
 
-(define-public nanopass
-  (let ((version "1.9.2"))
-    (origin
-      (method git-fetch)
-      (uri (git-reference
-            (url "https://github.com/nanopass/nanopass-framework-scheme")
-            (commit (string-append "v" version))))
-      (sha256 (base32 "16vjsik9rrzbabbhbxbaha51ppi3f9n8rk59pc6zdyffs0vziy4i"))
-      (file-name (git-file-name "nanopass" version)))))
+(define-public chez-nanopass-bootstrap
+  (hidden-package
+   (package
+     (name "chez-nanopass")
+     (version "1.9.2")
+     (source
+      (origin
+        (method git-fetch)
+        (uri (git-reference
+              (url "https://github.com/nanopass/nanopass-framework-scheme")
+              (commit (string-append "v" version))))
+        (sha256
+         (base32 "16vjsik9rrzbabbhbxbaha51ppi3f9n8rk59pc6zdyffs0vziy4i"))
+        (file-name (git-file-name "nanopass-framework-scheme" version))
+        (snippet
+         #~(begin
+             (use-modules (guix build utils))
+             (when (file-exists? "doc/user-guide.pdf")
+               (delete-file "doc/user-guide.pdf"))
+             (substitute* "doc/Makefile"
+               (("include ~/stex/Mf-stex")
+                "include $(STEXLIB)/Mf-stex"))))))
+     (build-system copy-build-system)
+     (arguments
+      (list #:install-plan
+            #~`(("nanopass.ss" "lib/chez-scheme/")
+                ("nanopass" "lib/chez-scheme/"))))
+     (home-page "https://nanopass.org")
+     (synopsis "DSL for compiler development")
+     (description "The Nanopass framework is an embedded domain-specific
+language for writing compilers composed of several simple passes that
+operate over well-defined intermediate languages.  The goal of this
+organization is both to simplify the understanding of each pass, because it
+is responsible for a single task, and to simplify the addition of new passes
+anywhere in the compiler.  Nanopass reduces the boilerplate required to
+create compilers, making them easier to understand and maintain.")
+     (license license:expat))))
+
+(define-public chez-nanopass
+  (package/inherit chez-nanopass-bootstrap
+    (properties '())
+    ;; TODO: cross-compilation
+    (native-inputs (list chez-scheme stex))
+    (arguments
+     (substitute-keyword-arguments (package-arguments chez-nanopass-bootstrap)
+       ((#:install-plan base-plan)
+        #~`(("nanopass.so" "lib/chez-scheme/")
+            ("doc/user-guide.pdf" #$(string-append
+                                     "share/doc/"
+                                     (package-name this-package)
+                                     "-"
+                                     (package-version this-package)
+                                     "/"))
+            ,@#$base-plan))
+       ((#:phases base-phases #~%standard-phases)
+        #~(modify-phases #$base-phases
+            (add-before 'install 'compile-and-test
+              (lambda args
+                (invoke "scheme"
+                        "--compile-imported-libraries"
+                        "--program" "test-all.ss")))
+            (add-after 'compile-and-test 'build-doc
+              (lambda* (#:key native-inputs inputs #:allow-other-keys)
+                (with-directory-excursion "doc"
+                  (invoke "make"
+                          (string-append "Scheme="
+                                         (search-input-file
+                                          (or native-inputs inputs)
+                                          "/bin/scheme"))
+                          (string-append "STEXLIB="
+                                         (search-input-directory
+                                          (or native-inputs inputs)
+                                          "/lib/stex"))))))))))))
diff --git a/gnu/packages/racket.scm b/gnu/packages/racket.scm
index d8338bcd6f..e8d016c07b 100644
--- a/gnu/packages/racket.scm
+++ b/gnu/packages/racket.scm
@@ -334,7 +334,7 @@ (define-public racket-bootstrap-chez-bootfiles
                        racket-minimal
                        racket-minimal-bc-3m))
         ("stex" ,(package-source stex))
-        ("nanopass" ,nanopass)))
+        ("nanopass" ,(package-source chez-nanopass))))
      (arguments
       `(#:phases
         (modify-phases %standard-phases
-- 
2.32.0