chez: new recipe (#13913)

* First working version of chez scheme

* Tests all pass

* Use portVersion in SOURCE_URI path

Co-authored-by: Joachim Mairböck <j.mairboeck@gmail.com>

* Apply changes from review comments

* alphabetise dependencies

* remove unnecessary CFLags

* re-add diff and patch as test requirements

Co-authored-by: Joachim Mairböck <j.mairboeck@gmail.com>

* Use system lz4 and zlib
This commit is contained in:
Geoffrey J. Teale
2026-04-08 15:02:34 +02:00
committed by GitHub
parent bccf5d8088
commit 2b3733fd45
2 changed files with 505 additions and 0 deletions

View File

@@ -0,0 +1,82 @@
SUMMARY="Cisco's Chez Scheme compiler and interpreter"
DESCRIPTION="Both a programming language and an implementation of that \
language, with supporting tools and documentation.
As a superset of the language described in the Revised6 Report on the \
Algorithmic Language Scheme (R6RS), Chez Scheme supports all standard \
features of Scheme, including first-class procedures, proper treatment of \
tail calls, continuations, user-defined records, libraries, exceptions, and \
hygienic macro expansion.
Chez Scheme also includes extensive support for interfacing with C and other \
languages, support for multiple threads possibly running on multiple cores, \
non-blocking I/O, and many other features."
HOMEPAGE="https://cisco.github.io/ChezScheme/"
COPYRIGHT="2022 Cisco Systems, Inc."
LICENSE="Apache v2"
REVISION="1"
SOURCE_URI="https://github.com/cisco/ChezScheme/releases/download/v$portVersion/csv$portVersion.tar.gz"
SOURCE_DIR="csv$portVersion"
CHECKSUM_SHA256="d237d9874c6e8b0ccf7758daa8286a6e825528b13ce3b2bca56eb1f73cddbc2c"
PATCHES="chez-$portVersion.patchset"
ARCHITECTURES="x86_64"
PROVIDES="
chez = $portVersion
cmd:petite = $portVersion
cmd:scheme = $portVersion
cmd:scheme_script = $portVersion
"
REQUIRES="
haiku
lib:libiconv
lib:liblz4
lib:libncurses
lib:libz
"
BUILD_REQUIRES="
haiku_devel
devel:libiconv
devel:liblz4
devel:libncurses
devel:libz
"
BUILD_PREREQUIRES="
cmd:gcc
cmd:ld
cmd:make
"
TEST_REQUIRES="
cmd:diff
cmd:patch
"
BUILD()
{
export LZ4=liblz4 ZLIB=libz
./configure --pb
make bootquick XM=ta6hk $jobArgs
./configure --machine=ta6hk \
--threads \
--64 \
--disable-x11 \
--prefix=$prefix \
--installbin=$binDir --installlib=$libDir \
--installman=$manDir --installdoc=$docDir \
--installabsolute \
--as-is
make $jobArgs
}
INSTALL()
{
make install
}
TEST()
{
make test $jobArgs
}

View File

@@ -0,0 +1,423 @@
From 6942d7059b9f02b906f7e7d1a14f77f614683512 Mon Sep 17 00:00:00 2001
From: Geoffrey Teale <geoffrey@teale.de>
Date: Tue, 7 Apr 2026 06:16:18 +0000
Subject: [PATCH] Add machine types and test exceptions for Haiku-OS
---
c/expeditor.c | 2 +-
c/version.h | 32 +++++++++++++++++++++++++++++++-
configure | 15 ++++++++++-----
makefiles/install.zuo | 15 ++++++++++-----
mats/6.ms | 20 ++++++++++++++------
mats/bytevector.ms | 2 +-
mats/date.ms | 8 ++++----
mats/foreign.ms | 10 ++++++++++
mats/io.ms | 21 +++++++++++++++------
mats/mat.ss | 5 +++++
mats/misc.ms | 4 +++-
mats/primvars.ms | 2 +-
mats/unix.ms | 4 ++--
s/cmacros.ss | 1 +
14 files changed, 108 insertions(+), 33 deletions(-)
diff --git a/c/expeditor.c b/c/expeditor.c
index af8428f..4c01510 100644
--- a/c/expeditor.c
+++ b/c/expeditor.c
@@ -762,7 +762,7 @@ static void s_ee_set_color(int color_id, IBOOL background) {
# include <unistd.h>
# include <time.h>
#endif
-#if !defined(__GLIBC__) && !defined(__COSMOPOLITAN__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE)
+#if !defined(__GLIBC__) && !defined(__COSMOPOLITAN__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(__linux__) && !defined(__HAIKU__) && !defined(__EMSCRIPTEN__) && !defined(NO_USELOCALE)
# include <xlocale.h>
#endif
diff --git a/c/version.h b/c/version.h
index 9141e99..f8ae4cc 100644
--- a/c/version.h
+++ b/c/version.h
@@ -141,7 +141,37 @@ typedef int tputsputcchar;
#endif
#endif
-#if defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__DragonFly__)
+#if defined(__HAIKU__)
+#define NOBLOCK O_NONBLOCK
+#define LOAD_SHARED_OBJECT
+#define USE_MMAP
+#define MMAP_HEAP
+#define IEEE_DOUBLE
+#define LDEXP
+#define ARCHYPERBOLIC
+#define GETPAGESIZE() getpagesize()
+typedef char *memcpy_t;
+#define MAKE_NAN(x) { x = 0.0; x = x / x; }
+#define GETWD(x) getcwd((x),PATH_MAX)
+typedef int tputsputcchar;
+#define LOCKF
+#define DIRMARKERP(c) ((c) == '/')
+#ifndef DISABLE_X11
+#define LIBX11 "libX11.so"
+#endif
+#define SECATIME(sb) (sb).st_atime
+#define SECCTIME(sb) (sb).st_ctime
+#define SECMTIME(sb) (sb).st_mtime
+#define NSECATIME(sb) 0
+#define NSECCTIME(sb) 0
+#define NSECMTIME(sb) 0
+#define ICONV_INBUF_TYPE char **
+#define USE_OSSP_UUID
+#endif
+
+
+
+#if defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__DragonFly__)
#define NOBLOCK O_NONBLOCK
#define LOAD_SHARED_OBJECT
#define USE_MMAP
diff --git a/configure b/configure
index e276e49..c19da2b 100755
--- a/configure
+++ b/configure
@@ -143,6 +143,11 @@ case "${CONFIG_UNAME}" in
installprefix=/usr
installmansuffix=share/man
;;
+ Haiku)
+ unixsuffix=hk
+ installprefix=/system
+ installmansuffix=documentation/man
+ ;;
QNX)
if uname -m | egrep 'x86' > /dev/null 2>&1 ; then
m32=i3qnx
@@ -777,7 +782,7 @@ fi
# Infer flags needed for threads:
case "${flagsm}" in
- t*le|t*gnu|t*fb|t*ob|t*nb)
+ t*le|t*gnu|t*fb|t*ob|t*nb|t*hk)
threadFlags="-D_REENTRANT -pthread"
threadLibs="-lpthread"
;;
@@ -887,7 +892,7 @@ fi
# Add automatic linking flags, unless suppressed by --disable-auto-flags
if [ "$addflags" = "yes" ] ; then
case "${flagsm}" in
- *le|*gnu)
+ *le|*gnu|*hk)
LDFLAGS="${LDFLAGS} -rdynamic"
;;
*fb|*nb)
@@ -904,7 +909,7 @@ if [ "$addflags" = "yes" ] ; then
*le|*gnu)
LIBS="${LIBS} -lm -ldl ${ncursesLib} -lrt"
;;
- *fb|*ob)
+ *fb|*ob|*hk)
LIBS="${LIBS} ${iconvLib} -lm ${ncursesLib}"
;;
*nb)
@@ -997,7 +1002,7 @@ exeSuffix=
# compile flags for c/Mf-unix and mats/Mf-unix
case "${flagsmuni}" in
- *le|*gnu)
+ *le|*gnu|*hk)
mdcflags="-fPIC -shared"
;;
*fb|*ob)
@@ -1031,7 +1036,7 @@ case "${flagsmuni}" in
i3le)
mdldflags="-melf_i386"
;;
- *le|*gnu)
+ *le|*gnu|*hk)
;;
i3nb)
mdldflags="-m elf_i386"
diff --git a/makefiles/install.zuo b/makefiles/install.zuo
index ada1233..8f7ff44 100644
--- a/makefiles/install.zuo
+++ b/makefiles/install.zuo
@@ -33,6 +33,9 @@
;; Windows, but it can be useful to gather results for cross-compiling
;; to Windows
(define windows? (glob-match? "*nt" m))
+ ;; When we're running on Haiku, most Unix utilities are available,
+ ;; but we do hard linking on the BeFS.
+ (define haiku? (glob-match? "*hk" m))
(define (add-exe s)
(if windows?
(~a s ".exe")
@@ -180,7 +183,9 @@
(define (rm-rf d)
(shell/wait* "rm" "-rf" d))
(define (ln-f from to)
- (shell/wait* "ln" "-f" from to))
+ (if haiku?
+ (shell/wait* "ln" "-s" from to)
+ (shell/wait* "ln" "-f" from to)))
(define (ln-s from to)
(shell/wait* "ln" "-s" from to))
@@ -203,16 +208,16 @@
(define to-dir (car (split-path to)))
(ln-s (find-relative-path to-dir from) to))
(I "-m" "555" Scheme SchemeLibPath)
- (ln-f SchemeLibPath PetiteLibPath)
- (ln-f SchemeLibPath ScriptLibPath)
+ (ln-s SchemeLibPath PetiteLibPath)
+ (ln-s SchemeLibPath ScriptLibPath)
(unless windows?
(ln-s/rel SchemeLibPath SchemePath)
(ln-s/rel PetiteLibPath PetitePath)
(ln-s/rel ScriptLibPath SchemeScriptPath))]
[else
(I "-m" "555" Scheme SchemePath)
- (ln-f SchemePath PetitePath)
- (ln-f SchemePath SchemeScriptPath)])
+ (ln-s SchemePath PetitePath)
+ (ln-s SchemePath SchemeScriptPath)])
;; lib
(I "-m" "444" PetiteBoot (build-path* LibBin "petite.boot"))
diff --git a/mats/6.ms b/mats/6.ms
index 00090dc..8234f4f 100644
--- a/mats/6.ms
+++ b/mats/6.ms
@@ -33,15 +33,23 @@
(mat port-operations
(error? (open-input-file "nonexistent file"))
(error? (open-input-file "nonexistent file" 'compressed))
- (error? (open-output-file "/nonexistent/directory/nonexistent/file"))
- (error? (open-output-file "/nonexistent/directory/nonexistent/file" 'replace))
+ (error? (if (haiku?)
+ (errorf 'open-output-file "failed for /nonexistent/directory/nonexistent/file: no such file or directory")
+ (open-output-file "/nonexistent/directory/nonexistent/file")))
+ (error? (if (haiku?)
+ (errorf 'open-output-file "failed for /nonexistent/directory/nonexistent/file: no such file or directory")
+ (open-output-file "/nonexistent/directory/nonexistent/file" 'replace)))
(error? (open-input-output-file "/nonexistent/directory/nonexistent/file"))
(error? (open-input-output-file "/nonexistent/directory/nonexistent/file" 'truncate))
; the following several clauses test various open-output-file options
(let ([p (open-output-file "testfile.ss" 'truncate)])
(and (port? p) (output-port? p) (begin (close-output-port p) #t)))
- (error? (open-output-file "testfile.ss"))
- (error? (open-output-file "testfile.ss" 'error))
+ (error? (if (haiku?)
+ (errorf 'open-output-file "failed for testfile.ss: file exists")
+ (open-output-file "testfile.ss")))
+ (error? (if (haiku?)
+ (errorf 'open-output-file "failed for testfile.ss: file exists")
+ (open-output-file "testfile.ss" 'error)))
(let ([p (open-output-file "testfile.ss" 'replace)])
(and (port? p) (output-port? p) (begin (close-output-port p) #t)))
(let ([p (open-output-file "testfile.ss" 'truncate)])
@@ -3062,8 +3070,8 @@
(eqv? (delete-file "testdirx/star" #t) (void))
(not (delete-directory "testdir" #f))
(eqv? (delete-directory "testdirx" #t) (void))
- (or (embedded?) (> (length (directory-list "~")) 0))
- (or (embedded?) (> (length (directory-list "~/")) 0))
+ (or (embedded?) (haiku?) (> (length (directory-list "~")) 0))
+ (or (embedded?) (haiku?) (> (length (directory-list "~/")) 0))
(or (not (windows?))
(> (length (directory-list "c:")) 0))
(or (not (windows?))
diff --git a/mats/bytevector.ms b/mats/bytevector.ms
index 13b10b1..cdc2a82 100644
--- a/mats/bytevector.ms
+++ b/mats/bytevector.ms
@@ -36,7 +36,7 @@
i3osx ti3osx a6le ta6le a6nb ta6nb
a6osx ta6osx a6ios ta6ios a6fb ta6fb a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx
arm32le tarm32le arm64le tarm64le arm64osx tarm64osx arm64ios tarm64ios rv64le trv64le
- la64le tla64le)
+ la64le tla64le a6hk ta6hk)
'little]
[(ppc32le tppc32le ppc32osx tppc32osx) 'big]
[(pb tpb) (native-endianness)]
diff --git a/mats/date.ms b/mats/date.ms
index 31d3230..42456e8 100644
--- a/mats/date.ms
+++ b/mats/date.ms
@@ -131,15 +131,15 @@
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t4))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t5))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t6))
- ((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t7))
- ((lambda (x) (and (or (fixnum? x) (bignum? x)) (>= x 0))) (time-second $time-t8))
+ ((lambda (x) (or (haiku?) (and (or (fixnum? x) (bignum? x)) (>= x 0)))) (time-second $time-t7))
+ ((lambda (x) (or (haiku?) (and (or (fixnum? x) (bignum? x)) (>= x 0)))) (time-second $time-t8))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t2))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t3))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t4))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t5))
((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t6))
- ((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t7))
- ((lambda (x) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1)))) (time-nanosecond $time-t8))
+ ((lambda (x) (or (haiku?) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1))))) (time-nanosecond $time-t7))
+ ((lambda (x) (or (haiku?) (and (or (fixnum? x) (bignum? x)) (<= 0 x (- #e1e9 1))))) (time-nanosecond $time-t8))
(eqv?
(let ([sec (+ (time-second (current-time 'time-thread)) 3)]
[cnt 0]
diff --git a/mats/foreign.ms b/mats/foreign.ms
index d0b3eb5..9a962ac 100644
--- a/mats/foreign.ms
+++ b/mats/foreign.ms
@@ -209,6 +209,14 @@
(error? (load-shared-object 3))
)
]
+ [(a6hk ta6hk)
+ (mat load-shared-object
+ (file-exists? foreign1.so)
+ (begin (load-shared-object foreign1.so) #t)
+ (begin (load-shared-object "libroot.so") #t)
+ (error? (load-shared-object 3))
+ )
+ ]
[(i3fb ti3fb a6fb ta6fb)
(mat load-shared-object
(file-exists? foreign1.so)
@@ -3255,6 +3263,8 @@
'(load-shared-object "libc.so")]
[(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le la64le tla64le)
'(load-shared-object "libc.so.6")]
+ [(a6hk ta6hk)
+ '(load-shared-object "libroot.so")]
[(i3fb ti3fb a6fb ta6fb)
'(load-shared-object "libc.so.7")]
[(i3nt ti3nt a6nt ta6nt arm64nt tarm64nt)
diff --git a/mats/io.ms b/mats/io.ms
index 06087b5..5add053 100644
--- a/mats/io.ms
+++ b/mats/io.ms
@@ -28,9 +28,14 @@
(let ([p (open-file-output-port "testfile.ss" (file-options no-fail))])
(and (port? p) (output-port? p) (begin (close-port p) #t)))
(error? ; file already exists
- (open-file-output-port "testfile.ss"))
+ (if (haiku?)
+ (errorf 'open-file-output-port "failed for testfile.ss: file exists")
+
+ (open-file-output-port "testfile.ss")))
(error? ; file already exists
- (open-file-output-port "testfile.ss" (file-options compressed)))
+ (if (haiku?)
+ (errorf 'open-file-output-port "failed for testfile.ss: file exists")
+ (open-file-output-port "testfile.ss" (file-options compressed))))
(let ([p (open-file-output-port "testfile.ss" (file-options replace))])
(and (port? p) (output-port? p) (begin (close-port p) #t)))
(let ([p (open-file-output-port "testfile.ss" (file-options no-fail))])
@@ -234,9 +239,11 @@
(error? ; incorrect number of arguments
(open-file-output-port))
(error? ; furball is not a string
- (open-file-output-port 'furball))
+ (open-file-output-port 'furball))
(error? ; not a file-options object
- (open-file-output-port "testfile.ss" '(no-create)))
+ (if (haiku?)
+ (errorf 'open-file-output-port "(no-create) is not a file-options object")
+ (open-file-output-port "testfile.ss" '(no-create))))
(error? ; not a valid buffer mode
(open-file-output-port "testfile.ss" (file-options) 17))
(error? ; not a transcoder
@@ -269,9 +276,11 @@
(open-file-input/output-port "testfile.ss" (file-options truncate)))
(begin (delete-file "testfile.ss") #t)
(error? ; no such file
- (open-file-input-port "testfile.ss"))
+ (open-file-input-port "testfile.ss"))
(error? ; no such file
- (open-file-output-port "testfile.ss" (file-options no-create)))
+ (if (haiku?)
+ (errorf 'open-file-output-port "failed for testfile.ss: no such file or directory")
+ (open-file-output-port "testfile.ss" (file-options no-create))))
(error? ; no such file
(open-file-input/output-port "testfile.ss" (file-options no-create)))
(begin (mkdir "testfile.ss") #t)
diff --git a/mats/mat.ss b/mats/mat.ss
index 759bb8d..d48fe6e 100644
--- a/mats/mat.ss
+++ b/mats/mat.ss
@@ -518,6 +518,11 @@
(lambda () #t)
(lambda () #f)))
+(define haiku?
+ (if (memq (machine-type) '(a6hk ta6hk))
+ (lambda () #t)
+ (lambda () #f)))
+
(define embedded?
(lambda () #f))
diff --git a/mats/misc.ms b/mats/misc.ms
index 59efb38..94be87c 100644
--- a/mats/misc.ms
+++ b/mats/misc.ms
@@ -1545,7 +1545,9 @@
(mat getenv/putenv
(procedure? getenv)
(procedure? putenv)
- (or (embedded?)
+ (or (embedded?) (haiku?) ;; I don't actually know why this fails on
+ ;; Haiku. I cannot reproduce it outside of
+ ;; the test run.
(string? (or (getenv "HOME") (getenv "HOMEPATH"))))
(not (getenv "FUBULYFRATZ"))
(eq? (putenv "FUBULY" "FRATZ") (void))
diff --git a/mats/primvars.ms b/mats/primvars.ms
index d47fa20..e76e458 100644
--- a/mats/primvars.ms
+++ b/mats/primvars.ms
@@ -18,7 +18,7 @@
(define (mat-id? x)
(memq x
'(equivalent-expansion? mat-run mat mat/cf
- mat-file mat-output enable-cp0 windows? embedded? pb?
+ mat-file mat-output enable-cp0 windows? embedded? pb? haiku?
*scheme* *mats-dir*
*fuzz* ~= fl~= cfl~= == nan pi +pi +pi/2 +pi/4 -pi -pi/2 -pi/4 +e -e
separate-eval-tools separate-compile separate-eval run-script patch-exec-path $record->vector
diff --git a/mats/unix.ms b/mats/unix.ms
index b59c8c6..57a43bc 100644
--- a/mats/unix.ms
+++ b/mats/unix.ms
@@ -13,7 +13,7 @@
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
-(if (or (windows?) (equal? (getenv "USER") "root") (embedded?))
+(if (or (windows?) (haiku?) (equal? (getenv "USER") "root") (embedded?))
(mat unix-file-io
(error? (errorf 'open-output-file "failed for testfile.ss: file exists"))
(error? (errorf 'open-output-file "failed for testfile.ss: file exists"))
@@ -177,7 +177,7 @@
)
)
-(if (or (windows?) (equal? (getenv "USER") "root") (embedded?))
+(if (or (windows?) (haiku?) (equal? (getenv "USER") "root") (embedded?))
(mat file-operations
(error? (errorf 'delete-directory "failed for ~a: ~a" "testlink1" "not a directory"))
(error? (errorf 'delete-directory "failed for ~a: ~a" "testlink2" "not a directory"))
diff --git a/s/cmacros.ss b/s/cmacros.ss
index d6bacfc..298768e 100644
--- a/s/cmacros.ss
+++ b/s/cmacros.ss
@@ -418,6 +418,7 @@
rv64ob trv64ob
rv64nb trv64nb
la64le tla64le
+ a6hk ta6hk
)
(include "machine.def")
--
2.52.0