build: Simplify, drop make.scm experiment.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:38:57 +0000 (18:38 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 29 Apr 2018 16:38:57 +0000 (18:38 +0200)
* build.sh: Rewrite.
* build-aux/build-cc.sh: New file.
* build-aux/build-mes.sh: New file.
* build-aux/build-mlibc.sh: New file.
* build-aux/cc.sh: New file.
* build-aux/cc-mes.sh: New file.
* build-aux/cc-mlibc.sh: New file.
* install.sh: Update.
* make.scm: Remove.
* guile/guix/make.scm: Remove.
* guile/guix/records.scm: Remove.
* guile/guix/shell-utilsg.scm: Remove.

56 files changed:
.gitignore
GNUmakefile
build-aux/build-cc.sh [new file with mode: 0755]
build-aux/build-guile.sh [new file with mode: 0755]
build-aux/build-mes.sh [new file with mode: 0755]
build-aux/build-mlibc.sh [new file with mode: 0755]
build-aux/cc-mes.sh [new file with mode: 0755]
build-aux/cc-mlibc.sh [new file with mode: 0755]
build-aux/cc.sh [new file with mode: 0755]
build-aux/check-boot.sh [new file with mode: 0755]
build-aux/check-mescc.sh [new file with mode: 0755]
build-aux/mes-snarf.scm
build-aux/test.sh [new file with mode: 0755]
build.sh
check-boot.sh [deleted file]
check-mescc.sh [deleted file]
check.sh
guile/guix/make.scm [deleted file]
guile/guix/records.scm [deleted file]
guile/guix/shell-utils.scm [deleted file]
install.sh
make.scm [deleted file]
module/language/c99/compiler.mes
scaffold/mini-mes.c
scripts/mescc
src/mes.c
test.sh [deleted file]
tests/base.test
tests/boot.test
tests/catch.test
tests/closure.test
tests/cwv.test
tests/display.test
tests/fluids.test
tests/getopt-long.test
tests/guile.test
tests/let-syntax.test
tests/let.test
tests/match.test
tests/math.test
tests/module.test
tests/optargs.test
tests/peg.test
tests/pmatch.test
tests/psyntax.test
tests/quasiquote.test
tests/read.test
tests/record.test
tests/scm.test
tests/srfi-1.test
tests/srfi-13.test
tests/srfi-14.test
tests/srfi-16.test
tests/srfi-43.test
tests/syntax.test
tests/vector.test

index ea64ef76395f73994f97986aa4878c3a9a027e6c..b56da706b16eb84f56ea6339c199edf80c82104b 100644 (file)
@@ -1,4 +1,6 @@
 *-
+*.blood-elf-M1
+*.blood-elf-hex2
 *.go
 *~
 .#*
 /.tarball-version
 /ChangeLog
 /a.out
+*.gcc-out
 *.mes-out
+*.mlibc-out
+*.seed-out
 
 #keep this: bootstrap
 #/mes.mes
index 9a233667b4cbfd31fbc900e6c26122ffb24df3b6..9025f2430028fa0c58a2d150266999f5dd26b4a1 100644 (file)
@@ -6,13 +6,34 @@ include .config.make
 export PREFIX
 export VERSION
 
-PHONY_TARGETS:= all all-go check clean clean-go default help install list
+PHONY_TARGETS:= all all-go check clean clean-go default help install
 .PHONY: $(PHONY_TARGETS)
 
-$(PHONY_TARGETS):
-       $(GUILE) $(GUILE_FLAGS) -s make.scm $@
+default: all
 
-%:
-       $(GUILE) $(GUILE_FLAGS) -s make.scm $@
+all:
+       ./build.sh
+
+clean:
+       true
+
+all-go:
+       build-aux/build-guile.sh
+
+clean-go:
+       rm -f $(shell find . -name '*.go')
+
+check:
+       ./check.sh
+
+
+install:
+       ./install.sh
 
 .config.make: ./configure
+
+seed:
+       cd ../mes-seed && git reset --hard HEAD
+       MES=guile GUILE=guile SEED=1 build-aux/build-mes.sh
+       cd ../mes-seed && ./bootstrap.sh && cd ../mes
+       MES=guile GUILE=guile SEED=1 build-aux/build-mes.sh
diff --git a/build-aux/build-cc.sh b/build-aux/build-cc.sh
new file mode 100755 (executable)
index 0000000..0579697
--- /dev/null
@@ -0,0 +1,51 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+export CC=${CC-gcc}
+
+build-aux/mes-snarf.scm src/gc.c
+build-aux/mes-snarf.scm src/lib.c
+build-aux/mes-snarf.scm src/math.c
+build-aux/mes-snarf.scm src/mes.c
+build-aux/mes-snarf.scm src/posix.c
+build-aux/mes-snarf.scm src/reader.c
+build-aux/mes-snarf.scm src/vector.c
+
+export CPPFLAGS=${CPPFLAGS-"
+-D VERSION=\"$VERSION\"
+-D MODULEDIR=\"$MODULEDIR\"
+-D PREFIX=\"$PREFIX\"
+-I src
+-I lib
+-I include
+"}
+
+export CFLAGS=${CFLAGS-"
+--std=gnu99
+-O0
+-g
+"}
+
+NOLINK=1 sh build-aux/cc.sh lib/libc-gcc
+#NOLINK=1 sh build-aux/cc.sh lib/libc+tcc-gcc
+
+sh build-aux/cc.sh src/mes
diff --git a/build-aux/build-guile.sh b/build-aux/build-guile.sh
new file mode 100755 (executable)
index 0000000..26ef74e
--- /dev/null
@@ -0,0 +1,38 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+export GUILE=${GUILE-$(type -p guile)}
+
+SCM_FILES="
+language/c99/compiler.scm
+language/c99/info.scm
+mes/as-i386.scm
+mes/as.scm
+mes/bytevectors.scm
+mes/elf.scm
+mes/guile.scm
+mes/M1.scm"
+
+export srcdir=.
+export host=$($GUILE -c "(display %host-type)")
+cd guile
+$GUILE --no-auto-compile -L . -C . -s ../build-aux/compile-all.scm $SCM_FILES
diff --git a/build-aux/build-mes.sh b/build-aux/build-mes.sh
new file mode 100755 (executable)
index 0000000..e7cc853
--- /dev/null
@@ -0,0 +1,97 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+export HEX2=${HEX2-hex2}
+export M1=${M1-M1}
+export BLOOD_ELF=${BLOOD_ELF-blood-elf}
+export MES_SEED=${MES_SEED-../mes-seed}
+export MESCC=${MESCC-$(type -p mescc)}
+[ -z "$MESCC" ] && MESCC=scripts/mescc
+export MES=${MES-$(type -p mes)}
+[ -z "$MES" ] && MES=src/mes
+
+if [ -d "$MES_SEED" ]; then
+    $M1 --LittleEndian --Architecture=1\
+        -f stage0/x86.M1\
+        -f $MES_SEED/crt1.M1\
+        -o lib/crt1.hex2
+    $M1 --LittleEndian --Architecture=1\
+        -f stage0/x86.M1\
+        -f $MES_SEED/libc-mes.M1\
+        -o lib/libc-mes.hex2
+    $M1 --LittleEndian --Architecture=1\
+        -f stage0/x86.M1\
+        -f $MES_SEED/mes.M1\
+        -o src/mes.hex2
+    $BLOOD_ELF\
+        -f stage0/x86.M1\
+        -f $MES_SEED/mes.M1\
+        -f $MES_SEED/libc-mes.M1\
+        -o src/mes.blood-elf.M1
+    $M1 --LittleEndian --Architecture=1\
+        -f src/mes.blood-elf.M1\
+        -o src/mes.blood-elf.hex2
+    $HEX2 --LittleEndian --Architecture=1 --BaseAddress=0x1000000\
+          -f stage0/elf32-header.hex2\
+          -f lib/crt1.hex2\
+          -f lib/libc-mes.hex2\
+          -f src/mes.hex2\
+          -f src/mes.blood-elf.hex2\
+          --exec_enable\
+          -o src/mes.seed-out
+    cp src/mes.seed-out src/mes
+
+    $M1 --LittleEndian --Architecture=1 -f\
+        stage0/x86.M1\
+        -f $MES_SEED/libc+tcc-mes.M1\
+        -o src/libc+tcc-mes.hex2
+fi
+
+[ -n "$SEED" ] && exit 0
+
+export GUILE=src/mes
+export MES_ARENA=${MES_ARENA-30000000}
+sh build-aux/mes-snarf.scm --mes src/gc.c
+sh build-aux/mes-snarf.scm --mes src/lib.c
+sh build-aux/mes-snarf.scm --mes src/math.c
+sh build-aux/mes-snarf.scm --mes src/mes.c
+sh build-aux/mes-snarf.scm --mes src/posix.c
+sh build-aux/mes-snarf.scm --mes src/reader.c
+sh build-aux/mes-snarf.scm --mes src/vector.c
+
+export PREPROCESS=1
+NOLINK=1 sh build-aux/cc-mes.sh lib/crt1
+NOLINK=1 sh build-aux/cc-mes.sh lib/mini-libc-mes
+NOLINK=1 sh build-aux/cc-mes.sh lib/libc-mes
+NOLINK=1 sh build-aux/cc-mes.sh lib/libc+tcc-mes
+
+# sh build-aux/cc-mes.sh scaffold/main
+# sh build-aux/cc-mes.sh scaffold/hello
+# sh build-aux/cc-mes.sh scaffold/argv
+# sh build-aux/cc-mes.sh scaffold/malloc
+##sh build-aux/cc-mes.sh scaffold/micro-mes
+##sh build-aux/cc-mes.sh scaffold/tiny-mes
+# sh build-aux/cc-mes.sh scaffold/mini-mes
+
+sh build-aux/cc-mes.sh src/mes
+# FIXME: broken
+# cp src/mes.mes-out src/mes
diff --git a/build-aux/build-mlibc.sh b/build-aux/build-mlibc.sh
new file mode 100755 (executable)
index 0000000..a6e40b1
--- /dev/null
@@ -0,0 +1,71 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+export CC32=${CC32-$(type -p i686-unknown-linux-gnu-gcc)}
+build-aux/mes-snarf.scm --mes src/gc.c
+build-aux/mes-snarf.scm --mes src/lib.c
+build-aux/mes-snarf.scm --mes src/math.c
+build-aux/mes-snarf.scm --mes src/mes.c
+build-aux/mes-snarf.scm --mes src/posix.c
+build-aux/mes-snarf.scm --mes src/reader.c
+build-aux/mes-snarf.scm --mes src/vector.c
+
+build-aux/mes-snarf.scm src/gc.c
+build-aux/mes-snarf.scm src/lib.c
+build-aux/mes-snarf.scm src/math.c
+build-aux/mes-snarf.scm src/mes.c
+build-aux/mes-snarf.scm src/posix.c
+build-aux/mes-snarf.scm src/reader.c
+build-aux/mes-snarf.scm src/vector.c
+
+export CPPFLAGS=${CPPFLAGS-"
+-D VERSION=\"$VERSION\"
+-D MODULEDIR=\"$MODULEDIR\"
+-D PREFIX=\"$PREFIX\"
+-I src
+-I lib
+-I include
+"}
+
+export C32FLAGS=${C32FLAGS-"
+--std=gnu99
+-O0
+-fno-stack-protector
+-g
+-m32
+-nostdinc
+-nostdlib
+"}
+
+NOLINK=1 sh build-aux/cc-mlibc.sh lib/crt1
+NOLINK=1 sh build-aux/cc-mlibc.sh lib/libc-gcc
+NOLINK=1 sh build-aux/cc-mlibc.sh lib/libc+tcc-gcc
+
+sh build-aux/cc-mlibc.sh scaffold/main
+sh build-aux/cc-mlibc.sh scaffold/hello
+sh build-aux/cc-mlibc.sh scaffold/argv
+sh build-aux/cc-mlibc.sh scaffold/malloc
+sh build-aux/cc-mlibc.sh scaffold/micro-mes
+sh build-aux/cc-mlibc.sh scaffold/tiny-mes
+sh build-aux/cc-mlibc.sh scaffold/mini-mes
+
+sh build-aux/cc-mlibc.sh src/mes
diff --git a/build-aux/cc-mes.sh b/build-aux/cc-mes.sh
new file mode 100755 (executable)
index 0000000..2a51db5
--- /dev/null
@@ -0,0 +1,88 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+export HEX2=${HEX2-hex2}
+export M1=${M1-M1}
+export BLOOD_ELF=${BLOOD_ELF-blood-elf}
+export MES_SEED=${MES_SEED-../mes-seed}
+export MESCC=${MESCC-$(type -p mescc)}
+[ -z "$MESCC" ] && MESCC=scripts/mescc
+export MES=${MES-$(type -p mes)}
+[ -z "$MES" ] && MES=src/mes
+
+CPPFLAGS=${CPPFLAGS-"
+-D VERSION=\"$VERSION\"
+-D MODULEDIR=\"$MODULEDIR\"
+-D PREFIX=\"$PREFIX\"
+-I src
+-I lib
+-I include
+"}
+
+MESCCLAGS=${MESCCFLAGS-"
+"}
+
+c=$1
+
+if [ -n "$PREPROCESS" ]; then
+    sh -x $MESCC\
+       -E\
+       $CPPFLAGS\
+       $MESCCFLAGS\
+       -o "$c".E\
+       "$c".c
+    sh -x $MESCC\
+       -c\
+       -o "$c".M1\
+       "$c".E
+else
+    sh -x $MESCC\
+       -c\
+       $CPPFLAGS\
+       $MESCCFLAGS\
+       -o "$c".M1\
+       "$c".c
+fi
+
+$M1 --LittleEndian --Architecture=1\
+    -f stage0/x86.M1\
+    -f "$c".M1\
+    -o "$c".hex2
+
+if [ -z "$NOLINK" ]; then
+    $BLOOD_ELF\
+        -f stage0/x86.M1\
+        -f "$c".M1\
+        -f lib/libc-mes.M1\
+        -o "$c".blood-elf-M1
+    $M1 --LittleEndian --Architecture=1\
+        -f "$c".blood-elf-M1\
+        -o "$c".blood-elf-hex2
+    $HEX2 --LittleEndian --Architecture=1 --BaseAddress=0x1000000\
+          -f stage0/elf32-header.hex2\
+          -f lib/crt1.hex2\
+          -f lib/libc-mes.hex2\
+          -f "$c".hex2\
+          -f "$c".blood-elf-hex2\
+          --exec_enable\
+          -o "$c".mes-out
+fi
diff --git a/build-aux/cc-mlibc.sh b/build-aux/cc-mlibc.sh
new file mode 100755 (executable)
index 0000000..e5bd8dd
--- /dev/null
@@ -0,0 +1,59 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+CPPFLAGS=${CPPFLAGS-"
+-D VERSION=\"$VERSION\"
+-D MODULEDIR=\"$MODULEDIR\"
+-D PREFIX=\"$PREFIX\"
+-I src
+-I lib
+-I include
+"}
+
+C32FLAGS=${C32FLAGS-"
+--std=gnu99
+-O0
+-fno-builtin
+-fno-stack-protector
+-g
+-m32
+-nostdinc
+-nostdlib
+"}
+
+c=$1
+
+$CC32\
+    -c\
+    $CPPFLAGS\
+    $C32FLAGS\
+    -o "$c".mlibc-o\
+    "$c".c
+
+if [ -z "$NOLINK" ]; then
+    $CC32\
+        $C32FLAGS\
+        -o "$c".mlibc-out\
+        lib/crt1.mlibc-o\
+        "$c".mlibc-o\
+        lib/libc-gcc.mlibc-o
+fi
diff --git a/build-aux/cc.sh b/build-aux/cc.sh
new file mode 100755 (executable)
index 0000000..0929a20
--- /dev/null
@@ -0,0 +1,54 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+CPPFLAGS=${CPPFLAGS-"
+-D VERSION=\"$VERSION\"
+-D MODULEDIR=\"$MODULEDIR\"
+-D PREFIX=\"$PREFIX\"
+-I src
+-I lib
+-I include
+"}
+
+CFLAGS=${CFLAGS-"
+--std=gnu99
+-O0
+-g
+"}
+
+c=$1
+
+$CC\
+    -c\
+    $CPPFLAGS\
+    $CFLAGS\
+    -D POSIX=1\
+    -o "$c".gcc-o\
+    "$c".c
+
+if [ -z "$NOLINK" ]; then
+    $CC\
+        $CFLAGS\
+        -o "$c".gcc-out\
+        "$c".gcc-o\
+        lib/libc-gcc.gcc-o
+fi
diff --git a/build-aux/check-boot.sh b/build-aux/check-boot.sh
new file mode 100755 (executable)
index 0000000..380611a
--- /dev/null
@@ -0,0 +1,125 @@
+#! /bin/bash
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -e
+
+export GUILE=${GUILE-guile}
+export MES=${MES-./src/mes}
+
+tests="
+
+00-zero.scm
+01-true.scm
+02-symbol.scm
+03-string.scm
+04-quote.scm
+05-list.scm
+06-tick.scm
+07-if.scm
+08-if-if.scm
+
+10-cons.scm
+11-list.scm
+12-car.scm
+13-cdr.scm
+14-exit.scm
+15-display.scm
+
+16-if-eq-quote.scm
+
+20-define.scm
+20-define-quoted.scm
+20-define-quote.scm
+
+21-define-procedure.scm
+22-define-procedure-2.scm
+23-begin.scm
+24-begin-define.scm
+25-begin-define-2.scm
+26-begin-define-later.scm
+27-lambda-define.scm
+28-define-define.scm
+29-lambda-define.scm
+2a-lambda-lambda.scm
+2b-define-lambda.scm
+2c-define-lambda-recurse.scm
+2d-define-lambda-set.scm
+2d-compose.scm
+2e-define-first.scm
+2f-define-second.scm
+2f-define-second-lambda.scm
+2g-vector.scm
+
+30-capture.scm
+31-capture-define.scm
+32-capture-modify-close.scm
+32-capture-modify-close.scm
+33-procedure-override-close.scm
+34-cdr-override-close.scm
+35-closure-modify.scm
+36-closure-override.scm
+37-closure-lambda.scm
+38-simple-format.scm
+39-global-define-override.scm
+3a-global-define-lambda-override.scm
+
+40-define-macro.scm
+41-when.scm
+42-if-when.scm
+43-or.scm
+44-or-if.scm
+45-pass-if.scm
+46-report.scm
+47-pass-if-eq.scm
+48-let.scm
+49-macro-override.scm
+4a-define-macro-define-macro.scm
+4b-define-macro-define.scm
+4c-quasiquote.scm
+4d-let-map.scm
+4e-let-global.scm
+
+50-primitive-load.scm
+51-module.scm
+52-define-module.scm
+53-closure-display.scm
+
+60-let-syntax.scm
+"
+
+for i in $tests; do
+    echo -n $i
+    if [ ! -f scaffold/boot/$i ]; then
+        echo ' [SKIP]'
+        continue;
+    fi
+    $GUILE -L guile -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i) >& /dev/null
+    x=$(
+        if [ -z "${i/5[0-9]-*/}" ]; then
+            cat scaffold/boot/$i | MES_BOOT=boot-00.scm $MES 2>&1;
+        elif [ -z "${i/6[0-9]-*/}" ]; then
+            cat scaffold/boot/$i | MES_BOOT=boot-01.scm $MES 2>&1;
+        else
+            MES_BOOT=scaffold/boot/$i $MES 2>&1;
+        fi
+     ) \
+        && echo ' [PASS]' \
+        || (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
+done
diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh
new file mode 100755 (executable)
index 0000000..d36da3d
--- /dev/null
@@ -0,0 +1,237 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+export MES=${MES-src/mes}
+export MESCC=${MESCC-scripts/mescc}
+export GUILE=${GUILE-guile}
+export MES_PREFIX=${MES_PREFIX-.}
+
+export HEX2=${HEX2-hex2}
+export M1=${M1-M1}
+export BLOOD_ELF=${BLOOD_ELF-blood-elf}
+export MES_SEED=${MES_SEED-../mes-seed}
+export MESCC=${MESCC-$(type -p mescc)}
+[ -z "$MESCC" ] && MESCC=scripts/mescc
+export MES=${MES-$(type -p mes)}
+[ -z "$MES" ] && MES=src/mes
+
+
+tests="
+t
+00-exit-0
+01-return-0
+02-return-1
+03-call
+04-call-0
+05-call-1
+06-call-!1
+10-if-0
+11-if-1
+12-if-==
+13-if-!=
+14-if-goto
+15-if-!f
+16-if-t
+20-while
+21-char[]
+22-while-char[]
+23-pointer
+30-strlen
+31-eputs
+32-compare
+33-and-or
+34-pre-post
+35-compare-char
+36-compare-arithmetic
+37-compare-assign
+38-compare-call
+40-if-else
+41-?
+42-goto-label
+43-for-do-while
+44-switch
+45-void-call
+50-assert
+51-strcmp
+52-itoa
+53-strcpy
+54-argv
+60-math
+61-array
+63-struct-cell
+64-make-cell
+65-read
+70-printf
+71-struct-array
+72-typedef-struct-def
+73-union
+74-multi-line-string
+75-struct-union
+76-pointer-arithmetic
+77-pointer-assign
+78-union-struct
+79-int-array
+7a-struct-char-array
+7b-struct-int-array
+7c-dynarray
+7d-cast-char
+7e-struct-array-access
+7f-struct-pointer-arithmetic
+7g-struct-byte-word-field
+7h-struct-assign
+7i-struct-struct
+7j-strtoull
+7k-for-each-elem
+7l-struct-any-size-array
+7m-struct-char-array-assign
+7n-struct-struct-array
+80-setjmp
+81-qsort
+82-define
+"
+
+if [ ! -x ./i686-unknown-linux-gnu-tcc ]; then
+    tests=$(echo "$tests" | grep -Ev "02-return-1|05-call-1|80-setjmp|81-qsort")
+fi
+
+set +e
+fail=0
+total=0
+for t in $tests; do
+    sh build-aux/test.sh "scaffold/tests/$t" &> scaffold/tests/"$t".log
+    r=$?
+    total=$((total+1))
+    if [ $r = 0 ]; then
+        echo $t: [OK]
+    else
+        echo $t: [FAIL]
+        fail=$((fail+1))
+    fi
+done
+
+tests="
+00_assignment
+01_comment
+02_printf
+03_struct
+04_for
+05_array
+06_case
+07_function
+08_while
+09_do_while
+
+10_pointer
+11_precedence
+12_hashdefine
+
+14_if
+15_recursion
+16_nesting
+17_enum
+18_include
+19_pointer_arithmetic
+
+20_pointer_comparison
+21_char_array
+
+
+
+25_quicksort
+
+
+29_array_address
+
+
+31_args
+
+
+33_ternary_op
+35_sizeof
+
+
+
+
+
+
+41_hashif
+
+43_void_param
+44_scoped_declarations
+45_empty_for
+
+47_switch_return
+48_nested_break
+
+
+50_logical_second_arg
+
+
+54_goto
+
+"
+
+#13_integer_literals     ; fail
+#22_floating_point       ; float
+#23_type_coercion        ; float
+#24_math_library         ; float
+#27_sizeof               ; float
+#28_strings              ; TODO: strncpy strchr strrchr memset memcpy memcmp
+#30_hanoi                ; fails with GCC
+#32_led                  ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "d") (p-expr (fixed "32"))))))
+#34_array_assignment     ; fails with GCC
+#36_array_initialisers   ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "Array") (p-expr (fixed "10"))) (initzer (initzer-list (initzer (p-expr (fixed "12"))) (initzer (p-expr (fixed "34"))) (initzer (p-expr (fixed "56"))) (initzer (p-expr (fixed "78"))) (initzer (p-expr (fixed "90"))) (initzer (p-expr (fixed "123"))) (initzer (p-expr (fixed "456"))) (initzer (p-expr (fixed "789"))) (initzer (p-expr (fixed "8642"))) (initzer (p-expr (fixed "9753"))))))))
+#37_sprintf              ; integer formatting unsupported
+#38_multiple_array_index ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (array-of (ident "a") (p-expr (fixed "4"))) (p-expr (fixed "4"))))))
+#39_typedef              ;unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename "MyFunStruct"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "MoreFunThanEver")))))
+
+#40_stdio                ; f* functions
+#42_function_pointer     ; f* functions
+#46_grep                 ; f* functions
+#49_bracket_evaluation   ; float
+#51_static               ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (ident "fred") (initzer (p-expr (fixed "1234"))))))
+#52_unnamed_enum         ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (enum-def (enum-def-list (enum-defn (ident "e")) (enum-defn (ident "f")) (enum-defn (ident "g")))))) (init-declr-list (init-declr (ident "h"))))
+#55_lshift_type          ; unsigned
+
+
+# FIXME: have no diff
+tests=
+for t in $tests; do
+    if [ ! -f scaffold/tinycc/"$t.c" ]; then
+        echo ' [SKIP]'
+        continue;
+    fi
+    sh build-aux/test.sh "scaffold/tinycc/$t" &> scaffold/tinycc/"$t".log
+    r=$?
+    total=$((total+1))
+    if [ $r = 0 ]; then
+        echo $t: [OK]
+    else
+        echo $t: [FAIL]
+        fail=$((fail+1))
+    fi
+done
+
+if [ $fail != 0 ]; then
+    echo FAILED: $fail/$total
+    exit 1
+else
+    echo PASS: $total
+fi
index 64a8fc4f7c922e853e724c45fb17d0fb517d0d56..ed57bc67af5de79bac1992d7595df272fa230d9c 100755 (executable)
@@ -65,12 +65,12 @@ exec ${GUILE-guile} -L $(dirname 0) -e '(mes-snarf)' -s "$0" "$@"
 
 (define %gcc? #t)
 
-(define-record-type file (make-file name content)
+(define-record-type <file> (make-file name content)
   file?
   (name file.name)
   (content file.content))
 
-(define-record-type function (make-function name formals annotation)
+(define-record-type <function> (make-function name formals annotation)
   function?
   (name function.name)
   (formals function.formals)
diff --git a/build-aux/test.sh b/build-aux/test.sh
new file mode 100755 (executable)
index 0000000..4454c48
--- /dev/null
@@ -0,0 +1,37 @@
+#! /bin/sh
+
+# Mes --- Maxwell Equations of Software
+# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+#
+# This file is part of Mes.
+#
+# Mes is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# Mes is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+set -ex
+
+t=${1-scaffold/tests/t}
+#rm -f "$t".i686-unknown-linux-gnu-out
+rm -f "$t".mes-out
+
+sh build-aux/cc-mes.sh "$t"
+
+r=0
+set +e
+"$t".mes-out | tee "$t".stdout
+m=$?
+
+[ $m = $r ]
+if [ -f "$t".expect ]; then
+    diff -u "$t".expect "$t".stdout;
+fi
index e7ff09e4f55bca28ef28c75da0b2f0a36cdc8ab4..df558c07e8901a840073e04e297f2a67ab0e4656 100755 (executable)
--- a/build.sh
+++ b/build.sh
 
 set -ex
 
-HEX2=${HEX2-hex2}
-M1=${M1-M1}
-BLOOD_ELF=${BLOOD_ELF-blood-elf}
-MES_SEED=${MES_SEED-../mes-seed}
+export CC=${CC-$(type -p gcc)}
+export CC32=${CC32-$(type -p i686-unknown-linux-gnu-gcc)}
+export MESCC=${MESCC-$(type -p mescc)}
+export MES_SEED=${MES_SEED-../mes-seed}
+export GUILE=${GUILE-$(type -p guile)}
+export MES_ARENA=${MES_ARENA-300000000}
+export MES_DEBUG=${MES_DEBUG-2}
 
-$M1 --LittleEndian --Architecture=1\
-    -f stage0/x86.M1\
-    -f $MES_SEED/crt1.M1\
-    -o crt1.hex2
-$M1 --LittleEndian --Architecture=1\
-    -f stage0/x86.M1\
-    -f $MES_SEED/libc-mes.M1\
-    -o libc-mes.hex2
-$M1 --LittleEndian --Architecture=1\
-    -f stage0/x86.M1\
-    -f $MES_SEED/mes.M1\
-    -o mes.hex2
-$BLOOD_ELF\
-    -f stage0/x86.M1\
-    -f $MES_SEED/mes.M1\
-    -f $MES_SEED/libc-mes.M1\
-    -o mes-blood-elf-footer.M1
-$M1 --LittleEndian --Architecture=1\
-    -f mes-blood-elf-footer.M1\
-    -o mes-blood-elf-footer.hex2
-$HEX2 --LittleEndian --Architecture=1 --BaseAddress=0x1000000\
-      -f stage0/elf32-header.hex2\
-      -f crt1.hex2\
-      -f libc-mes.hex2\
-      -f mes.hex2\
-      -f mes-blood-elf-footer.hex2\
-      --exec_enable\
-      -o src/mes
+export PREFIX=${PREFIX-/usr/local}
+export DATADIR=${DATADIR-$PREFIX/share/mes}
+export MODULEDIR=${MODULEDIR-$DATADIR/module}
 
-$M1 --LittleEndian --Architecture=1 -f\
-    stage0/x86.M1\
-    -f $MES_SEED/libc+tcc-mes.M1\
-    -o libc+tcc-mes.hex2
 
-cp crt1.hex2 lib
-cp libc-mes.hex2 lib
-cp libc+tcc-mes.hex2 lib
+if [ -n "$GUILE" ]; then
+    sh build-aux/build-guile.sh
+fi
 
-# TODO: after building from seed, build from src/mes.c
-# build-aux/mes-snarf.scm --mes src/gc.c
-# build-aux/mes-snarf.scm --mes src/lib.c
-# build-aux/mes-snarf.scm --mes src/math.c
-# build-aux/mes-snarf.scm --mes src/mes.c
-# build-aux/mes-snarf.scm --mes src/posix.c
-# build-aux/mes-snarf.scm --mes src/reader.c
-# build-aux/mes-snarf.scm --mes src/vector.c
+if [ -n "$CC" ]; then
+    sh build-aux/build-cc.sh
+    cp src/mes.gcc-out src/mes
+fi
+
+if [ -n "$CC32" ]; then
+    sh build-aux/build-mlibc.sh
+    cp src/mes.mlibc-out src/mes
+fi
+
+sh build-aux/build-mes.sh
diff --git a/check-boot.sh b/check-boot.sh
deleted file mode 100755 (executable)
index 380611a..0000000
+++ /dev/null
@@ -1,125 +0,0 @@
-#! /bin/bash
-
-# Mes --- Maxwell Equations of Software
-# Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of Mes.
-#
-# Mes is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or (at
-# your option) any later version.
-#
-# Mes is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -e
-
-export GUILE=${GUILE-guile}
-export MES=${MES-./src/mes}
-
-tests="
-
-00-zero.scm
-01-true.scm
-02-symbol.scm
-03-string.scm
-04-quote.scm
-05-list.scm
-06-tick.scm
-07-if.scm
-08-if-if.scm
-
-10-cons.scm
-11-list.scm
-12-car.scm
-13-cdr.scm
-14-exit.scm
-15-display.scm
-
-16-if-eq-quote.scm
-
-20-define.scm
-20-define-quoted.scm
-20-define-quote.scm
-
-21-define-procedure.scm
-22-define-procedure-2.scm
-23-begin.scm
-24-begin-define.scm
-25-begin-define-2.scm
-26-begin-define-later.scm
-27-lambda-define.scm
-28-define-define.scm
-29-lambda-define.scm
-2a-lambda-lambda.scm
-2b-define-lambda.scm
-2c-define-lambda-recurse.scm
-2d-define-lambda-set.scm
-2d-compose.scm
-2e-define-first.scm
-2f-define-second.scm
-2f-define-second-lambda.scm
-2g-vector.scm
-
-30-capture.scm
-31-capture-define.scm
-32-capture-modify-close.scm
-32-capture-modify-close.scm
-33-procedure-override-close.scm
-34-cdr-override-close.scm
-35-closure-modify.scm
-36-closure-override.scm
-37-closure-lambda.scm
-38-simple-format.scm
-39-global-define-override.scm
-3a-global-define-lambda-override.scm
-
-40-define-macro.scm
-41-when.scm
-42-if-when.scm
-43-or.scm
-44-or-if.scm
-45-pass-if.scm
-46-report.scm
-47-pass-if-eq.scm
-48-let.scm
-49-macro-override.scm
-4a-define-macro-define-macro.scm
-4b-define-macro-define.scm
-4c-quasiquote.scm
-4d-let-map.scm
-4e-let-global.scm
-
-50-primitive-load.scm
-51-module.scm
-52-define-module.scm
-53-closure-display.scm
-
-60-let-syntax.scm
-"
-
-for i in $tests; do
-    echo -n $i
-    if [ ! -f scaffold/boot/$i ]; then
-        echo ' [SKIP]'
-        continue;
-    fi
-    $GUILE -L guile -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i) >& /dev/null
-    x=$(
-        if [ -z "${i/5[0-9]-*/}" ]; then
-            cat scaffold/boot/$i | MES_BOOT=boot-00.scm $MES 2>&1;
-        elif [ -z "${i/6[0-9]-*/}" ]; then
-            cat scaffold/boot/$i | MES_BOOT=boot-01.scm $MES 2>&1;
-        else
-            MES_BOOT=scaffold/boot/$i $MES 2>&1;
-        fi
-     ) \
-        && echo ' [PASS]' \
-        || (r=$?; echo ' [FAIL]'; echo -e "$x"; echo scaffold/boot/$i; exit $r)
-done
diff --git a/check-mescc.sh b/check-mescc.sh
deleted file mode 100755 (executable)
index 598a746..0000000
+++ /dev/null
@@ -1,141 +0,0 @@
-#! /bin/sh
-
-# Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of Mes.
-#
-# Mes is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or (at
-# your option) any later version.
-#
-# Mes is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-export MES=${MES-src/mes}
-export MESCC=${MESCC-scripts/mescc}
-#export MES_ARENA=${MES_ARENA-200000000} > 12GB mem
-
-GUILE=${GUILE-guile}
-MES=${MES-src/mes}
-M1=${M1-M1}
-HEX2=${HEX2-hex2}
-MES_PREFIX=${MES_PREFIX-.}
-
-# $MESCC -E -o lib/crt1.E lib/crt1.c
-# $MESCC -c -o lib/crt1.M1 lib/crt1.E
-# $M1 --LittleEndian --Architecture=1 \
-#     -f stage0/x86.M1\
-#     -f lib/crt1.M1\
-#     > lib/crt1.hex2
-# $MESCC -E -o lib/libc-mes.E lib/libc-mes.c
-# $MESCC -c -o lib/libc-mes.M1 lib/libc-mes.E
-# $M1 --LittleEndian --Architecture=1\
-#     -f stage0/x86.M1\
-#     -f lib/libc-mes.M1\
-#     > lib/libc-mes.hex2
-
-tests="
-t
-00-exit-0
-01-return-0
-02-return-1
-03-call
-04-call-0
-05-call-1
-06-call-!1
-10-if-0
-11-if-1
-12-if-==
-13-if-!=
-14-if-goto
-15-if-!f
-16-if-t
-20-while
-21-char[]
-22-while-char[]
-23-pointer
-30-strlen
-31-eputs
-32-compare
-33-and-or
-34-pre-post
-35-compare-char
-36-compare-arithmetic
-37-compare-assign
-38-compare-call
-40-if-else
-41-?
-42-goto-label
-43-for-do-while
-44-switch
-45-void-call
-50-assert
-51-strcmp
-52-itoa
-53-strcpy
-54-argv
-60-math
-61-array
-63-struct-cell
-64-make-cell
-65-read
-70-printf
-71-struct-array
-72-typedef-struct-def
-73-union
-74-multi-line-string
-75-struct-union
-76-pointer-arithmetic
-77-pointer-assign
-78-union-struct
-79-int-array
-7a-struct-char-array
-7b-struct-int-array
-7c-dynarray
-7d-cast-char
-7e-struct-array-access
-7f-struct-pointer-arithmetic
-7g-struct-byte-word-field
-7h-struct-assign
-7i-struct-struct
-7j-strtoull
-7k-for-each-elem
-7l-struct-any-size-array
-7m-struct-char-array-assign
-7n-struct-struct-array
-80-setjmp
-81-qsort
-82-define
-"
-
-if [ ! -x ./i686-unknown-linux-gnu-tcc ]; then
-    tests=$(echo "$tests" | grep -Ev "02-return-1|05-call-1|80-setjmp|81-qsort")
-fi
-
-set +e
-fail=0
-total=0
-for t in $tests; do
-    sh test.sh "$t" &> scaffold/tests/$t.log
-    r=$?
-    total=$((total+1))
-    if [ $r = 0 ]; then
-        echo $t: [OK]
-    else
-        echo $t: [FAIL]
-        fail=$((fail+1))
-    fi
-done
-if [ $fail != 0 ]; then
-    echo FAILED: $fail/$total
-    exit 1
-else
-    echo PASS: $total
-fi
index cfdb61423b9206e9702908250ab0978b3e9464d5..9636c0c3eff7697a75e4eba2c01f2830fc3b0856 100755 (executable)
--- a/check.sh
+++ b/check.sh
 
 export GUILE=${GUILE-guile}
 export MES=${MES-src/mes}
-#export MES_ARENA=${MES_ARENA-200000000} #9GiB
+export MES_ARENA=${MES_ARENA-100000000}
 
 set -e
-bash check-boot.sh
+bash build-aux/check-boot.sh
 
 tests="
 tests/boot.test
@@ -85,4 +85,4 @@ else
     echo PASS: $total
 fi
 
-sh check-mescc.sh
+sh build-aux/check-mescc.sh
diff --git a/guile/guix/make.scm b/guile/guix/make.scm
deleted file mode 100644 (file)
index 470c920..0000000
+++ /dev/null
@@ -1,546 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; make
-
-;;; Code:
-
-(define-module (guix make)
-  #:use-module (ice-9 curried-definitions)
-  #:use-module (ice-9 format)
-  #:use-module (ice-9 optargs)
-  #:use-module (ice-9 popen)
-  #:use-module (ice-9 pretty-print)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 receive)
-
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-
-  #:use-module (guix records)
-  #:use-module (guix shell-utils)
-
-  #:export (base-name
-            build
-            check
-            clean
-            group
-            install
-            target-prefix?
-            check-target?
-            install-target?
-
-            cpp.mescc
-            compile.mescc
-            compile.gcc
-            ld
-
-            bin.mescc
-            bin.gcc
-            snarf
-            m1.as
-
-            crt1.mlibc-o
-            libc-gcc.mlibc-o
-            libc+tcc-gcc.mlibc-o
-
-            add-target
-            get-target
-
-            conjoin
-            system**
-            target-file-name
-
-            method
-            target
-            store
-            target-inputs
-            method-name
-            assert-gulp-pipe*
-
-            PATH-search-path
-
-            %MESCC
-            %HEX2
-            %M1
-
-            %targets
-            %status
-
-            %version
-            %prefix
-            %datadir
-            %docdir
-            %moduledir
-            %guiledir
-            %godir))
-
-(define %status 0)
-(define %targets '())
-(define %store-dir ".store")
-(mkdir-p %store-dir)
-(define %command-log (open-output-file "script"))
-
-(define (base-name file-name suffix)
-  (string-drop-right file-name (string-length suffix)))
-
-(define (conjoin . predicates)
-  (lambda (. arguments)
-    (every (cut apply <> arguments) predicates)))
-
-(define (system** . command)
-  (format %command-log "~a\n" (string-join command " "))
-  (unless (zero? (apply system* command))
-    (format (current-error-port) "FAILED:~s\n" command)
-    (exit 1)))
-
-(define (gulp-pipe* . command)
-  (let* ((port (apply open-pipe* (cons OPEN_READ command)))
-         (foo (set-port-encoding! port "ISO-8859-1"))
-         (output (read-string port))
-         (status (close-pipe port)))
-    (format %command-log "~a\n" (string-join command " "))
-    (values output status)))
-
-(define (assert-gulp-pipe* . command)
-  (receive (output status)
-      (apply gulp-pipe* command)
-    (if (zero? status) (string-trim-right output #\newline)
-        (error (format #f "pipe failed: ~d ~s"
-                       (or (status:exit-val status)
-                           (status:term-sig status)) command)))))
-
-(define-record-type* <method>
-  method make-method
-  method?
-  (name       method-name)
-  (build      method-build (default (lambda _ #t)))
-  (inputs     method-inputs (default (list))))
-
-(define-record-type* <target>
-  target make-target
-  target?
-  (file-name  target-file-name (default #f))       ; string
-  (file-names target-file-names (default '()))     ; (string)
-  (hash       target-hash (default #f))            ; string
-  (method     target-method (default method-file)) ; <method>
-  (inputs     target-inputs (default (list)))      ; list
-
-                                                   ; For check targets
-  (baseline   target-baseline (default #f))        ; string: file-name
-  (exit       target-exit (default #f))            ; number
-  (signal     target-signal (default #f)))         ; number
-
-(define method-file (method (name "FILE")))
-(define method-check
-  (method (name "CHECK")
-          (build (lambda (o t)
-                   (let* ((inputs (target-inputs t))
-                          (file-name (target-file-name (build (car inputs))))
-                          (run file-name)
-                          (baseline (target-baseline t))
-                          (exit (target-exit t))
-                          (signal (target-signal t))
-                          (log (string-append file-name "-check.log")))
-                     (format (current-error-port) "  CHECK\t~a" (basename file-name))
-                     (receive (output result)
-                         ;; FIXME: quiet MES tests are not fun
-                         (if (string-prefix? "tests/" run) (values #f (system* run "arg1" "arg2" "arg3" "arg4" "arg5"))
-                             (gulp-pipe* run "arg1" "arg2" "arg3" "arg4" "arg5"))
-                       (if (file-exists? log) (delete-file log))
-                       (if (or baseline (and output (not (string-null? output)))) (with-output-to-file log (lambda _ (display output))))
-                       (if baseline (set! result (system* "diff" "-bu" baseline log)))
-                       (let ((status (if (string? result) 0
-                                         (or (status:term-sig result) (status:exit-val result)))))
-                         (if (file-exists? log) (store #:add-file log))
-                         (format (current-error-port) "\t[~a]\n"
-                                 (if (or (and signal (= status signal))
-                                         (and exit (= status exit))) "OK"
-                                         (begin (set! %status 1) "FAIL"))))))))))
-
-(define %version (or (getenv "VERSION") "git"))
-(define %prefix (or (getenv "PREFIX") ""))
-(define %datadir "share/mes")
-(define %docdir "share/doc/mes")
-(define %moduledir (string-append %datadir "/module"))
-(define %guiledir (string-append "share/guile/site/" (effective-version)))
-(define %godir (string-append "lib/guile/" (effective-version) "/site-ccache"))
-
-(define* (method-cp #:key substitutes)
-  (method (name "INSTALL")
-          (build (lambda (o t)
-                   (let ((file-name (target-file-name t)))
-                     (mkdir-p (dirname file-name))
-                     (format (current-error-port) "  INSTALL\t~a\n" file-name)
-                     (copy-file ((compose target-file-name car target-inputs) t) file-name)
-                     (if substitutes
-                         (begin
-                           (substitute* file-name
-                             (("module/") (string-append %prefix "/" %moduledir "/"))
-                             (("@DATADIR@") (string-append %prefix "/" %datadir "/"))
-                             (("@DOCDIR@") (string-append %prefix "/" %docdir "/"))
-                             (("@GODIR@") (string-append %prefix "/" %godir "/"))
-                             (("@GUILEDIR@") (string-append %prefix "/" %guiledir "/"))
-                             (("@MODULEDIR@") (string-append %prefix "/" %moduledir "/"))
-                             (("@PREFIX@") (string-append %prefix "/"))
-                             (("@VERSION@") %version)))))))))
-
-(define (hash-target o)
-  (if (find (negate identity) (target-inputs o))
-      (format (current-error-port) "invalid inputs[~s]: ~s\n" (target-file-name o) (target-inputs o)))
-  (let ((inputs (target-inputs o)))
-    (if (null? inputs) (or (target-hash o) (target-hash (store #:add o)))
-        (let ((input-shas (map hash-target inputs)))
-          (and (every identity input-shas)
-               (let ((method (target-method o)))
-                 (string-hash (format #f "~s" (cons* (target-file-name o)
-                                                     (method-build method)
-                                                     (map target-hash (method-inputs method))
-                                                     input-shas)))))))))
-
-(define (string-hash o)
-  (number->string (hash o (expt 2 31))))
-
-(define (file-hash o)
-  (string-hash (with-input-from-file o read-string)))
-
-(define (store-file-name o)
-  (string-append %store-dir "/" (if (string? o) o
-                                    (target-hash o))))
-
-(define (link-or-cp existing-file new-file)
-  (catch #t
-    (lambda _ (link existing-file new-file))
-    (lambda _ (copy-file existing-file new-file))))
-
-(define (assert-link existing-file new-file)
-  (if (not (file-exists? new-file)) (link-or-cp existing-file new-file)))
-
-(define store
-  (let ((*store* '()))
-    (define (prune? o)
-      (let ((t (cdr o)))
-        (pair? (target-inputs t))))
-    (define ((file-name? file-name) o)
-      (let ((t (cdr o)))
-        (equal? (target-file-name t) (target-file-name file-name))))
-    (lambda* (#:key add add-file delete get key print prune)
-      (cond ((and add key) (let ((value (target (inherit add) (hash key))))
-                             (set! *store* (assoc-set! (filter (negate (file-name? add)) *store*) key value))
-                             (let ((file-name (target-file-name value)))
-                               (if (and file-name (file-exists? file-name))
-                                   (assert-link file-name (store-file-name value))))
-                             value))
-            (add (let ((key (if (null? (target-inputs add)) (file-hash (target-file-name add))
-                                (hash-target add))))
-                   (if (not key) (error "store: no hash for:" add))
-                   (store #:add add #:key key)))
-            (add-file
-             (or (and=> (find (lambda (t) (equal? (target-file-name t) add-file)) (map cdr *store*))
-                        (compose (cut store #:get <>) target-hash))
-                 (and (file-exists? add-file)
-                      (store #:add (target (file-name add-file))))
-                 (error (format #f "store add-file: no such file: ~s\n" add-file))))
-            ((and get key)
-             (or (assoc-ref *store* key)
-                 (let ((store-file (store-file-name key))
-                       (file-name (target-file-name get)))
-                   (and (file-exists? store-file)
-                        (if (file-exists? file-name) (delete-file file-name))
-                        (link-or-cp store-file file-name)
-                        (store #:add get #:key key)))))
-            (get (assoc-ref *store* get))
-            (delete (and (assoc-ref *store* delete)
-                         (set! *store* (filter (lambda (e) (not (equal? (car e) delete))) *store*))))
-            (print (pretty-print (map (lambda (e) (cons (target-file-name (cdr e)) (car e))) *store*)))
-            ((eq? prune 'file-system)
-             (set! *store* (filter prune? *store*)))
-            (else (error "store: dunno"))))))
-
-(define (build o)
-  (let ((hash (hash-target o)))
-    (or (and hash (store #:get o #:key hash))
-        (begin
-          ;;(format (current-error-port) "must rebuild hash=~s\n" hash)
-          (for-each build (target-inputs o))
-          (let ((method (target-method o)))
-            ((method-build method) method o))
-          (store #:add o #:key hash)))))
-
-(define* (check name #:key baseline (exit 0) (signal #f) (dependencies '()))
-  (target (file-name (string-append "check-" name))
-          (method method-check)
-          (inputs (cons (get-target name) dependencies))
-          (baseline baseline)
-          (exit exit)
-          (signal signal)))
-
-(define* (install name #:key (dir (dirname name)) (installed-name (basename name)) (prefix %prefix) substitutes (dependencies '()))
-  (target (file-name (string-append prefix "/" dir "/" installed-name))
-          (method (method-cp #:substitutes substitutes))
-          (inputs (cons (or (get-target name)
-                            (store #:add-file name)) dependencies))))
-
-(define* (group name #:key (dependencies '()))
-  (target (file-name name)
-          (inputs (map get-target dependencies))))
-
-(define (target->input-files o)
-  (let ((inputs (target-inputs o)))
-    (if (null? inputs) '()
-        (append (cons (target-file-name o) (target-file-names o)) (append-map target->input-files inputs)))))
-
-(define* (clean #:optional targets)
-  (for-each
-   delete-file
-   (filter file-exists? (delete-duplicates (append-map (cut target->input-files <>) (or targets %targets))))))
-
-(define (tree o)
-  (let ((inputs (target-inputs o)))
-    (if (null? inputs) o
-        (cons o (append (map tree inputs) (map tree (method-inputs (target-method o))))))))
-
-
-(define (verbose fmt . o)
-  ;;(apply format (cons* (current-error-port) fmt o))
-  #t
-  )
-
-(define* (PATH-search-path name #:key (default name))
-  (or (search-path (string-split (getenv "PATH") #\:) name)
-      (and (format (current-error-port) "warning: not found: ~a\n" name)
-           default)))
-
-(define %CC (or (getenv "CC") (PATH-search-path "gcc")))
-(define %CC32 (or (getenv "CC32")
-                  (PATH-search-path "i686-unknown-linux-gnu-gcc" #:default #f)
-                  (and (format (current-error-port) "warning: CC32 not found, trying gcc -m32")
-                       %CC)))
-
-(define %C-FLAGS
-  '("--std=gnu99"
-    "-O0"
-    "-g"
-    "-D"
-    "POSIX=1"
-    "-I" "src"
-    "-I" "lib"
-    "-I" "include"
-    "--include=lib/libc-gcc.c"))
-
-(define %C32-FLAGS
-  '("--std=gnu99"
-    "-O0"
-    "-fno-stack-protector"
-    "-g"
-    "-m32"
-    "-I" "src"
-    "-I" "lib"
-    "-I" "include"))
-
-(define* (CC.gcc #:key (libc #t) (cc (if (eq? libc #t) %CC %CC32)) (c-flags (if (eq? libc #t) %C-FLAGS %C32-FLAGS)) (defines '()) (includes '()))
-  (method (name "CC.gcc")
-          (build (lambda (o t)
-                   (let* ((input-files (map target-file-name (target-inputs t)))
-                          (command `(,cc
-                                     "-c"
-                                     ,@(append-map (cut list "-D" <>) defines)
-                                     ,@(append-map (cut list "-I" <>) includes)
-                                     ,@(if (eq? libc #t) '() '("-nostdinc" "-fno-builtin"))
-                                     ,@c-flags
-                                     "-o" ,(target-file-name t)
-                                     ,@(filter (cut string-suffix? ".c" <>) input-files))))
-                     (format (current-error-port) "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (apply system** command))))))
-
-(define* (CPP.mescc #:key (cc %MESCC) (defines '()) (includes '()))
-  (method (name "CPP.mescc")
-          (build (lambda (o t)
-                   (let ((input-files (map target-file-name (target-inputs t))))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (apply system**
-                            `(,cc
-                              "-E"
-                              ,@(append-map (cut list "-D" <>) defines)
-                              ,@(append-map (cut list "-I" <>) includes)
-                              "-o" ,(target-file-name t)
-                              ,@input-files)))))))
-
-(define %MESCC "scripts/mescc")
-(define* (CC.mescc #:key (cc %MESCC))
-  (method (name "CC.mescc")
-          (build (lambda (o t)
-                   (let ((input-files (map target-file-name (target-inputs t))))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (setenv "MES" "guile")
-                     (apply system**
-                            `("scripts/mescc" "-c"
-                              "-o" ,(target-file-name t)
-                              ,@input-files))
-                     (unsetenv "MES"))))
-          (inputs (list (store #:add-file "guile/language/c99/info.go")
-                        (store #:add-file "guile/language/c99/compiler.go")
-                        (store #:add-file "guile/mes/as-i386.go")
-                        (store #:add-file "guile/mes/as.go")
-                        (store #:add-file "guile/mes/elf.go")
-                        (store #:add-file "guile/mes/bytevectors.go")
-                        (store #:add-file "guile/mes/M1.go")
-                        (store #:add-file "guile/mes/guile.go")))))
-
-(define %M1 (or (PATH-search-path "M1" #:default #f)
-                (PATH-search-path "M0" #:default #f) ; M1 is in unreleased mescc-tools 0.2
-                (and (format (current-error-port) "error: no macro assembler found, please install mescc-tools\n")
-                     (exit 1))))
-(define %M0-FLAGS
-  '("--LittleEndian"))
-(define %M1-FLAGS
-  '("--LittleEndian"
-    "--Architecture=1"))
-(if (equal? (basename %M1) "M0")
-    (set! %M1-FLAGS %M0-FLAGS))
-
-(define* (M1.as #:key (m1 %M1) (m1-flags %M1-FLAGS))
-  (method (name "M1")
-          (build (lambda (o t)
-                   (let* ((input-files (map target-file-name (target-inputs t)))
-                          (input-files (filter (lambda (f) (string-suffix? "M1" f))
-                                               input-files)))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (with-output-to-file (target-file-name t)
-                       (lambda _
-                         (display
-                          (apply assert-gulp-pipe*
-                                 `(,m1
-                                   "-f"
-                                   "stage0/x86.M1"
-                                   ,@(append-map (cut list "-f" <>) input-files)
-                                   ,@m1-flags)))
-                         (newline))))))
-          (inputs (list (store #:add-file "stage0/x86.M1")))))
-
-(define* (LINK.gcc #:key (cc %CC) (libc #t) (c-flags (if (eq? libc #t) %C-FLAGS %C32-FLAGS)) (crt1 #f))
-  (method (name "LINK.gcc")
-          (build (lambda (o t)
-                   (let* ((input-files (map target-file-name (target-inputs t)))
-                          (command `(,cc
-                                     ,@c-flags
-                                     ,@(if (eq? libc #t) '() '("-nostdlib"))
-                                     "-o"
-                                     ,(target-file-name t)
-                                     ,@(if crt1 (list (target-file-name crt1))'())
-                                     ,@input-files
-                                     ,@(cond ((eq? libc #t) '())
-                                             (libc (list (target-file-name libc)))
-                                             (else '())))))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (apply system** command))))))
-
-(define SNARF "build-aux/mes-snarf.scm")
-(define (SNARF.mes mes?)
-  (method (name "SNARF.mes")
-          (build (lambda (o t)
-                   (let* ((input-files (map target-file-name (target-inputs t)))
-                          (command `(,SNARF
-                                     ,@(if mes? '("--mes") '())
-                                     ,@input-files)))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (apply system** command))))))
-
-(define* (cpp.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '()))
-  (let* ((c-target (target (file-name input-file-name)))
-         (base-name (base-name input-file-name ".c"))
-         (suffix ".E")
-         (target-file-name (string-append base-name suffix)))
-    (target (file-name target-file-name)
-            (inputs (cons c-target dependencies))
-            (method (CPP.mescc #:cc cc #:defines defines #:includes includes)))))
-
-(define* (compile.gcc input-file-name #:key (libc #t) (cc (if (eq? libc #t) %CC %CC32)) (defines '()) (includes '()) (dependencies '()))
-  (let* ((base-name (base-name input-file-name ".c"))
-         (cross (if (eq? libc #t) "" "mlibc-"))
-         (suffix (string-append "." cross "o"))
-         (target-file-name (string-append base-name suffix))
-         (c-target (target (file-name input-file-name))))
-    (target (file-name target-file-name)
-            (inputs (cons c-target dependencies))
-            (method (CC.gcc #:cc cc #:libc libc #:defines defines #:includes includes)))))
-
-(define* (compile.mescc input-file-name #:key (cc %MESCC) (defines '()) (includes '()) (dependencies '()))
-  (let* ((base-name (base-name input-file-name ".c"))
-         (suffix ".M1")
-         (target-file-name (string-append base-name suffix))
-         (E-target (cpp.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
-    (target (file-name target-file-name)
-            (inputs `(,E-target))
-            (method (CC.mescc #:cc cc)))))
-
-(define* (m1.as input-file-name #:key (cc %MESCC) (m1 %M1) (defines '()) (includes '()) (dependencies '()))
-  (let* ((base-name (base-name input-file-name ".c"))
-         ;;(foo (format (current-error-port) "m1.as[~s .m1] base=~s\n" input-file-name base-name))
-         (suffix ".hex2")
-         (target-file-name (string-append base-name suffix))
-         (m1-target (compile.mescc input-file-name #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
-    (target (file-name target-file-name)
-            (inputs `(,m1-target))
-            (method (M1.as #:m1 m1)))))
-
-(define* (bin.gcc input-file-name #:key (libc #t) (crt1 (if (eq? libc #t) #f crt1.mlibc-o)) (cc (if (eq? libc #t) %CC %CC32)) (dependencies '()) (defines '()) (includes '()))
-  (and cc
-       (let* ((base-name (base-name input-file-name ".c"))
-          (suffix (if (eq? libc #t) ".gcc" ".mlibc-gcc"))
-          (target-file-name (string-append base-name suffix))
-          (o-target (compile.gcc input-file-name #:cc cc #:libc libc #:defines defines #:includes includes #:dependencies dependencies)))
-     (target (file-name target-file-name)
-             (inputs (list o-target))
-             (method (LINK.gcc #:cc cc #:libc libc #:crt1 crt1))))))
-
-(define* (snarf input-file-name #:key (dependencies '()) (mes? #t))
-  (let* ((base-name (base-name input-file-name ".c"))
-         (suffixes '(".h" ".i" ".environment.i" ".symbol-names.i" ".symbols.i"  ".symbols.h"))
-         (suffixes (if mes? (map (cut string-append ".mes" <>) suffixes) suffixes))
-         (target-file-names (map (cut string-append base-name <>) suffixes))
-         (snarf-target (target (file-name input-file-name))))
-    (target (file-name (car target-file-names))
-            (file-names (cdr target-file-names))
-            (inputs (cons snarf-target dependencies))
-            ;;(inputs (list snarf-target))
-            (method (SNARF.mes mes?)))))
-
-(define ((target-prefix? prefix) o)
-  (string-prefix? prefix (target-file-name o)))
-
-(define (check-target? o)
-  (and o ((target-prefix? "check-") o)))
-
-(define (install-target? o)
-  (and o ((target-prefix? (or (getenv "PREFIX") "/")) o)))
-
-(define (add-target o)
-  (and o (set! %targets (append %targets (list o))))
-  o)
-(define (get-target o)
-  (if (target? o) o
-      (find (lambda (t) (equal? (target-file-name t) o)) %targets)))
-
-(define crt1.mlibc-o (compile.gcc "lib/crt1.c" #:libc #f))
-(define libc-gcc.mlibc-o (compile.gcc "lib/libc-gcc.c" #:libc #f))
-(define libc+tcc-gcc.mlibc-o (compile.gcc "lib/libc+tcc-gcc.c" #:libc #f))
diff --git a/guile/guix/records.scm b/guile/guix/records.scm
deleted file mode 100644 (file)
index a019373..0000000
+++ /dev/null
@@ -1,378 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix records)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 regex)
-  #:use-module (ice-9 rdelim)
-  #:export (define-record-type*
-            alist->record
-            object->fields
-            recutils->alist))
-
-;;; Commentary:
-;;;
-;;; Utilities for dealing with Scheme records.
-;;;
-;;; Code:
-
-(define-syntax record-error
-  (syntax-rules ()
-    "Report a syntactic error in use of CONSTRUCTOR."
-    ((_ constructor form fmt args ...)
-     (syntax-violation constructor
-                       (format #f fmt args ...)
-                       form))))
-
-(define (report-invalid-field-specifier name bindings)
-  "Report the first invalid binding among BINDINGS."
-  (let loop ((bindings bindings))
-    (syntax-case bindings ()
-      (((field value) rest ...)                   ;good
-       (loop #'(rest ...)))
-      ((weird _ ...)                              ;weird!
-       (syntax-violation name "invalid field specifier" #'weird)))))
-
-(define-syntax make-syntactic-constructor
-  (syntax-rules ()
-    "Make the syntactic constructor NAME for TYPE, that calls CTOR, and
-expects all of EXPECTED fields to be initialized.  DEFAULTS is the list of
-FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked
-fields, and DELAYED is the list of identifiers of delayed fields."
-    ((_ type name ctor (expected ...)
-        #:thunked thunked
-        #:delayed delayed
-        #:innate innate
-        #:defaults defaults)
-     (define-syntax name
-       (lambda (s)
-         (define (record-inheritance orig-record field+value)
-           ;; Produce code that returns a record identical to ORIG-RECORD,
-           ;; except that values for the FIELD+VALUE alist prevail.
-           (define (field-inherited-value f)
-             (and=> (find (lambda (x)
-                            (eq? f (car (syntax->datum x))))
-                          field+value)
-                    car))
-
-           ;; Make sure there are no unknown field names.
-           (let* ((fields     (map (compose car syntax->datum) field+value))
-                  (unexpected (lset-difference eq? fields '(expected ...))))
-             (when (pair? unexpected)
-               (record-error 'name s "extraneous field initializers ~a"
-                             unexpected)))
-
-           #`(make-struct/no-tail type
-                          #,@(map (lambda (field index)
-                                    (or (field-inherited-value field)
-                                        (if (innate-field? field)
-                                            (wrap-field-value
-                                             field (field-default-value field))
-                                            #`(struct-ref #,orig-record
-                                                          #,index))))
-                                  '(expected ...)
-                                  (iota (length '(expected ...))))))
-
-         (define (thunked-field? f)
-           (memq (syntax->datum f) 'thunked))
-
-         (define (delayed-field? f)
-           (memq (syntax->datum f) 'delayed))
-
-         (define (innate-field? f)
-           (memq (syntax->datum f) 'innate))
-
-         (define (wrap-field-value f value)
-           (cond ((thunked-field? f)
-                  #`(lambda () #,value))
-                 ((delayed-field? f)
-                  #`(delay #,value))
-                 (else value)))
-
-         (define default-values
-           ;; List of symbol/value tuples.
-           (map (match-lambda
-                  ((f v)
-                   (list (syntax->datum f) v)))
-                #'defaults))
-
-         (define (field-default-value f)
-           (car (assoc-ref default-values (syntax->datum f))))
-
-         (define (field-bindings field+value)
-           ;; Return field to value bindings, for use in 'let*' below.
-           (map (lambda (field+value)
-                  (syntax-case field+value ()
-                    ((field value)
-                     #`(field
-                        #,(wrap-field-value #'field #'value)))))
-                field+value))
-
-         (syntax-case s (inherit expected ...)
-           ((_ (inherit orig-record) (field value) (... ...))
-            #`(let* #,(field-bindings #'((field value) (... ...)))
-                #,(record-inheritance #'orig-record
-                                      #'((field value) (... ...)))))
-           ((_ (field value) (... ...))
-            (let ((fields (map syntax->datum #'(field (... ...)))))
-              (define (field-value f)
-                (or (find (lambda (x)
-                            (eq? f (syntax->datum x)))
-                          #'(field (... ...)))
-                    (wrap-field-value f (field-default-value f))))
-
-              (let ((fields (append fields (map car default-values))))
-                (cond ((lset= eq? fields '(expected ...))
-                       #`(let* #,(field-bindings
-                                  #'((field value) (... ...)))
-                           (ctor #,@(map field-value '(expected ...)))))
-                      ((pair? (lset-difference eq? fields
-                                               '(expected ...)))
-                       (record-error 'name s
-                                     "extraneous field initializers ~a"
-                                     (lset-difference eq? fields
-                                                      '(expected ...))))
-                      (else
-                       (record-error 'name s
-                                     "missing field initializers ~a"
-                                     (lset-difference eq?
-                                                      '(expected ...)
-                                                      fields)))))))
-           ((_ bindings (... ...))
-            ;; One of BINDINGS doesn't match the (field value) pattern.
-            ;; Report precisely which one is faulty, instead of letting the
-            ;; "source expression failed to match any pattern" error.
-            (report-invalid-field-specifier 'name
-                                            #'(bindings (... ...))))))))))
-
-(define-syntax-rule (define-field-property-predicate predicate property)
-  "Define PREDICATE as a procedure that takes a syntax object and, when passed
-a field specification, returns the field name if it has the given PROPERTY."
-  (define (predicate s)
-    (syntax-case s (property)
-      ((field (property values (... ...)) _ (... ...))
-       #'field)
-      ((field _ properties (... ...))
-       (predicate #'(field properties (... ...))))
-      (_ #f))))
-
-(define-syntax define-record-type*
-  (lambda (s)
-    "Define the given record type such that an additional \"syntactic
-constructor\" is defined, which allows instances to be constructed with named
-field initializers, à la SRFI-35, as well as default values.  An example use
-may look like this:
-
-  (define-record-type* <thing> thing make-thing
-    thing?
-    (name  thing-name (default \"chbouib\"))
-    (port  thing-port
-           (default (current-output-port)) (thunked))
-    (loc   thing-location (innate) (default (current-source-location))))
-
-This example defines a macro 'thing' that can be used to instantiate records
-of this type:
-
-  (thing
-    (name \"foo\")
-    (port (current-error-port)))
-
-The value of 'name' or 'port' could as well be omitted, in which case the
-default value specified in the 'define-record-type*' form is used:
-
-  (thing)
-
-The 'port' field is \"thunked\", meaning that calls like '(thing-port x)' will
-actually compute the field's value in the current dynamic extent, which is
-useful when referring to fluids in a field's value.
-
-A field can also be marked as \"delayed\" instead of \"thunked\", in which
-case its value is effectively wrapped in a (delay …) form.
-
-It is possible to copy an object 'x' created with 'thing' like this:
-
-  (thing (inherit x) (name \"bar\"))
-
-This expression returns a new object equal to 'x' except for its 'name'
-field and its 'loc' field---the latter is marked as \"innate\", so it is not
-inherited."
-
-    (define (field-default-value s)
-      (syntax-case s (default)
-        ((field (default val) _ ...)
-         (list #'field #'val))
-        ((field _ properties ...)
-         (field-default-value #'(field properties ...)))
-        (_ #f)))
-
-    (define-field-property-predicate delayed-field? delayed)
-    (define-field-property-predicate thunked-field? thunked)
-    (define-field-property-predicate innate-field? innate)
-
-    (define (wrapped-field? s)
-      (or (thunked-field? s) (delayed-field? s)))
-
-    (define (wrapped-field-accessor-name field)
-      ;; Return the name (an unhygienic syntax object) of the "real"
-      ;; getter for field, which is assumed to be a wrapped field.
-      (syntax-case field ()
-        ((field get properties ...)
-         (let* ((getter      (syntax->datum #'get))
-                (real-getter (symbol-append '% getter '-real)))
-           (datum->syntax #'get real-getter)))))
-
-    (define (field-spec->srfi-9 field)
-      ;; Convert a field spec of our style to a SRFI-9 field spec of the
-      ;; form (field get).
-      (syntax-case field ()
-        ((name get properties ...)
-         #`(name
-            #,(if (wrapped-field? field)
-                  (wrapped-field-accessor-name field)
-                  #'get)))))
-
-    (define (thunked-field-accessor-definition field)
-      ;; Return the real accessor for FIELD, which is assumed to be a
-      ;; thunked field.
-      (syntax-case field ()
-        ((name get _ ...)
-         (with-syntax ((real-get (wrapped-field-accessor-name field)))
-           #'(define-inlinable (get x)
-               ;; The real value of that field is a thunk, so call it.
-               ((real-get x)))))))
-
-    (define (delayed-field-accessor-definition field)
-      ;; Return the real accessor for FIELD, which is assumed to be a
-      ;; delayed field.
-      (syntax-case field ()
-        ((name get _ ...)
-         (with-syntax ((real-get (wrapped-field-accessor-name field)))
-           #'(define-inlinable (get x)
-               ;; The real value of that field is a promise, so force it.
-               (force (real-get x)))))))
-
-    (syntax-case s ()
-      ((_ type syntactic-ctor ctor pred
-          (field get properties ...) ...)
-       (let* ((field-spec #'((field get properties ...) ...))
-              (thunked    (filter-map thunked-field? field-spec))
-              (delayed    (filter-map delayed-field? field-spec))
-              (innate     (filter-map innate-field? field-spec))
-              (defaults   (filter-map field-default-value
-                                      #'((field properties ...) ...))))
-         (with-syntax (((field-spec* ...)
-                        (map field-spec->srfi-9 field-spec))
-                       ((thunked-field-accessor ...)
-                        (filter-map (lambda (field)
-                                      (and (thunked-field? field)
-                                           (thunked-field-accessor-definition
-                                            field)))
-                                    field-spec))
-                       ((delayed-field-accessor ...)
-                        (filter-map (lambda (field)
-                                      (and (delayed-field? field)
-                                           (delayed-field-accessor-definition
-                                            field)))
-                                    field-spec)))
-           #`(begin
-               (define-record-type type
-                 (ctor field ...)
-                 pred
-                 field-spec* ...)
-               thunked-field-accessor ...
-               delayed-field-accessor ...
-               (make-syntactic-constructor type syntactic-ctor ctor
-                                           (field ...)
-                                           #:thunked #,thunked
-                                           #:delayed #,delayed
-                                           #:innate #,innate
-                                           #:defaults #,defaults))))))))
-
-(define* (alist->record alist make keys
-                        #:optional (multiple-value-keys '()))
-  "Apply MAKE to the values associated with KEYS in ALIST.  Items in KEYS that
-are also in MULTIPLE-VALUE-KEYS are considered to occur possibly multiple
-times in ALIST, and thus their value is a list."
-  (let ((args (map (lambda (key)
-                     (if (member key multiple-value-keys)
-                         (filter-map (match-lambda
-                                      ((k . v)
-                                       (and (equal? k key) v)))
-                                     alist)
-                         (assoc-ref alist key)))
-                   keys)))
-    (apply make args)))
-
-(define (object->fields object fields port)
-  "Write OBJECT (typically a record) as a series of recutils-style fields to
-PORT, according to FIELDS.  FIELDS must be a list of field name/getter pairs."
-  (let loop ((fields fields))
-    (match fields
-      (()
-       object)
-      (((field . get) rest ...)
-       (format port "~a: ~a~%" field (get object))
-       (loop rest)))))
-
-(define %recutils-field-charset
-  ;; Valid characters starting a recutils field.
-  ;; info "(recutils) Fields"
-  (char-set-union char-set:upper-case
-                  char-set:lower-case
-                  (char-set #\%)))
-
-(define (recutils->alist port)
-  "Read a recutils-style record from PORT and return it as a list of key/value
-pairs.  Stop upon an empty line (after consuming it) or EOF."
-  (let loop ((line   (read-line port))
-             (result '()))
-    (cond ((eof-object? line)
-           (reverse result))
-          ((string-null? line)
-           (if (null? result)
-               (loop (read-line port) result)     ; leading space: ignore it
-               (reverse result)))                 ; end-of-record marker
-          (else
-           ;; Now check the first character of LINE, since that's what the
-           ;; recutils manual says is enough.
-           (let ((first (string-ref line 0)))
-             (cond
-              ((char-set-contains? %recutils-field-charset first)
-               (let* ((colon (string-index line #\:))
-                      (field (string-take line colon))
-                      (value (string-trim (string-drop line (+ 1 colon)))))
-                 (loop (read-line port)
-                       (alist-cons field value result))))
-              ((eqv? first #\#)                   ;info "(recutils) Comments"
-               (loop (read-line port) result))
-              ((eqv? first #\+)                   ;info "(recutils) Fields"
-               (let ((new-line (if (string-prefix? "+ " line)
-                                   (string-drop line 2)
-                                   (string-drop line 1))))
-                (match result
-                  (((field . value) rest ...)
-                   (loop (read-line port)
-                         `((,field . ,(string-append value "\n" new-line))
-                           ,@rest))))))
-              (else
-               (error "unmatched line" line))))))))
-
-;;; records.scm ends here
diff --git a/guile/guix/shell-utils.scm b/guile/guix/shell-utils.scm
deleted file mode 100644 (file)
index c6007c8..0000000
+++ /dev/null
@@ -1,225 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
-;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix shell-utils)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 regex)
-  #:use-module (srfi srfi-1)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
-  #:export (dump-port
-            mkdir-p
-            with-directory-excursion
-            substitute
-            substitute*))
-
-;;;
-;;; Directories.
-;;;
-
-(define (mkdir-p dir)
-  "Create directory DIR and all its ancestors."
-  (define absolute?
-    (string-prefix? "/" dir))
-
-  (define not-slash
-    (char-set-complement (char-set #\/)))
-
-  (let loop ((components (string-tokenize dir not-slash))
-             (root       (if absolute?
-                             ""
-                             ".")))
-    (match components
-      ((head tail ...)
-       (let ((path (string-append root "/" head)))
-         (catch 'system-error
-           (lambda ()
-             (mkdir path)
-             (loop tail path))
-           (lambda args
-             (if (= EEXIST (system-error-errno args))
-                 (loop tail path)
-                 (apply throw args))))))
-      (() #t))))
-
-(define-syntax-rule (with-directory-excursion dir body ...)
-  "Run BODY with DIR as the process's current directory."
-  (let ((init (getcwd)))
-   (dynamic-wind
-     (lambda ()
-       (chdir dir))
-     (lambda ()
-       body ...)
-     (lambda ()
-       (chdir init)))))
-
-(define* (dump-port in out
-                    #:key (buffer-size 16384)
-                    (progress (lambda (t k) (k))))
-  "Read as much data as possible from IN and write it to OUT, using chunks of
-BUFFER-SIZE bytes.  Call PROGRESS at the beginning and after each successful
-transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes
-transferred and the continuation of the transfer as a thunk."
-  (define buffer
-    (make-bytevector buffer-size))
-
-  (define (loop total bytes)
-    (or (eof-object? bytes)
-        (let ((total (+ total bytes)))
-          (put-bytevector out buffer 0 bytes)
-          (progress total
-                    (lambda ()
-                      (loop total
-                            (get-bytevector-n! in buffer 0 buffer-size)))))))
-
-  ;; Make sure PROGRESS is called when we start so that it can measure
-  ;; throughput.
-  (progress 0
-            (lambda ()
-              (loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
-
-\f
-;;;
-;;; Text substitution (aka. sed).
-;;;
-
-(define (with-atomic-file-replacement file proc)
-  "Call PROC with two arguments: an input port for FILE, and an output
-port for the file that is going to replace FILE.  Upon success, FILE is
-atomically replaced by what has been written to the output port, and
-PROC's result is returned."
-  (let* ((template (string-append file ".XXXXXX"))
-         (out      (mkstemp! template))
-         (mode     (stat:mode (stat file))))
-    (with-throw-handler #t
-      (lambda ()
-        (call-with-input-file file
-          (lambda (in)
-            (let ((result (proc in out)))
-              (close out)
-              (chmod template mode)
-              (rename-file template file)
-              result))))
-      (lambda (key . args)
-        (false-if-exception (delete-file template))))))
-
-(define (substitute file pattern+procs)
-  "PATTERN+PROCS is a list of regexp/two-argument-procedure pairs.  For each
-line of FILE, and for each PATTERN that it matches, call the corresponding
-PROC as (PROC LINE MATCHES); PROC must return the line that will be written as
-a substitution of the original line.  Be careful about using '$' to match the
-end of a line; by itself it won't match the terminating newline of a line."
-  (let ((rx+proc  (map (match-lambda
-                        (((? regexp? pattern) . proc)
-                         (cons pattern proc))
-                        ((pattern . proc)
-                         (cons (make-regexp pattern regexp/extended)
-                               proc)))
-                       pattern+procs)))
-    (with-atomic-file-replacement file
-      (lambda (in out)
-        (let loop ((line (read-line in 'concat)))
-          (if (eof-object? line)
-              #t
-              (let ((line (fold (lambda (r+p line)
-                                  (match r+p
-                                    ((regexp . proc)
-                                     (match (list-matches regexp line)
-                                       ((and m+ (_ _ ...))
-                                        (proc line m+))
-                                       (_ line)))))
-                                line
-                                rx+proc)))
-                (display line out)
-                (loop (read-line in 'concat)))))))))
-
-
-(define-syntax let-matches
-  ;; Helper macro for `substitute*'.
-  (syntax-rules (_)
-    ((let-matches index match (_ vars ...) body ...)
-     (let-matches (+ 1 index) match (vars ...)
-                  body ...))
-    ((let-matches index match (var vars ...) body ...)
-     (let ((var (match:substring match index)))
-       (let-matches (+ 1 index) match (vars ...)
-                    body ...)))
-    ((let-matches index match () body ...)
-     (begin body ...))))
-
-(define-syntax substitute*
-  (syntax-rules ()
-    "Substitute REGEXP in FILE by the string returned by BODY.  BODY is
-evaluated with each MATCH-VAR bound to the corresponding positional regexp
-sub-expression.  For example:
-
-  (substitute* file
-     ((\"hello\")
-      \"good morning\\n\")
-     ((\"foo([a-z]+)bar(.*)$\" all letters end)
-      (string-append \"baz\" letter end)))
-
-Here, anytime a line of FILE contains \"hello\", it is replaced by \"good
-morning\".  Anytime a line of FILE matches the second regexp, ALL is bound to
-the complete match, LETTERS is bound to the first sub-expression, and END is
-bound to the last one.
-
-When one of the MATCH-VAR is `_', no variable is bound to the corresponding
-match substring.
-
-Alternatively, FILE may be a list of file names, in which case they are
-all subject to the substitutions.
-
-Be careful about using '$' to match the end of a line; by itself it won't
-match the terminating newline of a line."
-    ((substitute* file ((regexp match-var ...) body ...) ...)
-     (let ()
-       (define (substitute-one-file file-name)
-         (substitute
-          file-name
-          (list (cons regexp
-                      (lambda (l m+)
-                        ;; Iterate over matches M+ and return the
-                        ;; modified line based on L.
-                        (let loop ((m* m+)  ; matches
-                                   (o  0)   ; offset in L
-                                   (r  '())) ; result
-                          (match m*
-                            (()
-                             (let ((r (cons (substring l o) r)))
-                               (string-concatenate-reverse r)))
-                            ((m . rest)
-                             (let-matches 0 m (match-var ...)
-                               (loop rest
-                                     (match:end m)
-                                     (cons*
-                                      (begin body ...)
-                                      (substring l o (match:start m))
-                                      r))))))))
-                ...)))
-
-       (match file
-         ((files (... ...))
-          (for-each substitute-one-file files))
-         ((? string? f)
-          (substitute-one-file f)))))))
-
index 9e60e044e93c826b7e221673b2a63bfb2f8705a8..1c80a8b87ab2015f9c0ed871a7d179d470b4cc66 100755 (executable)
@@ -2,7 +2,7 @@
 
 set -e
 
-PREFIX=${PREFIX-usr}
+export PREFIX=${PREFIX-/usr/local}
 MES_PREFIX=${MES_PREFIX-$PREFIX/share/mes}
 MES_SEED=${MES_SEED-../mes-seed}
 TINYCC_SEED=${TINYCC_SEED-../tinycc-seed}
@@ -12,17 +12,38 @@ cp src/mes $PREFIX/bin/mes
 
 mkdir -p $PREFIX/lib
 mkdir -p $MES_PREFIX/lib
-cp $MES_SEED/crt1.M1 $MES_PREFIX/lib/crt1.M1
-cp $MES_SEED/libc-mes.M1 $MES_PREFIX/lib/libc-mes.M1
-cp $MES_SEED/libc+tcc-mes.M1 $MES_PREFIX/lib/libc+tcc-mes.M1
-
-cp crt1.hex2 $MES_PREFIX/lib/crt1.hex2
-cp libc-mes.hex2 $MES_PREFIX/lib/libc-mes.hex2
-cp libc+tcc-mes.hex2 $MES_PREFIX/lib/libc+tcc-mes.hex2
-
 cp scripts/mescc $PREFIX/bin/mescc
-sed -e "s,@PREFIX@,$MES_PREFIX,g" \
-    scripts/mescc > $PREFIX/bin/mescc
 
 mkdir -p $MES_PREFIX
 tar -cf- doc guile include lib module scaffold stage0 | tar -xf- -C $MES_PREFIX
+
+GUILE_EFFECTIVE_VERSION=${GUILE_EFFECTIVE_VERSION-2.2}
+DATADIR=${MODULEDIR-$PREFIX/share/mes}
+DOCDIR=${MODULEDIR-$PREFIX/share/doc/mes}
+MODULEDIR=${MODULEDIR-$DATADIR/module}
+GUILEDIR=${MODULEDIR-$PREFIX/share/guile/site/$GUILE_EFFECTIVE_VERSION}
+GODIR=${GODIR-$PREFIX/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache}
+DOCDIR=${MODULEDIR-$PREFIX/share/doc/mes}
+
+chmod +w $PREFIX/bin/mescc
+sed \
+    -e "s,module/,$MODULEDIR/," \
+    -e "s,@DATADIR@,$DATADIR,g" \
+    -e "s,@DOCDIR@,$DOCDIR,g" \
+    -e "s,@GODIR@,$GODIR,g" \
+    -e "s,@GUILEDIR@,$GUILEDIR,g" \
+    -e "s,@MODULEDIR@,$MODULEDIR,g" \
+    -e "s,@PREFIX@,$PREFIX,g" \
+    -e "s,@VERSION@,$VERSION,g" \
+    scripts/mescc > $PREFIX/bin/mescc
+chmod +w $MODULEDIR/mes/boot-0.scm
+sed \
+    -e "s,module/,$MODULEDIR/," \
+    -e "s,@DATADIR@,$DATADIR,g" \
+    -e "s,@DOCDIR@,$DOCDIR,g" \
+    -e "s,@GODIR@,$GODIR,g" \
+    -e "s,@GUILEDIR@,$GUILEDIR,g" \
+    -e "s,@MODULEDIR@,$MODULEDIR,g" \
+    -e "s,@PREFIX@,$PREFIX,g" \
+    -e "s,@VERSION@,$VERSION,g" \
+    module/mes/boot-0.scm > $MODULEDIR/mes/boot-0.scm
diff --git a/make.scm b/make.scm
deleted file mode 100755 (executable)
index 20a3ff2..0000000
--- a/make.scm
+++ /dev/null
@@ -1,720 +0,0 @@
-#! /bin/sh
-# -*- scheme -*-
-exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$@"}
-!#
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-(use-modules (srfi srfi-26)
-             (guix shell-utils))
-
-;; FIXME: .go dependencies
-;; workaround: always update .go before calculating hashes
-;;(use-modules ((mes make) #:select (sytem**)))
-(define %scm-files
-  '("guix/make.scm"
-    "guix/records.scm"
-    "guix/shell-utils.scm"
-    "language/c99/compiler.scm"
-    "language/c99/info.scm"
-    "mes/as-i386.scm"
-    "mes/as.scm"
-    "mes/bytevectors.scm"
-    "mes/elf.scm"
-    "mes/guile.scm"
-    "mes/M1.scm"))
-(define %go-files (map (compose (cut string-append <> ".go") (cut string-drop-right <> 4)) %scm-files))
-(setenv "srcdir" ".")
-(setenv "host" %host-type)
-(with-directory-excursion "guile"
-  (apply system* `("guile"
-                   "--no-auto-compile"
-                   "-L" "."
-                   "-C" "."
-                   "-s"
-                   "../build-aux/compile-all.scm"
-                   ,@%scm-files)))
-
-(use-modules (srfi srfi-1)
-             (ice-9 curried-definitions)
-             (ice-9 match)
-             (guix make))
-
-(define crt1.hex2 (m1.as "lib/crt1.c"))
-(add-target crt1.hex2)
-
-(add-target crt1.mlibc-o)
-
-(define %HEX2-FLAGS
-  '("--LittleEndian"
-    "--Architecture=1"
-    "--BaseAddress=0x1000000"))
-(define %HEX2 (PATH-search-path "hex2"))
-
-(define* (LINK.hex2 #:key (hex2 %HEX2) (hex2-flags %HEX2-FLAGS) (crt1 crt1.hex2) (libc libc-mes.hex2) debug?)
-  (method (name "LINK.hex2")
-          (build (lambda (o t)
-                   (let* ((input-files (map target-file-name (target-inputs t)))
-                          ;; FIXME: snarf inputs
-                          (input-files (filter (lambda (f) (and (string-suffix? "hex2" f)
-                                                                (not (member f (cdr input-files)))))
-                                               input-files)))
-                     (format #t "  ~a\t ~a -> ~a\n" (method-name o) (string-join input-files) (target-file-name t))
-                     (with-output-to-file (target-file-name t)
-                       (lambda _
-                         (set-port-encoding! (current-output-port) "ISO-8859-1")
-                         (display
-                          (apply assert-gulp-pipe*
-                                 `(,hex2
-                                   ,@hex2-flags
-                                   "-f"
-                                   ,(if (not debug?) "stage0/elf32-0header.hex2"
-                                        "stage0/elf32-header.hex2")
-                                   ,@(if crt1 `("-f" ,(target-file-name crt1)) '())
-                                   ,@(if libc `("-f" ,(target-file-name libc)) '())
-                                   ,@(append-map (cut list "-f" <>) input-files)
-                                   "-f"
-                                   ,(if (not debug?) "stage0/elf-0footer.hex2"
-                                        "stage0/elf32-footer-single-main.hex2"))))))
-                     (chmod (target-file-name t) #o755))))
-          (inputs `(,(store #:add-file "stage0/elf32-0header.hex2")
-                    ,@(if crt1 (target-inputs crt1) '())
-                    ,@(if libc (target-inputs libc) '())
-                    ,(store #:add-file "stage0/elf-0footer.hex2")))))
-
-(define* (bin.mescc input-file-name #:key (cc %MESCC) (hex2 %HEX2) (m1 %M1) (crt1 crt1.hex2) (libc libc-mes.hex2) (dependencies '()) (defines '()) (includes '()))
-  (let* ((base-name (base-name input-file-name ".c"))
-         ;;(foo (format (current-error-port) "bin[~s .c] base=~s\n" input-file-name base-name))
-         (suffix (cond ((not libc) ".0-guile")
-                       ((eq? libc libc-mes.hex2) ".guile")
-                       ((eq? libc libc+tcc-mes.hex2) ".tcc-guile")
-                       (else ".mini-guile")))
-         (target-file-name (string-append base-name suffix))
-         (hex2-target (m1.as input-file-name #:m1 m1 #:cc cc #:defines defines #:includes includes #:dependencies dependencies)))
-    (target (file-name target-file-name)
-            (inputs `(,hex2-target
-                      ,@(if crt1 (list crt1) '())
-                      ,@(if libc (list libc) '())))
-            (method (LINK.hex2 #:hex2 hex2 #:crt1 crt1 #:libc libc #:debug? (eq? libc libc-mes.hex2))))))
-
-;;(define mini-libc-mes.E (m1.as "lib/mini-libc-mes.c"))
-
-(define libc-mes.hex2 (m1.as "lib/libc-mes.c"))
-(add-target libc-mes.hex2)
-
-(define mini-libc-mes.hex2 (m1.as "lib/mini-libc-mes.c"))
-(add-target mini-libc-mes.hex2)
-
-(define libc+tcc-mes.hex2 (m1.as "lib/libc+tcc-mes.c"))
-(add-target libc+tcc-mes.hex2)
-
-(add-target (bin.mescc "stage0/exit-42.c" #:libc #f))
-(add-target (check "stage0/exit-42.0-guile" #:exit 42))
-
-(add-target (cpp.mescc "lib/mini-libc-mes.c"))
-(add-target (compile.mescc "lib/mini-libc-mes.c"))
-
-(add-target (bin.mescc "stage0/exit-42.c" #:libc mini-libc-mes.hex2))
-(add-target (check "stage0/exit-42.mini-guile" #:exit 42))
-
-(add-target (cpp.mescc "lib/libc-mes.c"))
-(add-target (compile.mescc "lib/libc-mes.c"))
-
-(add-target (bin.mescc "stage0/exit-42.c"))
-(add-target (check "stage0/exit-42.guile" #:exit 42))
-
-(define* (add-scaffold-test name #:key (exit 0) (libc libc-mes.hex2) (libc-gcc libc-gcc.mlibc-o) (includes '()))
-  (add-target (bin.gcc (string-append "scaffold/tests/" name ".c") #:libc libc-gcc #:includes includes))
-  (add-target (check (string-append "scaffold/tests/" name ".mlibc-gcc") #:exit exit))
-
-  (add-target (bin.mescc (string-append "scaffold/tests/" name ".c") #:libc libc #:includes includes))
-  (add-target (check (string-append "scaffold/tests/" name "." (cond ((not libc) "0-")
-                                                                     ((eq? libc mini-libc-mes.hex2) "mini-")
-                                                                     ((eq? libc libc+tcc-mes.hex2) "tcc-")
-                                                                     (else "")) "guile") #:exit exit)))
-
-(add-target (compile.gcc "lib/crt1.c" #:libc #f))
-(add-target (compile.gcc "lib/libc-gcc.c" #:libc #f))
-(add-target (compile.gcc "lib/libc+tcc-gcc.c" #:libc #f))
-;;(add-target (compile.gcc "lib/libc+tcc-mes.c" #:libc #f))
-
-;;(add-scaffold-test "t" #:libc mini-libc-mes.hex2)
-(add-scaffold-test "t")
-;;(add-scaffold-test "t" #:libc libc+tcc-mes.hex2)
-
-;; tests/00: exit, functions without libc
-(add-scaffold-test "00-exit-0" #:libc #f)
-(add-scaffold-test "01-return-0" #:libc #f)
-(add-scaffold-test "02-return-1" #:libc #f #:exit 1)
-(add-scaffold-test "03-call" #:libc #f)
-(add-scaffold-test "04-call-0" #:libc #f)
-(add-scaffold-test "05-call-1" #:libc #f #:exit 1)
-(add-scaffold-test "06-call-!1" #:libc #f)
-(add-scaffold-test "07-include" #:libc #f #:includes '("scaffold/tests") #:exit 42)
-
-(add-target (group "check-scaffold-tests/0" #:dependencies (filter (target-prefix? "check-scaffold/tests/0") %targets)))
-
-;; tests/10: control without libc
-(for-each
- (cut add-scaffold-test <> #:libc #f)
- '("10-if-0"
-   "11-if-1"
-   "12-if-=="
-   "13-if-!="
-   "14-if-goto"
-   "15-if-!f"
-   "16-if-t"))
-
-(add-target (group "check-scaffold-tests/1" #:dependencies (filter (target-prefix? "check-scaffold/tests/1") %targets)))
-
-;; tests/20: loop without libc
-(for-each
- (cut add-scaffold-test <> #:libc #f)
- '("20-while"
-   "21-char[]"
-   "22-while-char[]"
-   "23-pointer"))
-
-(add-target (group "check-scaffold-tests/2" #:dependencies (filter (target-prefix? "check-scaffold/tests/2") %targets)))
-
-;; tests/30: call, compare: mini-libc-mes.c
-(for-each
- (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
- '("30-strlen"
-   "31-eputs"
-   "32-compare"
-   "33-and-or"
-   "34-pre-post"
-   "35-compare-char"
-   "36-compare-arithmetic"
-   "37-compare-assign"
-   "38-compare-call"))
-
-(add-target (group "check-scaffold-tests/3" #:dependencies (filter (target-prefix? "check-scaffold/tests/3") %targets)))
-
-;; tests/40: control: mini-libc-mes.c
-(for-each
- (cut add-scaffold-test <> #:libc mini-libc-mes.hex2)
- '("40-if-else"
-   "41-?"
-   "42-goto-label"
-   "43-for-do-while"
-   "44-switch"
-   "45-void-call"))
-
-(add-target (group "check-scaffold-tests/4" #:dependencies (filter (target-prefix? "check-scaffold/tests/4") %targets)))
-
-;; tests/50: libc-mes.c
-(for-each
- add-scaffold-test
- '("50-assert"
-   "51-strcmp"
-   "52-itoa"
-   "54-argv"))
-
-(add-target (group "check-scaffold-tests/5" #:dependencies (filter (target-prefix? "check-scaffold/tests/5") %targets)))
-
-;; tests/60: building up to scaffold/m.c, scaffold/micro-mes.c
-(for-each
- add-scaffold-test
- '("60-math"
-   "61-array"
-   "63-struct-cell"
-   "64-make-cell"
-   "65-read"
-   "66-local-char-array"))
-
-(add-target (group "check-scaffold-tests/6" #:dependencies (filter (target-prefix? "check-scaffold/tests/6") %targets)))
-
-;; tests/70: and beyond src/mes.c -- building up to 8cc.c, pcc.c, tcc.c, libguile/eval.c
-(for-each
- add-scaffold-test
- '("70-printf"
-   "71-struct-array"
-   "72-typedef-struct-def"
-   "73-union"
-   "74-multi-line-string"
-   "75-struct-union"
-   "76-pointer-arithmetic"
-   "77-pointer-assign"
-   "78-union-struct"
-   "79-int-array"
-   "7a-struct-char-array"
-   "7b-struct-int-array"
-   "7c-dynarray"
-   "7d-cast-char"
-   "7e-struct-array-access"
-   "7f-struct-pointer-arithmetic"
-   "7g-struct-byte-word-field"
-   "7h-struct-assign"
-   "7i-struct-struct"
-   "7j-strtoull"
-   "7k-for-each-elem"
-   "7l-struct-any-size-array"
-   "7m-struct-char-array-assign"
-   "7n-struct-struct-array"))
-
-(add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
-
-(add-target (group "check-scaffold-tests" #:dependencies (filter (target-prefix? "check-scaffold/tests") %targets)))
-
-;; tests/80: and beyond tinycc; building GNU GCC and dependencies
-(for-each
- (cut add-scaffold-test <> #:libc libc+tcc-mes.hex2 #:libc-gcc libc+tcc-gcc.mlibc-o)
- '("80-setjmp"
-   "81-qsort"
-   "82-define"))
-
-(add-target (group "check-scaffold-tests/8" #:dependencies (filter (target-prefix? "check-scaffold/tests/8") %targets)))
-
-(add-target (group "check-scaffold-tests" #:dependencies (filter (target-prefix? "check-scaffold/tests") %targets)))
-
-(add-target (cpp.mescc "lib/libc+tcc-mes.c"))
-(add-target (compile.mescc "lib/libc+tcc-mes.c"))
-
-(define* (add-tcc-test name)
-  (add-target (bin.gcc (string-append "scaffold/tinycc/" name ".c") #:libc libc-gcc.mlibc-o #:includes '("scaffold/tinycc")))
-  (add-target (check (string-append "scaffold/tinycc/" name ".mlibc-gcc") #:baseline (string-append "scaffold/tinycc/" name ".expect")))
-
-  (add-target (bin.mescc (string-append "scaffold/tinycc/" name ".c") #:includes '("scaffold/tinycc")))
-  (add-target (check (string-append "scaffold/tinycc/" name ".guile") #:baseline (string-append "scaffold/tinycc/" name ".expect"))))
-(map
- add-tcc-test
- '("00_assignment"
-   "01_comment"
-   "02_printf"
-   "03_struct"
-   "04_for"
-   "05_array"
-   "06_case"
-   "07_function"
-   "08_while"
-   "09_do_while"
-
-   "10_pointer"
-   "11_precedence"
-   "12_hashdefine"
-   "13_integer_literals"
-   "14_if"
-   "15_recursion"
-   "16_nesting"
-   "17_enum"
-   "18_include"
-   "19_pointer_arithmetic"
-
-   "20_pointer_comparison"
-   "21_char_array"
-   ;;"22_floating_point"       ; float
-   ;;"23_type_coercion"        ; float
-   ;;"24_math_library"         ; float
-   "25_quicksort"
-   ;;"27_sizeof"               ; float
-   ;;"28_strings"              ; TODO: strncpy strchr strrchr memset memcpy memcmp
-   "29_array_address"
-
-   ;;"30_hanoi"                ; fails with GCC
-   "31_args"
-   ;;"32_led"                  ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "d") (p-expr (fixed "32"))))))
-   ;;"34_array_assignment"     ; fails with GCC
-   "33_ternary_op"
-   "35_sizeof"
-   ;;"36_array_initialisers"   ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (ident "Array") (p-expr (fixed "10"))) (initzer (initzer-list (initzer (p-expr (fixed "12"))) (initzer (p-expr (fixed "34"))) (initzer (p-expr (fixed "56"))) (initzer (p-expr (fixed "78"))) (initzer (p-expr (fixed "90"))) (initzer (p-expr (fixed "123"))) (initzer (p-expr (fixed "456"))) (initzer (p-expr (fixed "789"))) (initzer (p-expr (fixed "8642"))) (initzer (p-expr (fixed "9753"))))))))
-   ;; "37_sprintf"             ; integer formatting unsupported
-   ;;"38_multiple_array_index" ; unspported: (decl (decl-spec-list (type-spec (fixed-type "int"))) (init-declr-list (init-declr (array-of (array-of (ident "a") (p-expr (fixed "4"))) (p-expr (fixed "4"))))))
-   ;;"39_typedef"              ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (typename "MyFunStruct"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "MoreFunThanEver")))))
-
-   ;;"40_stdio"                ; f* functions
-   "41_hashif"
-   ;;"42_function_pointer"     ; f* functions
-   "43_void_param"
-   "44_scoped_declarations"
-   "45_empty_for"           ; unsupported
-   ;;"46_grep"                 ; f* functions
-   "47_switch_return"
-   "48_nested_break"
-   ;;"49_bracket_evaluation"   ; float
-
-   "50_logical_second_arg"
-   ;;"51_static"               ; unsupported: (decl (decl-spec-list (stor-spec (static)) (type-spec (fixed-type "int"))) (init-declr-list (init-declr (ident "fred") (initzer (p-expr (fixed "1234"))))))
-   ;;"52_unnamed_enum"         ; unsupported: (decl (decl-spec-list (stor-spec (typedef)) (type-spec (enum-def (enum-def-list (enum-defn (ident "e")) (enum-defn (ident "f")) (enum-defn (ident "g")))))) (init-declr-list (init-declr (ident "h"))))
-   "54_goto"
-   ;;"55_lshift_type"          ; unsigned
-   ))
-
-(add-target (group "check-scaffold-tinycc" #:dependencies (filter (target-prefix? "check-scaffold/tinycc") %targets)))
-
-;;(add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
-
-(add-target (bin.gcc "scaffold/main.c"))
-(add-target (check "scaffold/main.gcc" #:exit 42))
-
-(add-target (bin.gcc "scaffold/main.c" #:libc #f))
-(add-target (check "scaffold/main.mlibc-gcc" #:exit 42))
-
-(add-target (bin.mescc "scaffold/main.c" #:libc mini-libc-mes.hex2))
-(add-target (check "scaffold/main.mini-guile" #:exit 42))
-
-(add-target (bin.mescc "scaffold/main.c"))
-(add-target (check "scaffold/main.guile" #:exit 42))
-
-
-(add-target (bin.gcc "scaffold/hello.c"))
-(add-target (check "scaffold/hello.gcc" #:exit 42))
-
-(add-target (bin.gcc "scaffold/hello.c" #:libc libc-gcc.mlibc-o))
-(add-target (check "scaffold/hello.mlibc-gcc" #:exit 42))
-
-(add-target (bin.mescc "scaffold/hello.c" #:libc mini-libc-mes.hex2))
-(add-target (check "scaffold/hello.mini-guile" #:exit 42))
-
-(add-target (bin.mescc "scaffold/hello.c"))
-(add-target (check "scaffold/hello.guile" #:exit 42))
-
-
-(add-target (bin.gcc "scaffold/m.c"))
-(add-target (check "scaffold/m.gcc" #:exit 255))
-
-(add-target (bin.gcc "scaffold/m.c" #:libc libc-gcc.mlibc-o))
-(add-target (check "scaffold/m.mlibc-gcc" #:exit 255))
-
-(add-target (bin.mescc "scaffold/m.c"))
-(add-target (check "scaffold/m.guile" #:exit 255))
-
-(add-target (bin.gcc "scaffold/micro-mes.c" #:libc libc-gcc.mlibc-o))
-(add-target (check "scaffold/micro-mes.mlibc-gcc" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
-
-(add-target (bin.mescc "scaffold/micro-mes.c"))
-(add-target (check "scaffold/micro-mes.guile" #:exit 6)) ; arg1 arg2 arg3 arg4 arg5
-
-(add-target (group "check-scaffold" #:dependencies (filter (target-prefix? "check-scaffold") %targets)))
-
-(define snarf-bases
-  '("gc" "lib" "math" "mes" "posix" "reader" "vector"))
-
-(define bla
-  `(,@(map (cut string-append "src/" <> ".c") snarf-bases)
-    ,@(map (cut string-append "src/" <> ".mes.h") snarf-bases)
-    ,@(map (cut string-append "src/" <> ".mes.i") snarf-bases)
-    ,@(map (cut string-append "src/" <> ".mes.environment.i") snarf-bases)))
-
-(define gcc-snarf-targets
-  (list
-   (add-target (snarf "src/gc.c" #:mes? #f))
-   (add-target (snarf "src/lib.c" #:mes? #f))
-   (add-target (snarf "src/math.c" #:mes? #f))
-   (add-target (snarf "src/mes.c" #:mes? #f))
-   (add-target (snarf "src/posix.c" #:mes? #f))
-   (add-target (snarf "src/reader.c" #:mes? #f))
-   (add-target (snarf "src/vector.c" #:mes? #f))))
-
-(define mes-snarf-targets
-  (list
-   (add-target (snarf "src/gc.c"))
-   (add-target (snarf "src/lib.c" #:mes? #t))
-   (add-target (snarf "src/math.c" #:mes? #t))
-   (add-target (snarf "src/mes.c" #:mes? #t))
-   (add-target (snarf "src/posix.c" #:mes? #t))
-   (add-target (snarf "src/reader.c" #:mes? #t))
-   (add-target (snarf "src/vector.c" #:mes? #t))))
-
-(add-target (bin.gcc "src/mes.c" #:dependencies gcc-snarf-targets
-                     #:defines `("POSIX=1"
-                                 ,(string-append "VERSION=\"" %version "\"")
-                                 ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
-                                 ,(string-append "PREFIX=\"" %prefix "\""))
-                     #:includes '("src")))
-
-(add-target (bin.gcc "src/mes.c" #:libc libc-gcc.mlibc-o
-                     #:dependencies mes-snarf-targets
-                     #:defines `(,(string-append "VERSION=\"" %version "\"")
-                                 ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
-                                 ,(string-append "PREFIX=\"" %prefix "\""))
-                     #:includes '("src")))
-
-(add-target (bin.mescc "src/mes.c" #:dependencies mes-snarf-targets
-                       #:defines `(,(string-append "VERSION=\"" %version "\"")
-                                   ,(string-append "MODULEDIR=\"" (string-append %prefix (if (string-null? %prefix) "" "/") %moduledir "/") "\"")
-                                   ,(string-append "PREFIX=\"" %prefix "\""))
-                       #:includes '("src")))
-
-(define mes-tests
-  '("tests/boot.test"
-    "tests/read.test"
-    "tests/base.test"
-    "tests/quasiquote.test"
-    "tests/let.test"
-    "tests/closure.test"
-    "tests/scm.test"
-    "tests/display.test"
-    "tests/cwv.test"
-    "tests/math.test"
-    "tests/vector.test"
-    "tests/srfi-1.test"
-    "tests/srfi-13.test"
-    "tests/srfi-14.test"
-    "tests/srfi-16.test"
-    "tests/srfi-43.test"
-    "tests/optargs.test"
-    "tests/fluids.test"
-    "tests/catch.test"
-    "tests/record.test"
-    "tests/getopt-long.test"
-    "tests/guile.test"
-    "tests/syntax.test"
-    "tests/let-syntax.test"
-    "tests/pmatch.test"
-    "tests/match.test"
-    "tests/psyntax.test"
-    ;;sloooowwww/broken?
-    ;;"tests/peg.test"
-    ))
-
-(define (add-guile-test o)
-  (add-target (target (file-name o)))
-  (add-target (check o)))
-
-(define (add-mes.gcc-test o)
-  (add-target (target (file-name o)))
-  (add-target (check o #:dependencies (list (get-target "src/mes.mlibc-gcc")))))
-
-(define (add-mes.guile-test o)
-  (add-target (target (file-name o)))
-  (add-target (check o #:dependencies (list (get-target "src/mes.guile")))))
-
-(for-each add-guile-test (map (cut string-append <> "-guile") mes-tests))
-
-;; takes long, and should always pass if...
-;;(for-each add-mes.gcc-test mes-tests)
-
-;; ...mes.guile passes :-)
-(for-each add-mes.guile-test mes-tests)
-
-(add-target (group "check-tests" #:dependencies (filter (target-prefix? "check-tests/") %targets)))
-
-(add-target (install "scripts/mescc" #:dir "bin" #:substitutes #t))
-(define bootstrap? #f)
-(if bootstrap?
-    (add-target (install "src/mes.mes" #:dir "bin" #:installed-name "mes"))
-    (add-target (install "src/mes.guile" #:dir "bin" #:installed-name "mes")))
-
-(define* ((install-dir #:key dir) name)
-  (add-target (install name  #:dir (string-append dir "/" (dirname name)))))
-
-(add-target (install "module/mes/boot-0.scm" #:dir (string-append %moduledir "/mes") #:substitutes #t))
-(add-target (install "module/language/c99/compiler.mes" #:dir (string-append %moduledir "/language/c99") #:substitutes #t))
-
-(define %module-dir "share/mes")
-(for-each
- (lambda (f)
-   ((install-dir #:dir (string-append %module-dir)) f))
- '(;;"module/language/c99/compiler.mes"
-   "module/language/c99/compiler.scm"
-   "module/language/c99/info.mes"
-   "module/language/c99/info.scm"
-   "module/language/paren.mes"
-   "module/mes/M1.mes"
-   "module/mes/M1.scm"
-   "module/mes/as-i386.mes"
-   "module/mes/as-i386.scm"
-   "module/mes/as.mes"
-   "module/mes/as.scm"
-   "module/mes/base.mes"
-   ;;"module/mes/boot-0.scm"
-   "module/mes/boot-00.scm"
-   "module/mes/boot-01.scm"
-   "module/mes/boot-02.scm"
-   "module/mes/bytevectors.mes"
-   "module/mes/bytevectors.scm"
-   "module/mes/catch.mes"
-   "module/mes/display.mes"
-   "module/mes/elf.mes"
-   "module/mes/elf.scm"
-   "module/mes/fluids.mes"
-   "module/mes/getopt-long.mes"
-   "module/mes/getopt-long.scm"
-   "module/mes/guile.mes"
-   "module/mes/guile.scm"
-   "module/mes/lalr.mes"
-   "module/mes/lalr.scm"
-   "module/mes/let.mes"
-   "module/mes/match.mes"
-   "module/mes/match.scm"
-   "module/mes/module.mes"
-   "module/mes/optargs.mes"
-   "module/mes/optargs.scm"
-   "module/mes/peg.mes"
-   "module/mes/peg/cache.scm"
-   "module/mes/peg/codegen.scm"
-   "module/mes/peg/simplify-tree.scm"
-   "module/mes/peg/string-peg.scm"
-   "module/mes/peg/using-parsers.scm"
-   "module/mes/pmatch.mes"
-   "module/mes/pmatch.scm"
-   "module/mes/posix.mes"
-   "module/mes/pretty-print.mes"
-   "module/mes/pretty-print.scm"
-   "module/mes/psyntax-0.mes"
-   "module/mes/psyntax-1.mes"
-   "module/mes/psyntax.mes"
-   "module/mes/psyntax.pp"
-   "module/mes/psyntax.ss"
-   "module/mes/quasiquote.mes"
-   "module/mes/quasisyntax.mes"
-   "module/mes/quasisyntax.scm"
-   "module/mes/repl.mes"
-   "module/mes/scm.mes"
-   "module/mes/syntax.mes"
-   "module/mes/syntax.scm"
-   "module/mes/test.mes"
-   "module/mes/tiny-0.mes"
-   "module/mes/type-0.mes"
-   "module/nyacc/lalr.mes"
-   "module/nyacc/lang/c99/cpp.mes"
-   "module/nyacc/lang/c99/parser.mes"
-   "module/nyacc/lang/c99/pprint.mes"
-   "module/nyacc/lang/calc/parser.mes"
-   "module/nyacc/lang/util.mes"
-   "module/nyacc/lex.mes"
-   "module/nyacc/parse.mes"
-   "module/nyacc/util.mes"
-   "module/rnrs/arithmetic/bitwise.mes"
-   "module/srfi/srfi-0.mes"
-   "module/srfi/srfi-1.mes"
-   "module/srfi/srfi-1.scm"
-   "module/srfi/srfi-13.mes"
-   "module/srfi/srfi-14.mes"
-   "module/srfi/srfi-16.mes"
-   "module/srfi/srfi-16.scm"
-   "module/srfi/srfi-26.mes"
-   "module/srfi/srfi-26.scm"
-   "module/srfi/srfi-43.mes"
-   "module/srfi/srfi-9.mes"
-   "module/sxml/xpath.mes"
-   "module/sxml/xpath.scm"))
-
-(define* ((install-guile-dir #:key dir) name)
-  (add-target (install (string-append "guile/" name) #:dir (string-append dir "/" (dirname name)))))
-
-(for-each
- (lambda (f)
-   ((install-guile-dir #:dir (string-append %guiledir)) f))
- %scm-files)
-
-(for-each
- (lambda (f)
-   ((install-guile-dir #:dir (string-append %godir)) f))
- %go-files)
-
-(add-target (install "lib/crt1.hex2" #:dir "lib"))
-(add-target (install "lib/libc-mes.M1" #:dir "lib"))
-(add-target (install "lib/libc-mes.hex2" #:dir "lib"))
-(add-target (install "lib/libc+tcc-mes.M1" #:dir "lib"))
-(add-target (install "lib/libc+tcc-mes.hex2" #:dir "lib"))
-(add-target (install "lib/mini-libc-mes.M1" #:dir "lib"))
-(add-target (install "lib/mini-libc-mes.hex2" #:dir "lib"))
-
-(add-target (install "lib/crt1.mlibc-o" #:dir "lib"))
-(add-target (install "lib/libc-gcc.mlibc-o" #:dir "lib"))
-(add-target (install "lib/libc+tcc-gcc.mlibc-o" #:dir "lib"))
-
-(for-each
- (lambda (f)
-   ((install-dir #:dir "share/") f))
- '("include/alloca.h"
-   "include/assert.h"
-   "include/ctype.h"
-   "include/dlfcn.h"
-   "include/errno.h"
-   "include/fcntl.h"
-   "include/features.h"
-   "include/inttypes.h"
-   "include/libgen.h"
-   "include/limits.h"
-   "include/locale.h"
-   "include/math.h"
-   "include/mlibc.h"
-   "include/setjmp.h"
-   "include/signal.h"
-   "include/stdarg.h"
-   "include/stdbool.h"
-   "include/stdint.h"
-   "include/stdio.h"
-   "include/stdlib.h"
-   "include/stdnoreturn.h"
-   "include/string.h"
-   "include/strings.h"
-   "include/sys/cdefs.h"
-   "include/sys/mman.h"
-   "include/sys/stat.h"
-   "include/sys/time.h"
-   "include/sys/timeb.h"
-   "include/sys/types.h"
-   "include/sys/ucontext.h"
-   "include/sys/wait.h"
-   "include/time.h"
-   "include/unistd.h"))
-
-(for-each
- (compose add-target (cut install <> #:dir "share/doc/mes"))
- '("AUTHORS"
-   ;;"ChangeLog"
-   "BOOTSTRAP"
-   "COPYING"
-   "HACKING"
-   "INSTALL"
-   "NEWS"
-   "README"
-   "doc/ANNOUNCE-0.11"))
-
-(add-target (install "doc/fosdem/fosdem.pdf" #:dir "share/doc/mes"))
-
-(define (main args)
-  (cond ((member "all-go" args) #t)
-        ((member "clean-go" args) (map delete-file (filter file-exists? %go-files)))
-        ((member "clean" args) (clean))
-        ((member "list" args) (display (string-join (map target-file-name %targets) "\n" 'suffix)))
-        ((member "help" args) (format #t "Usage: ./make.scm [TARGET]...
-
-Targets:
-    all
-    all-go
-    check
-    clean
-    clean-go
-    help~a
-    install
-    list
-"
-                                      (string-join (filter (negate (cut string-index <> #\/)) (map target-file-name %targets)) "\n    " 'prefix)))
-        (else
-         (let ((targets (match args
-                          (() (filter (conjoin (negate install-target?)
-                                               (negate check-target?))
-                                      %targets))
-                          ((? (cut member "all" <>)) (filter (conjoin (negate install-target?)
-                                                                      (negate check-target?))
-                                                             %targets))
-                          ((? (cut member "check" <>)) (filter check-target? %targets))
-                          ((? (cut member "install" <>)) (filter install-target? %targets))
-                          (_ (filter-map (cut get-target <>) args)))))
-           ;;((@@ (guix make) store) #:print 0)
-           (for-each build targets)
-           (exit %status)))))
-
-(main (cdr (command-line)))
index a1acea496ed5f49ff427b1ab1a0fb57ab8e427f5..b1259b09d6ac388a034532e4b10a37f0215810e8 100644 (file)
            (info (append-text info (wrap-as (i386:pop-accu)))))
       info)))
 
+(define (comment? o)
+  (and (pair? o) (pair? (car o)) (eq? (caar o) #:comment)))
+
 (define (clause->info info i label last?)
   (define clause-label
     (string-append label "clause" (number->string i)))
          info))
 
       ((or ,a ,b)
-       (let* ((here (number->string (length (.text info))))
+       (let* ((here (number->string (length (if mes? (.text info)
+                                                (filter (negate comment?) (.text info))))))
               (skip-b-label (string-append label "_skip_b_" here))
               (b-label (string-append label "_b_" here))
               (info ((test-jump-label->info info b-label) a))
index c60a43b8827d5c92b2dd0bda52143fa6ea678d57..88b70c4afe4086e378f4eb12eb028028d889402b 100644 (file)
@@ -19,6 +19,7 @@
  */
 
 #define MES_MINI 1
+//#define HAVE_UNION 1
 #if POSIX
 #error "POSIX not supported"
 #endif
 #include <string.h>
 #include <mlibc.h>
 
-int ARENA_SIZE = 100000;
-int MAX_ARENA_SIZE = 40000000;
-int GC_SAFETY = 10000;
+int ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
+int MAX_ARENA_SIZE = 300000000;
+int JAM_SIZE = 20000;
+int GC_SAFETY = 2000;
 
 char *g_arena = 0;
 typedef int SCM;
@@ -42,6 +44,7 @@ int g_free = 0;
 SCM g_continuations = 0;
 SCM g_symbols = 0;
 SCM g_macros = 0;
+SCM g_ports = 0;
 SCM g_stack = 0;
 // a/env
 SCM r0 = 0;
@@ -52,7 +55,7 @@ SCM r2 = 0;
 // continuation
 SCM r3 = 0;
 
-enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
+enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TPORT, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVARIABLE, TVECTOR, TBROKEN_HEART};
 
 struct scm {
   enum type_t type;
@@ -172,6 +175,24 @@ struct scm scm_vm_call_with_values2 = {TSPECIAL, "*vm-call-with-values2*",0};
 struct scm scm_vm_call_with_current_continuation2 = {TSPECIAL, "*vm-call-with-current-continuation2*",0};
 struct scm scm_vm_return = {TSPECIAL, "*vm-return*",0};
 
+struct scm scm_type_char = {TSYMBOL, "<cell:char>",0};
+struct scm scm_type_closure = {TSYMBOL, "<cell:closure>",0};
+struct scm scm_type_continuation = {TSYMBOL, "<cell:continuation>",0};
+struct scm scm_type_function = {TSYMBOL, "<cell:function>",0};
+struct scm scm_type_keyword = {TSYMBOL, "<cell:keyword>",0};
+struct scm scm_type_macro = {TSYMBOL, "<cell:macro>",0};
+struct scm scm_type_number = {TSYMBOL, "<cell:number>",0};
+struct scm scm_type_pair = {TSYMBOL, "<cell:pair>",0};
+struct scm scm_type_port = {TSYMBOL, "<cell:port>",0};
+struct scm scm_type_ref = {TSYMBOL, "<cell:ref>",0};
+struct scm scm_type_special = {TSYMBOL, "<cell:special>",0};
+struct scm scm_type_string = {TSYMBOL, "<cell:string>",0};
+struct scm scm_type_symbol = {TSYMBOL, "<cell:symbol>",0};
+struct scm scm_type_values = {TSYMBOL, "<cell:values>",0};
+struct scm scm_type_variable = {TSYMBOL, "<cell:variable>",0};
+struct scm scm_type_vector = {TSYMBOL, "<cell:vector>",0};
+struct scm scm_type_broken_heart = {TSYMBOL, "<cell:broken-heart>",0};
+
 struct scm scm_symbol_gnuc = {TSYMBOL, "%gnuc",0};
 struct scm scm_symbol_mesc = {TSYMBOL, "%mesc",0};
 
@@ -216,6 +237,7 @@ int g_function = 0;
 
 #define FUNCTION(x) g_functions[g_cells[x].cdr]
 #define MACRO(x) g_cells[x].cdr
+#define PORT(x) g_cells[x].cdr
 #define VALUE(x) g_cells[x].cdr
 #define VECTOR(x) g_cells[x].cdr
 
@@ -513,9 +535,48 @@ gc_push_frame () ///((internal))
 SCM
 append2 (SCM x, SCM y)
 {
-  if (x == cell_nil) return y;
-  assert (TYPE (x) == TPAIR);
-  return cons (car (x), append2 (cdr (x), y));
+  if (x == cell_nil)
+    return y;
+  if (TYPE (x) != TPAIR)
+    error (cell_symbol_not_a_pair, cons (x, cell_append2));
+  SCM r = cell_nil;
+  while (x != cell_nil)
+    {
+      r = cons (CAR (x), r);
+      x = CDR (x);
+    }
+  return reverse_x_ (r, y);
+}
+
+SCM
+append_reverse (SCM x, SCM y)
+{
+  if (x == cell_nil)
+    return y;
+  if (TYPE (x) != TPAIR)
+    error (cell_symbol_not_a_pair, cons (x, cell_append_reverse));
+  while (x != cell_nil)
+    {
+      y = cons (CAR (x), y);
+      x = CDR (x);
+    }
+  return y;
+}
+
+SCM
+reverse_x_ (SCM x, SCM t)
+{
+  if (TYPE (x) != TPAIR)
+    error (cell_symbol_not_a_pair, cons (x, cell_reverse_x_));
+  SCM r = t;
+  while (x != cell_nil)
+    {
+      t = CDR (x);
+      CDR (x) = r;
+      r = x;
+      x = t;
+    }
+  return r;
 }
 
 SCM
@@ -656,10 +717,25 @@ gc_pop_frame () ///((internal))
   return frame;
 }
 
+char const* string_to_cstring (SCM s);
+
+SCM
+add_formals (SCM formals, SCM x)
+{
+  while (TYPE (x) == TPAIR)
+    {
+      formals = cons (CAR (x), formals);
+      x = CDR (x);
+    }
+  if (TYPE (x) == TSYMBOL)
+    formals = cons (x, formals);
+  return formals;
+}
+
 SCM
 eval_apply ()
 {
-  return scm_unspecified;
+  return cell_unspecified;
 }
 
 SCM
@@ -729,42 +805,6 @@ gc_init_cells () ///((internal))
   return 0;
 }
 
-SCM
-gc_init_news () ///((internal))
-{
-  eputs ("gc_init_news\n");
-  ///g_news = g_cells-1 + ARENA_SIZE;
-  //g_news = g_cells + ARENA_SIZE * 12 + GC_SAFETY * 6;
-  char *p = g_cells;
-  // g_news = g_cells;
-  int halfway = ARENA_SIZE * 12;
-  int safety = GC_SAFETY * 12;
-  safety = safety / 2;
-  halfway = halfway + safety;
-  // g_news = g_news + halfway;
-  p = p + halfway;
-  g_news = p;
-  eputs ("g_cells=");
-  eputs (itoa (g_cells));
-  eputs (" size=");
-  eputs (itoa (halfway));
-  eputs (" news=");
-  eputs (itoa (g_news));
-  eputs (" news - cells=");
-  char * c = g_cells;
-  eputs (itoa (p - c));
-  eputs ("\n");
-
-
-  NTYPE (0) = TVECTOR;
-  NLENGTH (0) = 1000;
-  NVECTOR (0) = 0;
-  g_news++;
-  NTYPE (0) = TCHAR;
-  NVALUE (0) = 'n';
-  return 0;
-}
-
 SCM
 mes_symbols () ///((internal))
 {
index eb7d4b9be83dc0c8e58f1f203b7791cb49d4301c..bc324ad845ca96c23d75af9834d6c08d8d98bcba 100755 (executable)
@@ -12,11 +12,12 @@ if [ '(' -z "$mes_p" -a -z "$MES" ')' -o "$MES" = "guile" -o "$MES" = "mes.guile
 else
     MES=${MES-$(dirname $0)/mes}
     PREFIX=${PREFIX-@PREFIX@}
-    MES_PREFIX=${MES_PREFIX-$PREFIX}
     if [ "$MES_PREFIX" = @PREFIX""@ ]
     then
         MES_PREFIX=$(cd $(dirname $0)/.. && pwd)
         export MES_PREFIX
+    else
+        MES_PREFIX=${MES_PREFIX-$PREFIX/share/mes}
     fi
     MES_MODULEDIR=${MES_MODULEDIR-$MES_PREFIX/"module"}
     export MES_MODULEDIR
@@ -63,7 +64,8 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' scripts/mescc
 
 (cond-expand
  (mes
-  (define %scheme "mes"))
+  (define %scheme "mes")
+  (define (set-port-encoding! port encoding) #t))
  (guile-2
   (define %scheme "guile")
   (define-macro (mes-use-module . rest) #t)
@@ -153,11 +155,13 @@ Environment variables:
 
 (define (ast? o)
   (or (string-suffix? ".E" o)
-      (string-suffix? (string-append "." %scheme "-E") o)))
+      (string-suffix? (string-append "." %scheme "-E") o)
+      (string-suffix? "-E" o)))
 
 (define (object? o)
   (or (string-suffix? ".o" o)
-      (string-suffix? (string-append "." %scheme "-o") o)))
+      (string-suffix? (string-append "." %scheme "-o") o)
+      (string-suffix? "-o" o)))
 
 (define (main args)
   (let* ((options (parse-opts args))
index d8cc4bd4a890ad4928f85a2646234f1d08730dcc..4f787929a016363ad02b7bb303716abc882b8119 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -2220,8 +2220,8 @@ load_env (SCM a) ///((internal))
 {
   r0 = a;
   g_stdin = -1;
-  char boot[128];
-  char buf[128];
+  char boot[1024];
+  char buf[1024];
   if (getenv ("MES_BOOT"))
     strcpy (boot, getenv ("MES_BOOT"));
   else
@@ -2242,7 +2242,7 @@ load_env (SCM a) ///((internal))
     }
   if (g_stdin < 0)
     {
-      char const *prefix = MODULEDIR "mes/";
+      char const *prefix = MODULEDIR "/mes/";
       strcpy (buf, prefix);
       strcpy (buf + strlen (buf), boot);
       if (getenv ("MES_DEBUG"))
@@ -2296,12 +2296,12 @@ bload_env (SCM a) ///((internal))
 #if !_POSIX_SOURCE
   char *mo = "mes/read-0-32.mo";
   g_stdin = open ("module/mes/boot-0.32-mo", O_RDONLY);
-  char *read0 = MODULEDIR "mes/boot-0.32-mo";
+  char *read0 = MODULEDIR "/mes/boot-0.32-mo";
   g_stdin = g_stdin >= 0 ? g_stdin : open (read0, O_RDONLY);
 #else
   char *mo ="mes/boot-0.mo";
   g_stdin = open ("module/mes/boot-0.mo", O_RDONLY);
-  g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "mes/boot-0.mo", O_RDONLY);
+  g_stdin = g_stdin >= 0 ? g_stdin : open (MODULEDIR "/mes/boot-0.mo", O_RDONLY);
 #endif
 
   if (g_stdin < 0)
diff --git a/test.sh b/test.sh
deleted file mode 100755 (executable)
index 2f6c1c7..0000000
--- a/test.sh
+++ /dev/null
@@ -1,66 +0,0 @@
-#! /bin/sh
-
-# Mes --- Maxwell Equations of Software
-# Copyright © 2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
-#
-# This file is part of Mes.
-#
-# Mes is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or (at
-# your option) any later version.
-#
-# Mes is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-set -ex
-
-t=${1-t}
-rm -f "$t".i686-unknown-linux-gnu-out
-rm -f "$t".mes-out
-
-M1=${M1-M1}
-HEX2=${HEX2-hex2}
-MES=${MES-guile}
-MESCC=${MESCC-scripts/mescc}
-
-sh $MESCC -E -o scaffold/tests/$t.E scaffold/tests/$t.c
-sh $MESCC -c -o scaffold/tests/$t.M1 scaffold/tests/$t.E
-$M1 --LittleEndian --Architecture=1\
-    -f stage0/x86.M1\
-    -f scaffold/tests/$t.M1\
-    -o scaffold/tests/$t.hex2
-
-# $MESCC -E -o lib/crt1.E lib/crt1.c
-# $MESCC -c -o lib/crt1.M1 lib/crt1.E
-# $M1 --LittleEndian --Architecture=1 \
-#     -f stage0/x86.M1\
-#     -f lib/crt1.M1\
-#     -o lib/crt1.hex2
-# $MESCC -E -o lib/libc-mes.E lib/libc-mes.c
-# $MESCC -c -o lib/libc-mes.M1 lib/libc-mes.E
-# $M1 --LittleEndian --Architecture=1\
-#     -f stage0/x86.M1\
-#     -f lib/libc-mes.M1\
-#     -o lib/libc-mes.hex2
-
-$HEX2 --LittleEndian --Architecture=1 --BaseAddress=0x1000000\
-      -f stage0/elf32-header.hex2\
-      -f lib/crt1.hex2\
-      -f lib/libc-mes.hex2\
-      -f scaffold/tests/$t.hex2\
-      -f stage0/elf32-footer-single-main.hex2\
-      -o scaffold/tests/$t.mes-out
-chmod +x scaffold/tests/$t.mes-out
-
-r=0
-set +e
-scaffold/tests/$t.mes-out
-m=$?
-
-[ $m = $r ]
index eee59548c81a20aa3f5059adbef8f4af4c5100a6..e9942df9d73d961b6f83a115a76760bf705dc6f6 100755 (executable)
@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 121540c6a86c94b512c3c79d7e977531a6e9c5de..753f4b6c72f44ea7cebd2a1b5bca670f708a1157 100755 (executable)
@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
+MES=${MES-$(dirname $0)/../src/mes}
 export MES_BOOT=boot-02.scm
 $MES < $0
 exit $?
index f3390ef87c2a7c345f44191daee2e48b8839f79d..62ee9e500cf0e56bf223c3645be9615957c20d5f 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 11dab07d307d59d3517bfb9d5a1ec6a76f493fbc..ea1acdb1104320d69545648744c3d7a738cf506e 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index dfc6b7ee127c79eb7f17afd58dd5fc30434e174b..9713579901420fafd3b8cf8866aa180bada161f7 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index a2d244d2e3ebb69fb9fb2ef69ed8e879a98ff530..88d49647ed84b78cf13dbf66ed07fb74eb2c06f9 100755 (executable)
@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index ea9521cfcf4b7a22678982d56428808c6309fc8a..3f22eff02b45fdb61ce1668fb9d58c0c34189df5 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 525c71940e4e988c9bb403ac816ee81ef7f0d087..237afa2396b7e85c1ddf66c967bac3a594a8ed7e 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 98699a294c909cc5ad802607de52152d4a990508..2939a244b366d9d307429a99dd9cd1b1deca3730 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index b2860c354aa66a3629e0b3e69da40007a1d08f7a..0df7b2114a06140900dbd8cdadce5e322db83b2a 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 8983036a7502b877f74fd7f861aa117c5bf257e9..24483ebb3c89af67622b7983bc34230aa3babad7 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index d65129a0d211b471e8ea9f36c049efa2a76a0249..1be8e5bdeb4a6456dd386420fb7df573097e87c1 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index cdcd40fa393e2e8fabaf08e40d7c9c805840b84a..d91643554750148373eade9075873d503a799b0b 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 7c1c0b4c438c0bc5bb60365cca2370e3fab039ab..643645a097ea531c77c64a938434f8df22621c1d 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 9fcb2e1cb083a8de71e0c6a9c4332bc28215d5bd..63b82f6ee652eae17af40fbad023e466fd87ed83 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 9753a5a1c70cc931b48f4f56edb067d9e3710c89..f6d40aacff5572be7b349c8e6dcb90a2b7498c78 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-166000000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 5f844def2f4e9f0b14de4d744fd3949699a673bf..0c913fc2bf7876ee0cc8a73b24bb284756509544 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 61f0ff60ad309efb2dec3988a06834fa269f9da4..64d9cc7e81c4fdf208500e3b20b01db5d7440001 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-200000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 6904b8b5222da5f172256e527b6a0a27b6a95dd3..042ea5ac9408ab9c59d0647928d73de6f7b3d781 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 #paredit:||
 exit $?
index 25dd9faf12b17e7c2932a8b337e99a9fcd25d69e..1b470f8a86b7575253d4bdc3f69ca7ed906131ae 100755 (executable)
@@ -1,7 +1,7 @@
 #! /bin/sh
 # -*-scheme-*-
 # ***REMOVE THIS BLOCK COMMENT INITIALLY***
-MES=${MES-$(dirname $0)/../src/mes.gcc}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 342fbb9655d33ee47a31e4eb2182428eda245e06..97e9471b31e5375beb02c92ce0204a060add1dd4 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index a01465e8ac3d8bcb64660cdce41ebfdcdefe5ed4..d83f5a3d2e737c9c25c4a8ccc0d05e05df66c15d 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 451494e280b16c7fa3d023cc8d26f141fef98975..3778b7ec47ce9124d0c5b95e9a770d9acc760097 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index afa75f547cc035706c77c70ff7b09ad93a6592bd..18c8ff5cfe35d5be980791bcecceb53b98af8815 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index ef2ab712086e66cd48bbcead5391e01a17b7b280..c1be2d3fed44c31ee6a12845ec2d91a3d7d299ea 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 957e8d77996dd79b9dd9a0c1912da83a9a4c0f4d..f124e67c3462450e29867867703db813820add0a 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 70a900120d5cc0c7029a6899a70f67cdb9aa1e2d..3fb6da8db2e8486a32c229f142dce427098646df 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 7b26f69f8247c4803390496a458bf18c13b38a77..115c76d5cce44f139cdd4bc9aa1c2d52c3dcd5be 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#
index 84539869edc26138c36af9c5c17e099c421cf748..a63acc695dcd7ae8b0b7c1f2d867eddd61bb5148 100755 (executable)
@@ -1,7 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES=${MES-$(dirname $0)/../src/mes.gcc}
-#export MES_ARENA=${MES_ARENA-40000}
+MES=${MES-$(dirname $0)/../src/mes}
 $MES -s $0
 exit $?
 !#