Retropikzel
/
compile-r7rs
1
0
Fork 0
Code Issues

Support Gauche with cond-expand

This commit is contained in:
retropikzel 2025-11-07 16:46:13 +02:00
parent e8311e1af4
commit b63df1340f
3 changed files with 56 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Makefile
View File

@ -18,15 +18,12 @@ all: build-chibi
README.md: doc/compile-scheme.1 README.md: doc/compile-scheme.1
printf "<pre>\n$$(MANWIDTH=80 man -l doc/compile-scheme.1)\n</pre>" > README.md printf "<pre>\n$$(MANWIDTH=80 man -l doc/compile-scheme.1)\n</pre>" > README.md
replace-version: build-chibi:
sed 's/DEVELOPMENT_VERSION/${VERSION}/' compile-scheme.scm
build-chibi: replace-version
echo "#!/bin/sh" > compile-scheme echo "#!/bin/sh" > compile-scheme
echo "chibi-scheme -A ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme echo "chibi-scheme -A ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
chmod +x compile-scheme chmod +x compile-scheme
build-chicken: replace-version build-chicken:
csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld csc -R r7rs -X r7rs -static -c -J -unit libs.util -o libs.util.o libs/util.sld
ar rcs libs.util.a libs.util.o ar rcs libs.util.a libs.util.o
csc -R r7rs -X r7rs -static -c -J -unit libs.library-util -o libs.library-util.o libs/library-util.sld csc -R r7rs -X r7rs -static -c -J -unit libs.library-util -o libs.library-util.o libs/library-util.sld
@ -42,42 +39,42 @@ build-chicken: replace-version
-uses srfi-170 \ -uses srfi-170 \
compile-scheme.scm compile-scheme.scm
deb: build-chicken deb: build-gauche
mkdir -p deb/bin mkdir -p deb/bin
cp compile-scheme deb/bin/ cp compile-scheme deb/bin/
mkdir -p deb/DEBIAN mkdir -p deb/DEBIAN
printf "Package: compile-scheme\nArchitecture: amd64\nVersion: ${VERSION}\nSection: misc\nMaintainer: Retropikzel <retropikzel@iki.fi>\nDescription: SRFI 138: Compiling Scheme programs to executables - Implementation" \ printf "Package: compile-scheme\nArchitecture: amd64\nDepends: gauche\nVersion: ${VERSION}\nSection: misc\nMaintainer: Retropikzel <retropikzel@iki.fi>\nDescription: SRFI 138: Compiling Scheme programs to executables - Implementation\n" \
> deb/DEBIAN/control > deb/DEBIAN/control
dpkg-deb -b deb dpkg-deb -b deb
mv deb.deb compile-scheme-${VERSION}.deb
# FIXME build-gauche:
#build-gauche: replace-version echo "#!/bin/sh" > compile-scheme
#echo "#!/bin/sh" > compile-scheme echo "gosh -r7 -I ${PREFIX}/lib/compile-scheme -I ${PREFIX}/lib/compile-scheme/libs ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
#echo "gosh -r -I ${PREFIX}/lib/compile-scheme -I ${PREFIX}/lib/compile-scheme/libs ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compilescheme- chmod +x compile-scheme
#chmod +x compile-scheme
build-guile: replace-version build-guile:
echo "#!/bin/sh" > compile-scheme echo "#!/bin/sh" > compile-scheme
echo "guile --r7rs --auto-compile -I -q -L ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme echo "guile --r7rs --auto-compile -I -q -L ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
chmod +x compile-scheme chmod +x compile-scheme
# FIXME # FIXME
#build-kawa: replace-version #build-kawa:
#echo "#!/bin/sh" > compile-scheme #echo "#!/bin/sh" > compile-scheme
#echo "kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -Dkawa.import.path=/usr/local/share/kawa/lib/*.sld:${PREFIX}/lib/compile-scheme/*.sld --r7rs ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\" 2> /dev/null" >> compile-scheme #echo "kawa -J--add-exports=java.base/jdk.internal.foreign.abi=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign.layout=ALL-UNNAMED -J--add-exports=java.base/jdk.internal.foreign=ALL-UNNAMED -J--enable-native-access=ALL-UNNAMED -Dkawa.import.path=/usr/local/share/kawa/lib/*.sld:${PREFIX}/lib/compile-scheme/*.sld --r7rs ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\" 2> /dev/null" >> compile-scheme
#chmod +x compile-scheme #chmod +x compile-scheme
# FIXME # FIXME
#build-racket: replace-version #build-racket:
#echo "#!/bin/sh" > compile-scheme #echo "#!/bin/sh" > compile-scheme
#echo "racket -I r7rs -S ${PREFIX}/lib/compile-scheme --script ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme #echo "racket -I r7rs -S ${PREFIX}/lib/compile-scheme --script ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
build-sagittarius: replace-version build-sagittarius:
echo "#!/bin/sh" > compile-scheme echo "#!/bin/sh" > compile-scheme
echo "sash -A ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme echo "sash -A ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
chmod +x compile-scheme chmod +x compile-scheme
build-stklos: replace-version build-stklos:
echo "#!/bin/sh" > compile-scheme echo "#!/bin/sh" > compile-scheme
echo "stklos -I ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme echo "stklos -I ${PREFIX}/lib/compile-scheme ${PREFIX}/lib/compile-scheme/compile-scheme.scm \"\$$@\"" >> compile-scheme
chmod +x compile-scheme chmod +x compile-scheme

32
compile-scheme.scm
View File

@ -1,20 +1,12 @@
(import (scheme base) (import (scheme base)
(scheme file) (scheme file)
(scheme read) (scheme read)
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(foreign c) (libs util)
(libs util) (libs data)
(libs data) (libs library-util)
(libs library-util) (srfi 170))
(srfi 170))
(define-c-library c-stdlib
'("stdlib.h")
libc-name
'((additional-versions ("6"))))
(define-c-procedure c-system c-stdlib 'system 'int '(pointer))
(when (member "--help" (command-line)) (when (member "--help" (command-line))
(display "For help see: man compile-scheme") (display "For help see: man compile-scheme")
@ -22,7 +14,7 @@
(exit 0)) (exit 0))
(when (member "--version" (command-line)) (when (member "--version" (command-line))
(display "DEVELOPMENT_VERSION") (display "1.0.0")
(newline) (newline)
(exit 0)) (exit 0))
@ -235,7 +227,7 @@
(let* ((library-command (scheme-library-command file))) (let* ((library-command (scheme-library-command file)))
(for-each (for-each
(lambda (command) (lambda (command)
(let ((exit-code (c-system (string->c-utf8 command)))) (let ((exit-code (system command)))
(when (not (= exit-code 0)) (when (not (= exit-code 0))
(exit exit-code)))) (exit exit-code))))
library-command))) library-command)))
@ -286,14 +278,14 @@
#\newline #\newline
,scheme-program)))))) ,scheme-program))))))
(cond ((symbol=? compilation-target 'unix) (cond ((symbol=? compilation-target 'unix)
(c-system (string->c-utf8 (string-append "chmod +x " output-file))))))) (system (string-append "chmod +x " output-file))))))
(when (and (symbol=? scheme-type 'compiler) input-file) (when (and (symbol=? scheme-type 'compiler) input-file)
(when (and output-file (file-exists? output-file)) (when (and output-file (file-exists? output-file))
(delete-file output-file)) (delete-file output-file))
(for-each (for-each
(lambda (command) (lambda (command)
(let ((exit-code (c-system (string->c-utf8 command)))) (let ((exit-code (system command)))
(when (not (= exit-code 0)) (when (not (= exit-code 0))
(exit exit-code)))) (exit exit-code))))
scheme-command) scheme-command)

37
libs/util.sld
View File

@ -1,12 +1,22 @@
(define-library (define-library
(libs util) (libs util)
(import (scheme base) (cond-expand
(scheme write) (gauche
(scheme file) (import (scheme base)
(scheme char) (scheme write)
(scheme process-context) (scheme file)
(foreign c)) (scheme char)
(export echo (scheme process-context)
(only (gauche base) sys-system)))
(else
(import (scheme base)
(scheme write)
(scheme file)
(scheme char)
(scheme process-context)
(foreign c))))
(export system
echo
cat cat
r6rs-schemes r6rs-schemes
r7rs-schemes r7rs-schemes
@ -31,6 +41,19 @@
trim-end trim-end
trim-both) trim-both)
(begin (begin
(cond-expand
(gauche
(define system sys-system))
(else
(define-c-library c-stdlib
'("stdlib.h")
libc-name
'((additional-versions ("6"))))
(define-c-procedure c-system c-stdlib 'system 'int '(pointer))
(define (system cmd)
(c-system (string->c-utf8 cmd)))))
(define (echo text) (display text) (newline)) (define (echo text) (display text) (newline))
(define (cat path) (for-each (lambda (line) (echo line)) (file->list path))) (define (cat path) (for-each (lambda (line) (echo line)) (file->list path)))
(define r6rs-schemes '(chezscheme (define r6rs-schemes '(chezscheme