GNU bug report logs - #61404
[PATCH] gnu: Add scheme48-prescheme.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 61404 in the body.
You can then email your comments to 61404 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Andrew Whatson <whatson <at> tailcall.au>
To: guix-patches <at> gnu.org
Cc: Andrew Whatson <whatson <at> tailcall.au>
Subject: [PATCH] gnu: Add scheme48-prescheme.
Date: Sat, 11 Feb 2023 00:29:31 +1000

* gnu/packages/scheme.scm (scheme48-prescheme): New variable.
---
 gnu/packages/scheme.scm | 132 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)

diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm
index c13de9d65b..dabd41e32d 100644
--- a/gnu/packages/scheme.scm
+++ b/gnu/packages/scheme.scm
@@ -20,6 +20,7 @@
 ;;; Copyright © 2022 Morgan Smith <Morgan.J.Smith <at> outlook.com>
 ;;; Copyright © 2022 jgart <jgart <at> dismail.de>
 ;;; Copyright © 2022 Robby Zambito <contact <at> robbyzambito.me>
+;;; Copyright © 2023 Andrew Whatson <whatson <at> tailcall.au>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +42,7 @@ (define-module (gnu packages scheme)
   #:use-module ((guix licenses)
                 #:select (gpl2+ lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3+ asl2.0 bsd-3
                           cc-by-sa4.0 non-copyleft expat public-domain))
+  #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix download)
   #:use-module (guix git-download)
@@ -409,6 +411,136 @@ (define-public scheme48
     ;; Most files are BSD-3; see COPYING for the few exceptions.
     (license bsd-3)))
 
+(define-public scheme48-prescheme
+  (package
+    (inherit scheme48)
+    (name "scheme48-prescheme")
+    (arguments
+     (list
+      #:tests? #f ; tests only cover scheme48
+      #:modules '((guix build gnu-build-system)
+                  (guix build utils)
+                  (ice-9 popen)
+                  (srfi srfi-1))
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'configure 'patch-prescheme-version
+            (lambda _
+              ;; Ensure the Pre-Scheme version matches the package version
+              (call-with-output-file "ps-compiler/minor-version-number"
+                (lambda (port)
+                  (let* ((version #$(package-version this-package))
+                         (vparts (string-split version #\.))
+                         (vminor (string-join (drop vparts 1) ".")))
+                    (write vminor port))))))
+          (add-after 'configure 'patch-prescheme-headers
+            (lambda _
+              ;; Rename "io.h" to play nicely with others
+              (copy-file "c/io.h" "c/prescheme-io.h")
+              (substitute* "c/prescheme.h"
+                (("^#include \"io\\.h\"")
+                 "#include \"prescheme-io.h\""))))
+          (add-after 'configure 'generate-pkg-config
+            (lambda _
+              ;; Generate a pkg-config file
+              (call-with-output-file "prescheme.pc"
+                (lambda (port)
+                  (let ((s48-version #$(package-version scheme48))
+                        (version #$(package-version this-package)))
+                    (format port (string-join
+                                  '("prefix=~a"
+                                    "exec_prefix=${prefix}"
+                                    "libdir=${prefix}/lib/scheme48-~a"
+                                    "includedir=${prefix}/include"
+                                    ""
+                                    "Name: Pre-Scheme (Scheme 48)"
+                                    "Description: Pre-Scheme C runtime"
+                                    "Version: ~a"
+                                    "Libs: -L${libdir} -lprescheme"
+                                    "Cflags: -I${includedir}")
+                                  "\n" 'suffix)
+                            #$output s48-version version))))))
+          (add-after 'configure 'generate-prescheme-wrapper
+            (lambda _
+              ;; Generate a wrapper to load and run ps-compiler.image
+              (call-with-output-file "prescheme"
+                (lambda (port)
+                  (let ((s48-version #$(package-version scheme48)))
+                    (format port (string-join
+                                  '("#!/bin/sh"
+                                    "scheme48=~a/lib/scheme48-~a/scheme48vm"
+                                    "prescheme=~a/lib/scheme48-~a/prescheme.image"
+                                    "exec ${scheme48} -i ${prescheme} \"$@\"")
+                                  "\n" 'suffix)
+                            #$scheme48 s48-version #$output s48-version))))
+              (chmod "prescheme" #o755)))
+          (replace 'build
+            (lambda _
+              ;; Build a minimal static library for linking Pre-Scheme code
+              (let ((lib "c/libprescheme.a")
+                    (objs '("c/unix/io.o"
+                            "c/unix/misc.o")))
+                (apply invoke "make" objs)
+                (apply invoke "ar" "rcs" lib objs))
+              ;; Dump a Scheme 48 image with both the Pre-Scheme compatibility
+              ;; library and compiler pre-loaded, courtesy of Taylor Campbell's
+              ;; Pre-Scheme Manual:
+              ;; https://groups.scheme.org/prescheme/1.3/#Invoking-the-Pre_002dScheme-compiler
+              (with-directory-excursion "ps-compiler"
+                (let ((version #$(package-version this-package))
+                      (port (open-pipe* OPEN_WRITE "scheme48")))
+                  (format port (string-join
+                                '(",batch"
+                                  ",config ,load ../scheme/prescheme/interface.scm"
+                                  ",config ,load ../scheme/prescheme/package-defs.scm"
+                                  ",exec ,load load-ps-compiler.scm"
+                                  ",in prescheme-compiler prescheme-compiler"
+                                  ",user (define prescheme-compiler ##)"
+                                  ",dump ../prescheme.image \"(Pre-Scheme ~a)\""
+                                  ",exit")
+                                "\n" 'suffix)
+                          version)
+                  (close-pipe port)))))
+          (replace 'install
+            (lambda _
+              (let* ((s48-version #$(package-version scheme48))
+                     (bin-dir     (string-append #$output "/bin"))
+                     (lib-dir     (string-append #$output "/lib/scheme48-" s48-version))
+                     (pkgconf-dir (string-append #$output "/lib/pkgconfig"))
+                     (share-dir   (string-append #$output "/share/scheme48-" s48-version))
+                     (include-dir (string-append #$output "/include")))
+                ;; Install Pre-Scheme compiler image
+                (install-file "prescheme" bin-dir)
+                (install-file "prescheme.image" lib-dir)
+                ;; Install Pre-Scheme config, headers, and lib
+                (install-file "prescheme.pc" pkgconf-dir)
+                (install-file "c/prescheme.h" include-dir)
+                (install-file "c/prescheme-io.h" include-dir)
+                (install-file "c/libprescheme.a" lib-dir)
+                ;; Install Pre-Scheme sources
+                (copy-recursively "scheme/prescheme"
+                                  (string-append share-dir "/prescheme"))
+                (copy-recursively "ps-compiler"
+                                  (string-append share-dir "/ps-compiler"))
+                ;; Remove files specific to building the Scheme 48 VM
+                (for-each (lambda (file)
+                            (delete-file (string-append share-dir "/" file)))
+                          '("ps-compiler/compile-bibop-gc-32.scm"
+                            "ps-compiler/compile-bibop-gc-64.scm"
+                            "ps-compiler/compile-gc.scm"
+                            "ps-compiler/compile-twospace-gc-32.scm"
+                            "ps-compiler/compile-twospace-gc-64.scm"
+                            "ps-compiler/compile-vm-no-gc-32.scm"
+                            "ps-compiler/compile-vm-no-gc-64.scm"))))))))
+    (propagated-inputs (list scheme48))
+    (home-page "http://s48.org/")
+    (synopsis "Pre-Scheme compiler from Scheme 48")
+    (description
+     "Pre-Scheme is a statically compilable dialect of Scheme, used to implement the
+Scheme 48 virtual machine.  Scheme 48 ships with a Pre-Scheme to C compiler written
+in Scheme, and a runtime library which allows Pre-Scheme code to run as Scheme.")
+    (license bsd-3)))
+
 (define-public gambit-c
   (package
     (name "gambit-c")
-- 
2.39.1

Message #10 received at 61404-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Andrew Whatson <whatson <at> tailcall.au>
Cc: 61404-done <at> debbugs.gnu.org
Subject: Re: bug#61404: [PATCH] gnu: Add scheme48-prescheme.
Date: Mon, 27 Feb 2023 15:14:44 +0100

Hi,

Andrew Whatson <whatson <at> tailcall.au> skribis:

> * gnu/packages/scheme.scm (scheme48-prescheme): New variable.

Applied, thanks!

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.