From patchwork Fri Feb 10 14:29:31 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andrew Whatson X-Patchwork-Id: 46793 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 74D2E165F9; Fri, 10 Feb 2023 21:53:46 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B6824165D1 for ; Fri, 10 Feb 2023 21:53:42 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pQbKd-0002P8-PL; Fri, 10 Feb 2023 16:53:23 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pQWjn-00040c-6B for guix-patches@gnu.org; Fri, 10 Feb 2023 11:59:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pQWjm-00045n-Du for guix-patches@gnu.org; Fri, 10 Feb 2023 11:59:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pQWjm-0001Vo-3y for guix-patches@gnu.org; Fri, 10 Feb 2023 11:59:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#61404] [PATCH] gnu: Add scheme48-prescheme. Resent-From: Andrew Whatson Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 10 Feb 2023 16:59:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 61404 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61404@debbugs.gnu.org Cc: Andrew Whatson X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16760483305781 (code B ref -1); Fri, 10 Feb 2023 16:59:01 +0000 Received: (at submit) by debbugs.gnu.org; 10 Feb 2023 16:58:50 +0000 Received: from localhost ([127.0.0.1]:38000 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pQWjW-0001V3-5X for submit@debbugs.gnu.org; Fri, 10 Feb 2023 11:58:49 -0500 Received: from lists.gnu.org ([209.51.188.17]:37018) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pQUPm-0005I6-Cw for submit@debbugs.gnu.org; Fri, 10 Feb 2023 09:30:17 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pQUPk-00025Q-RV for guix-patches@gnu.org; Fri, 10 Feb 2023 09:30:12 -0500 Received: from sunbury.hosting-cloud.net ([103.146.113.14]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pQUPf-0000V3-JS for guix-patches@gnu.org; Fri, 10 Feb 2023 09:30:12 -0500 X-Mailborder-Info: host=console.hosting-cloud.net, gmt_time=1676039394, scan_time=9.1s X-Mailborder-Spam-Score: 0.8 X-Mailborder-Spam-Report: URIBL_ZEN_BLOCKED_OPENDNS, ALL_TRUSTED, URIBL_DBL_BLOCKED_OPENDNS, SPF_FAIL, DKIM_SIGNED, DKIM_INVALID, MB_DMARC_FAIL, Received: from cp61.hosting-cloud.net (unknown [103.119.110.239]) by smtp.hosting-cloud.net (Postfix) with ESMTPSA id E303D7CFA4 for ; Sat, 11 Feb 2023 01:29:43 +1100 (AEDT) DMARC-Filter: OpenDMARC Filter v1.3.2 smtp.hosting-cloud.net E303D7CFA4 Authentication-Results: console.hosting-cloud.net; dmarc=fail (p=quarantine dis=none) header.from=tailcall.au Authentication-Results: console.hosting-cloud.net; spf=fail smtp.mailfrom=whatson@tailcall.au DKIM-Filter: OpenDKIM Filter v2.11.0 smtp.hosting-cloud.net E303D7CFA4 Authentication-Results: smtp.hosting-cloud.net; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=tailcall.au header.i=@tailcall.au header.b="RBoy0QPr"; dkim-atps=neutral DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tailcall.au ; s=x; h=Content-Transfer-Encoding:Content-Type:MIME-Version:Message-Id:Date: Subject:Cc:To:From:Sender:Reply-To:Content-ID:Content-Description:Resent-Date :Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID:In-Reply-To: References:List-Id:List-Help:List-Unsubscribe:List-Subscribe:List-Post: List-Owner:List-Archive; bh=3eELwKJii6bYLdXvUvdW1dvRRKP7q8Mh6F6oUWVa1E0=; b=R Boy0QPrTNDFFIGARTmLkXrmbhGh6/dWQxosn9fGvlzFJUM8cax+RjzpEwvFmQTVcXLxgs7oG+Gim8 XYSTguycwLT7RGKPVeX9NuEl84zalIP86cCOR8BqkQ9M7G6vFnpI5xZ5E9vWXTwRSSSbgFExFcbHz hk8Rr8FuQnD8fxJxIDdY5JMuNf5LA/LUT+8wxHj0NFx+nXoqJK57h7vAKgxLBQENDxMVz0dhlk/ZZ 1z33pkJrIKyoZyOTo3OQtVTogjj89BElkM5xNuRvE/YK2ppsjlwLlP03M4gbW1wN6FWqOK7IKWDkm qY3OAFirnpaxA9GrYRg25wVgjDoo1O9rA==; Received: from eft1854679.lnk.telstra.net ([101.187.131.186] helo=fumo.fritz.box) by cp61.hosting-cloud.net with esmtpsa (TLS1.3) tls TLS_AES_256_GCM_SHA384 (Exim 4.96) (envelope-from ) id 1pQUPI-001YoX-0C; Sat, 11 Feb 2023 01:29:44 +1100 Date: Sat, 11 Feb 2023 00:29:31 +1000 Message-Id: <20230210142931.8711-1-whatson@tailcall.au> X-Mailer: git-send-email 2.39.1 MIME-Version: 1.0 X-AuthUser: whatson@tailcall.au Received-SPF: pass client-ip=103.146.113.14; envelope-from=whatson@tailcall.au; helo=sunbury.hosting-cloud.net X-Spam_score_int: -16 X-Spam_score: -1.7 X-Spam_bar: - X-Spam_report: (-1.7 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Fri, 10 Feb 2023 11:58:43 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Mailman-Approved-At: Fri, 10 Feb 2023 16:53:18 -0500 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Andrew Whatson X-ACL-Warn: , Andrew Whatson via Guix-patches X-Patchwork-Original-From: Andrew Whatson via Guix-patches via From: Andrew Whatson Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 ;;; Copyright © 2022 jgart ;;; Copyright © 2022 Robby Zambito +;;; Copyright © 2023 Andrew Whatson ;;; ;;; 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")