From 542289a3c6028c4d1fe93e1c4c1dd3a884867aca Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 21 Jul 2018 07:15:52 +0200 Subject: [PATCH] build: Separate Mes and Guile modules. * scaffold/gc.scm: Move from guile/gc.scm. * guile/: Remove. * module/language/paren.mes: Remove. * mes/module/mes/base.mes: Move from module/mes/. * mes/module/mes/boot-0.scm: Likewise. * mes/module/mes/boot-00.scm: Likewise. * mes/module/mes/boot-01.scm: Likewise. * mes/module/mes/boot-02.scm: Likewise. * mes/module/mes/catch.mes: Likewise. * mes/module/mes/display.mes: Likewise. * mes/module/mes/fluids.mes: Likewise. * mes/module/mes/getopt-long.mes: Likewise. * mes/module/mes/guile.mes: Likewise. * mes/module/mes/lalr.mes: Likewise. * mes/module/mes/lalr.scm: Likewise. * mes/module/mes/let.mes: Likewise. * mes/module/mes/match.mes: Likewise. * mes/module/mes/match.scm: Likewise. * mes/module/mes/mescc.mes: Likewise. * mes/module/mes/misc.mes: Likewise. * mes/module/mes/module.mes: Likewise. * mes/module/mes/optargs.mes: Likewise. * mes/module/mes/optargs.scm: Likewise. * mes/module/mes/peg.mes: Likewise. * mes/module/mes/peg/cache.scm: Likewise. * mes/module/mes/peg/codegen.scm: Likewise. * mes/module/mes/peg/simplify-tree.scm: Likewise. * mes/module/mes/peg/string-peg.scm: Likewise. * mes/module/mes/peg/using-parsers.scm: Likewise. * mes/module/mes/pmatch.mes: Likewise. * mes/module/mes/pmatch.scm: Likewise. * mes/module/mes/posix.mes: Likewise. * mes/module/mes/pretty-print.mes: Likewise. * mes/module/mes/pretty-print.scm: Likewise. * mes/module/mes/psyntax-0.mes: Likewise. * mes/module/mes/psyntax-1.mes: Likewise. * mes/module/mes/psyntax.mes: Likewise. * mes/module/mes/psyntax.pp: Likewise. * mes/module/mes/psyntax.ss: Likewise. * mes/module/mes/quasiquote.mes: Likewise. * mes/module/mes/quasisyntax.mes: Likewise. * mes/module/mes/quasisyntax.scm: Likewise. * mes/module/mes/repl.mes: Likewise. * mes/module/mes/scm.mes: Likewise. * mes/module/mes/syntax.mes: Likewise. * mes/module/mes/syntax.scm: Likewise. * mes/module/mes/test.mes: Likewise. * mes/module/mes/tiny-0.mes: Likewise. * mes/module/mes/type-0.mes: Likewise. * mes/module/mescc/M1.mes: Likewise. * mes/module/mescc/as.mes: Likewise. * mes/module/mescc/bytevectors.mes: Likewise. * mes/module/mescc/compile.mes: Likewise. * mes/module/mescc/i386/as.mes: Likewise. * mes/module/mescc/info.mes: Likewise. * mes/module/mescc/mescc.mes: Likewise. * mes/module/mescc/preprocess.mes: Likewise. * mes/module/nyacc/lalr.mes: Likewise. * mes/module/nyacc/lang/c99/cpp.mes: Likewise. * mes/module/nyacc/lang/c99/parser.mes: Likewise. * mes/module/nyacc/lang/c99/pprint.mes: Likewise. * mes/module/nyacc/lang/calc/parser.mes: Likewise. * mes/module/nyacc/lang/util.mes: Likewise. * mes/module/nyacc/lex.mes: Likewise. * mes/module/nyacc/parse.mes: Likewise. * mes/module/nyacc/util.mes: Likewise. * mes/module/rnrs/arithmetic/bitwise.mes: Likewise. * mes/module/srfi/srfi-0.mes: Likewise. * mes/module/srfi/srfi-1.mes: Likewise. * mes/module/srfi/srfi-1.scm: Likewise. * mes/module/srfi/srfi-13.mes: Likewise. * mes/module/srfi/srfi-14.mes: Likewise. * mes/module/srfi/srfi-16.mes: Likewise. * mes/module/srfi/srfi-16.scm: Likewise. * mes/module/srfi/srfi-26.mes: Likewise. * mes/module/srfi/srfi-26.scm: Likewise. * mes/module/srfi/srfi-43.mes: Likewise. * mes/module/srfi/srfi-8.mes: Likewise. * mes/module/srfi/srfi-9.mes: Likewise. * mes/module/srfi/srfi-9/gnu.mes: Likewise. * mes/module/sxml/xpath.mes: Likewise. * mes/module/sxml/xpath.scm: Likewise. * module/mes/mes-0.scm: Likewise. * build-aux/build-guile.sh: Update for new layout. * build-aux/build-mes.sh: Likewise. * build-aux/check-boot.sh: Likewise. * build-aux/check-mescc.sh: Likewise. * install.sh: Likewise. * scaffold/boot/51-module.scm: Likewise. * scaffold/boot/52-define-module.scm: Likewise. * scripts/mescc: Likewise. * src/mes.c: Likewise. * tests/base.test-guile: Likewise. * tests/boot.test: Likewise. * tests/srfi-9.test: Likewise. * mes/include: New symlink. * mes/lib: New symlink. * AUTHORS: Update file names. --- AUTHORS | 27 +-- GNUmakefile | 15 +- build-aux/build-guile.sh | 27 ++- build-aux/build-mes.sh | 1 + build-aux/check-boot.sh | 2 +- build-aux/check-mescc.sh | 2 +- build-aux/mes-snarf.scm | 4 +- build-aux/test.sh | 2 + guile/language | 1 - guile/mes | 1 - guile/mes.mes | 174 ------------- guile/mes.scm | 228 ------------------ guile/mescc | 1 - guile/reader.mes | 141 ----------- install.sh | 30 ++- mes/include | 1 + mes/lib | 1 + {module => mes/module}/mes/base.mes | 0 {module => mes/module}/mes/boot-0.scm | 30 +-- {module => mes/module}/mes/boot-00.scm | 0 {module => mes/module}/mes/boot-01.scm | 0 {module => mes/module}/mes/boot-02.scm | 4 + {module => mes/module}/mes/catch.mes | 0 {module => mes/module}/mes/display.mes | 0 {module => mes/module}/mes/fluids.mes | 0 {module => mes/module}/mes/getopt-long.mes | 0 {module => mes/module}/mes/guile.mes | 11 - {module => mes/module}/mes/lalr.mes | 0 {module => mes/module}/mes/lalr.scm | 0 {module => mes/module}/mes/let.mes | 0 {module => mes/module}/mes/match.mes | 0 {module => mes/module}/mes/match.scm | 0 {module => mes/module}/mes/mescc.mes | 0 {module => mes/module}/mes/misc.mes | 0 {module => mes/module}/mes/module.mes | 0 {module => mes/module}/mes/optargs.mes | 0 {module => mes/module}/mes/optargs.scm | 0 {module => mes/module}/mes/peg.mes | 0 {module => mes/module}/mes/peg/cache.scm | 0 {module => mes/module}/mes/peg/codegen.scm | 0 .../module}/mes/peg/simplify-tree.scm | 0 {module => mes/module}/mes/peg/string-peg.scm | 0 .../module}/mes/peg/using-parsers.scm | 0 {module => mes/module}/mes/pmatch.mes | 0 {module => mes/module}/mes/pmatch.scm | 0 {module => mes/module}/mes/posix.mes | 0 {module => mes/module}/mes/pretty-print.mes | 0 {module => mes/module}/mes/pretty-print.scm | 0 {module => mes/module}/mes/psyntax-0.mes | 0 {module => mes/module}/mes/psyntax-1.mes | 0 {module => mes/module}/mes/psyntax.mes | 0 {module => mes/module}/mes/psyntax.pp | 0 {module => mes/module}/mes/psyntax.ss | 0 {module => mes/module}/mes/quasiquote.mes | 0 {module => mes/module}/mes/quasisyntax.mes | 0 {module => mes/module}/mes/quasisyntax.scm | 0 {module => mes/module}/mes/repl.mes | 0 {module => mes/module}/mes/scm.mes | 0 {module => mes/module}/mes/syntax.mes | 0 {module => mes/module}/mes/syntax.scm | 0 mes/module/mes/test.mes | 21 ++ {module => mes/module}/mes/tiny-0.mes | 0 {module => mes/module}/mes/type-0.mes | 0 {module => mes/module}/mescc/M1.mes | 0 {module => mes/module}/mescc/as.mes | 0 {module => mes/module}/mescc/bytevectors.mes | 0 {module => mes/module}/mescc/compile.mes | 0 {module => mes/module}/mescc/i386/as.mes | 0 {module => mes/module}/mescc/info.mes | 0 {module => mes/module}/mescc/mescc.mes | 0 {module => mes/module}/mescc/preprocess.mes | 0 {module => mes/module}/nyacc/lalr.mes | 0 {module => mes/module}/nyacc/lang/c99/cpp.mes | 0 .../module}/nyacc/lang/c99/parser.mes | 0 .../module}/nyacc/lang/c99/pprint.mes | 0 .../module}/nyacc/lang/calc/parser.mes | 0 {module => mes/module}/nyacc/lang/util.mes | 0 {module => mes/module}/nyacc/lex.mes | 0 {module => mes/module}/nyacc/parse.mes | 0 {module => mes/module}/nyacc/util.mes | 0 .../module}/rnrs/arithmetic/bitwise.mes | 0 {module => mes/module}/srfi/srfi-0.mes | 0 {module => mes/module}/srfi/srfi-1.mes | 0 {module => mes/module}/srfi/srfi-1.scm | 0 {module => mes/module}/srfi/srfi-13.mes | 0 {module => mes/module}/srfi/srfi-14.mes | 0 {module => mes/module}/srfi/srfi-16.mes | 0 {module => mes/module}/srfi/srfi-16.scm | 0 {module => mes/module}/srfi/srfi-26.mes | 0 {module => mes/module}/srfi/srfi-26.scm | 0 {module => mes/module}/srfi/srfi-43.mes | 0 {module => mes/module}/srfi/srfi-8.mes | 0 {module => mes/module}/srfi/srfi-9.mes | 0 {module => mes/module}/srfi/srfi-9/gnu.mes | 0 {module => mes/module}/sxml/xpath.mes | 0 {module => mes/module}/sxml/xpath.scm | 0 module/language/paren.mes | 177 -------------- {guile => module/mes}/mes-0.scm | 5 - module/mes/test.mes | 128 ---------- module/mes/test.scm | 107 +++++++- scaffold/boot/51-module.scm | 9 +- scaffold/boot/52-define-module.scm | 2 +- {guile => scaffold}/gc.scm | 30 +-- scripts/mescc | 13 +- src/mes.c | 2 +- tests/base.test-guile | 2 +- tests/boot.test | 3 +- tests/srfi-13.test | 1 - tests/srfi-9.test | 3 +- 109 files changed, 224 insertions(+), 982 deletions(-) delete mode 120000 guile/language delete mode 120000 guile/mes delete mode 100644 guile/mes.mes delete mode 100755 guile/mes.scm delete mode 120000 guile/mescc delete mode 100644 guile/reader.mes create mode 120000 mes/include create mode 120000 mes/lib rename {module => mes/module}/mes/base.mes (100%) rename {module => mes/module}/mes/boot-0.scm (90%) rename {module => mes/module}/mes/boot-00.scm (100%) rename {module => mes/module}/mes/boot-01.scm (100%) rename {module => mes/module}/mes/boot-02.scm (98%) rename {module => mes/module}/mes/catch.mes (100%) rename {module => mes/module}/mes/display.mes (100%) rename {module => mes/module}/mes/fluids.mes (100%) rename {module => mes/module}/mes/getopt-long.mes (100%) rename {module => mes/module}/mes/guile.mes (86%) rename {module => mes/module}/mes/lalr.mes (100%) rename {module => mes/module}/mes/lalr.scm (100%) rename {module => mes/module}/mes/let.mes (100%) rename {module => mes/module}/mes/match.mes (100%) rename {module => mes/module}/mes/match.scm (100%) rename {module => mes/module}/mes/mescc.mes (100%) rename {module => mes/module}/mes/misc.mes (100%) rename {module => mes/module}/mes/module.mes (100%) rename {module => mes/module}/mes/optargs.mes (100%) rename {module => mes/module}/mes/optargs.scm (100%) rename {module => mes/module}/mes/peg.mes (100%) rename {module => mes/module}/mes/peg/cache.scm (100%) rename {module => mes/module}/mes/peg/codegen.scm (100%) rename {module => mes/module}/mes/peg/simplify-tree.scm (100%) rename {module => mes/module}/mes/peg/string-peg.scm (100%) rename {module => mes/module}/mes/peg/using-parsers.scm (100%) rename {module => mes/module}/mes/pmatch.mes (100%) rename {module => mes/module}/mes/pmatch.scm (100%) rename {module => mes/module}/mes/posix.mes (100%) rename {module => mes/module}/mes/pretty-print.mes (100%) rename {module => mes/module}/mes/pretty-print.scm (100%) rename {module => mes/module}/mes/psyntax-0.mes (100%) rename {module => mes/module}/mes/psyntax-1.mes (100%) rename {module => mes/module}/mes/psyntax.mes (100%) rename {module => mes/module}/mes/psyntax.pp (100%) rename {module => mes/module}/mes/psyntax.ss (100%) rename {module => mes/module}/mes/quasiquote.mes (100%) rename {module => mes/module}/mes/quasisyntax.mes (100%) rename {module => mes/module}/mes/quasisyntax.scm (100%) rename {module => mes/module}/mes/repl.mes (100%) rename {module => mes/module}/mes/scm.mes (100%) rename {module => mes/module}/mes/syntax.mes (100%) rename {module => mes/module}/mes/syntax.scm (100%) create mode 100644 mes/module/mes/test.mes rename {module => mes/module}/mes/tiny-0.mes (100%) rename {module => mes/module}/mes/type-0.mes (100%) rename {module => mes/module}/mescc/M1.mes (100%) rename {module => mes/module}/mescc/as.mes (100%) rename {module => mes/module}/mescc/bytevectors.mes (100%) rename {module => mes/module}/mescc/compile.mes (100%) rename {module => mes/module}/mescc/i386/as.mes (100%) rename {module => mes/module}/mescc/info.mes (100%) rename {module => mes/module}/mescc/mescc.mes (100%) rename {module => mes/module}/mescc/preprocess.mes (100%) rename {module => mes/module}/nyacc/lalr.mes (100%) rename {module => mes/module}/nyacc/lang/c99/cpp.mes (100%) rename {module => mes/module}/nyacc/lang/c99/parser.mes (100%) rename {module => mes/module}/nyacc/lang/c99/pprint.mes (100%) rename {module => mes/module}/nyacc/lang/calc/parser.mes (100%) rename {module => mes/module}/nyacc/lang/util.mes (100%) rename {module => mes/module}/nyacc/lex.mes (100%) rename {module => mes/module}/nyacc/parse.mes (100%) rename {module => mes/module}/nyacc/util.mes (100%) rename {module => mes/module}/rnrs/arithmetic/bitwise.mes (100%) rename {module => mes/module}/srfi/srfi-0.mes (100%) rename {module => mes/module}/srfi/srfi-1.mes (100%) rename {module => mes/module}/srfi/srfi-1.scm (100%) rename {module => mes/module}/srfi/srfi-13.mes (100%) rename {module => mes/module}/srfi/srfi-14.mes (100%) rename {module => mes/module}/srfi/srfi-16.mes (100%) rename {module => mes/module}/srfi/srfi-16.scm (100%) rename {module => mes/module}/srfi/srfi-26.mes (100%) rename {module => mes/module}/srfi/srfi-26.scm (100%) rename {module => mes/module}/srfi/srfi-43.mes (100%) rename {module => mes/module}/srfi/srfi-8.mes (100%) rename {module => mes/module}/srfi/srfi-9.mes (100%) rename {module => mes/module}/srfi/srfi-9/gnu.mes (100%) rename {module => mes/module}/sxml/xpath.mes (100%) rename {module => mes/module}/sxml/xpath.scm (100%) delete mode 100644 module/language/paren.mes rename {guile => module/mes}/mes-0.scm (94%) delete mode 100644 module/mes/test.mes rename {guile => scaffold}/gc.scm (89%) diff --git a/AUTHORS b/AUTHORS index d2e9281d..fdad0bd2 100644 --- a/AUTHORS +++ b/AUTHORS @@ -15,48 +15,45 @@ List of imported files D A Gwyn lib/alloca.c -Based on Guile ECMAScript -module/language/c/lexer.mes - Included verbatim from gnulib build-aux/gitlog-to-changelog Portable hygienic pattern matcher -module/mes/match.scm +mes/module/mes/match.scm Portable LALR(1) parser generator -module/mes/lalr.scm +mes/module/mes/lalr.scm Portable syntax-case from Chez Scheme; patches from Guile -module/mes/psyntax.ss -module/mes/psyntax.pp [generated] +mes/module/mes/psyntax.ss +mes/module/mes/psyntax.pp [generated] Getopt-long from Guile module/mes/getopt-long.scm Optargs from Guile -module/mes/optargs.scm +mes/module/mes/optargs.scm PEG from Guile -module/mes/peg/ +mes/module/mes/peg/ Pmatch from Guile -module/mes/pmatch.scm +mes/module/mes/pmatch.scm Pretty-print from Guile -module/mes/pretty-print.scm +mes/module/mes/pretty-print.scm Srfi-1 bits from Guile -module/srfi/srfi-1.scm +mes/module/srfi/srfi-1.scm Srfi-16 from Guile -module/srfi/srfi-16.scm +mes/module/srfi/srfi-16.scm Srfi-26 from Guile -module/srfi/srfi-26.scm +mes/module/srfi/srfi-26.scm Sxml bits from Guile -module/sxml/xpath.scm +mes/module/sxml/xpath.scm GNU FDL in texinfo from GNU doc/fdl-1.3.texi diff --git a/GNUmakefile b/GNUmakefile index 3fd29110..2587d960 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -16,7 +16,7 @@ # You should have received a copy of the GNU General Public License # along with Mes. If not, see . -GUILE_FLAGS:=--no-auto-compile -L . -L guile -C . -C guile +GUILE_FLAGS:=--no-auto-compile -L . -L module -C . -C module include .config.make @@ -24,7 +24,7 @@ include .config.make ./configure --prefix=$(prefix) PHONY_TARGETS:= all all-go build check clean clean-go default doc help install install-info man\ -cc mes mes-gcc mes-tcc +gcc mes src/mes mes-gcc mes-tcc .PHONY: $(PHONY_TARGETS) @@ -116,14 +116,13 @@ install-info: info man: doc/mes.1 doc/mescc.1 -doc/mes.1: src/mes.gcc-out - MES_ARENA=10000000 $(HELP2MAN) $< > $@ +src/mes: build -src/mes.gcc-out: - $(MAKE) cc +doc/mes.1: src/mes + MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $< > $@ -doc/mescc.1: src/mes.gcc-out scripts/mescc - MES_ARENA=10000000 $(HELP2MAN) $< > $@ +doc/mescc.1: src/mes scripts/mescc + MES_ARENA=10000000 ./pre-inst-env $(HELP2MAN) $< > $@ html: mes/index.html diff --git a/build-aux/build-guile.sh b/build-aux/build-guile.sh index f4e9547d..0ba899b3 100755 --- a/build-aux/build-guile.sh +++ b/build-aux/build-guile.sh @@ -31,17 +31,18 @@ GUILE_AUTO_COMPILE=0 set -e SCM_FILES=" -guile/mes/guile.scm -guile/mes/misc.scm -guile/mes/test.scm -guile/mescc/M1.scm -guile/mescc/as.scm -guile/mescc/bytevectors.scm -guile/mescc/compile.scm -guile/mescc/i386/as.scm -guile/mescc/info.scm -guile/mescc/mescc.scm -guile/mescc/preprocess.scm +module/mes/getopt-long.scm +module/mes/guile.scm +module/mes/misc.scm +module/mes/test.scm +module/mescc/M1.scm +module/mescc/as.scm +module/mescc/bytevectors.scm +module/mescc/compile.scm +module/mescc/i386/as.scm +module/mescc/info.scm +module/mescc/mescc.scm +module/mescc/preprocess.scm " export srcdir=. @@ -57,7 +58,7 @@ for i in $SCM_FILES; do go=${i%%.scm}.go if [ $i -nt $go ]; then echo " GUILEC $i" - $GUILE_TOOLS compile -L ${abs}guile -L ${abs}scripts -o $go $i + $GUILE_TOOLS compile -L ${abs}module -L ${abs}scripts -o $go $i fi done @@ -69,6 +70,6 @@ for i in $SCRIPTS; do go=${i%%.scm}.go if [ $i -nt $go ]; then echo " GUILEC $i" - $GUILE_TOOLS compile -L ${abs}guile -L ${abs}scripts -o $go $i + $GUILE_TOOLS compile -L ${abs}module -L ${abs}scripts -o $go $i fi done diff --git a/build-aux/build-mes.sh b/build-aux/build-mes.sh index d7395fa6..cca170da 100755 --- a/build-aux/build-mes.sh +++ b/build-aux/build-mes.sh @@ -104,6 +104,7 @@ if [ ! -d "$MES_SEED" ] \ MES_ARENA=100000000 fi +MES_ARENA=100000000 ARCHDIR=1 NOLINK=1 bash build-aux/cc-mes.sh lib/crt0 ARCHDIR=1 NOLINK=1 bash build-aux/cc-mes.sh lib/crt1 ARCHDIR=1 NOLINK=1 bash build-aux/cc-mes.sh lib/crti diff --git a/build-aux/check-boot.sh b/build-aux/check-boot.sh index 34844314..8d29f43c 100755 --- a/build-aux/check-boot.sh +++ b/build-aux/check-boot.sh @@ -116,7 +116,7 @@ for i in $tests; do echo ' [SKIP]' continue; fi - $GUILE -L guile -L . <(echo '(use-modules (mes guile))'; cat scaffold/boot/$i) >& /dev/null + $GUILE -L module -C module -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; diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index 2d594085..0f9d294a 100755 --- a/build-aux/check-mescc.sh +++ b/build-aux/check-mescc.sh @@ -31,7 +31,7 @@ export LIBC CC32LIBS MES_LIBS MES=${MES-src/mes} MESCC=${MESCC-scripts/mescc} GUILE=${GUILE-guile} -MES_PREFIX=${MES_PREFIX-.} +MES_PREFIX=${MES_PREFIX-mes} HEX2=${HEX2-hex2} M1=${M1-M1} diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm index ed57bc67..7379e16c 100755 --- a/build-aux/mes-snarf.scm +++ b/build-aux/mes-snarf.scm @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -exec ${GUILE-guile} -L $(dirname 0) -e '(mes-snarf)' -s "$0" "$@" +exec ${GUILE-guile} --no-auto-compile -L $(dirname $0) -C $(dirname $0) -e '(mes-snarf)' -s "$0" "$@" !# ;;; Mes --- Maxwell Equations of Software @@ -218,7 +218,7 @@ exec ${GUILE-guile} -L $(dirname 0) -e '(mes-snarf)' -s "$0" "$@" (string-join (map function->header functions (iota (length functions) (+ %start (length symbols)))) ""))) (source (make-file (string-append base-name ".i") - (string-join (map function->source (filter (negate no-environment?) functions) (iota (length functions) (+ (length symbols) %start))) ""))) + (string-join (map function->source (filter (negate no-environment?) functions) (iota (length functions) (+ (length symbols) %start))) ""))) (environment (make-file (string-append base-name ".environment.i") (string-join (map function->environment (filter (negate no-environment?) functions) (iota (length functions) (+ (length symbols) %start))) ""))) diff --git a/build-aux/test.sh b/build-aux/test.sh index 4cfc0989..7845fcc0 100755 --- a/build-aux/test.sh +++ b/build-aux/test.sh @@ -22,6 +22,8 @@ if [ -n "$BUILD_DEBUG" ]; then set -x fi +MES_ARENA=100000000 + export LIBC MES_LIBS GUILE=${GUILE-$MES} diff --git a/guile/language b/guile/language deleted file mode 120000 index 4f52fd33..00000000 --- a/guile/language +++ /dev/null @@ -1 +0,0 @@ -../module/language \ No newline at end of file diff --git a/guile/mes b/guile/mes deleted file mode 120000 index cd5c453d..00000000 --- a/guile/mes +++ /dev/null @@ -1 +0,0 @@ -../module/mes \ No newline at end of file diff --git a/guile/mes.mes b/guile/mes.mes deleted file mode 100644 index 87ac3082..00000000 --- a/guile/mes.mes +++ /dev/null @@ -1,174 +0,0 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen -;;; -;;; mes.mes: 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 . - -;; The Maxwell Equations of Software -- John McCarthy page 13 -;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf - -(define (caar x) (car (car x))) -(define (cadr x) (car (cdr x))) -(define (cdar x) (cdr (car x))) -(define (cddr x) (cdr (cdr x))) -(define (caadr x) (car (car (cdr x)))) -(define (caddr x) (car (cdr (cdr x)))) -(define (cddar x) (cdr (cdr (car x)))) -(define (cdadr x) (cdr (car (cdr x)))) -(define (cadar x) (car (cdr (car x)))) -(define (cdddr x) (cdr (cdr (cdr x)))) - -;; Page 12 -(define (pairlis x y a) - (cond - ((null? x) a) - ((atom? x) (cons (cons x y) a)) - (#t (cons (cons (car x) (car y)) - (pairlis (cdr x) (cdr y) a))))) - -(define (assq x a) - (cond - ((null? a) #f) - ((eq? (caar a) x) (car a)) - (#t (assq x (cdr a))))) - -(define (assq-ref-env x a) - (let ((e (assq x a))) - (if (eq? e #f) '*undefined* (cdr e)))) - -;; Page 13 -(define (evcon c a) - (cond - ((null? c) *unspecified*) - ;; single-statement cond - ;; ((eval (caar c) a) (eval (cadar c) a)) - ((eval (caar c) a) - (cond ((null? (cddar c)) (eval (cadar c) a)) - (#t (eval (cadar c) a) - (evcon - (cons (cons #t (cddar c)) '()) - a)))) - (#t (evcon (cdr c) a)))) - -(define (evlis-env m a) - (cond - ((null? m) '()) - ((not (pair? m)) (eval-env m a)) - (#t (cons (eval-env (car m) a) (evlis-env (cdr m) a))))) - -(define (apply-env fn x a) - (cond - ((atom? fn) - (cond - ((builtin? fn) (call fn x)) - ((eq? fn 'call-with-values) (call call-with-values-env (append x (cons a '())))) - ((eq? fn 'current-module) a))) - ((eq? (car fn) 'lambda) - (let ((p (pairlis (cadr fn) x a))) - (eval-begin-env (cddr fn) (cons (cons '*closure* p) p)))) - ((eq? (car fn) '*closure*) - (let ((args (caddr fn)) - (body (cdddr fn)) - (a (cddr (cadr fn)))) - (let ((p (pairlis args x a))) - (eval-begin-env body (cons (cons '*closure* p) p))))) - ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a))) - (#t (apply-env (eval-env fn a) x a)))) - -;;return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (formals, body))); -(define (make-closure formals body a) - (cons (cons '*closure* #f) (cons (cons '*circ* a) (cons formals body)))) - -(define (eval-expand e a) - (cond - ((eq? e '*undefined*) e) - ((symbol? e) (assq-ref-env e a)) - ((atom? e) e) - ((atom? (car e)) - (cond - ((eq? (car e) 'quote) (cadr e)) - ((eq? (car e) 'syntax) (cadr e)) - ((eq? (car e) 'begin) (eval-begin-env e a)) - ((eq? (car e) 'lambda) e) - ((eq? (car e) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a))) - ((eq? (car e) '*closure*) e) - ((eq? (car e) 'if) (eval-if-env (cdr e) a)) - ((eq? (car e) 'define) (env:define (cons (sexp:define e a) '()) a)) - ((eq? (car e) 'define-macro) (env:define (env:macro (sexp:define e a)) a)) - ((eq? (car e) 'set!) (set-env! (cadr e) (eval-env (caddr e) a) a)) - ((eq? (car e) 'apply-env) (apply-env (eval-env (cadr e) a) (evlis-env (caddr e) a) a)) - ((eq? (car e) 'unquote) (eval-env (cadr e) a)) - ((eq? (car e) 'quasiquote) (eval-quasiquote (cadr e) (add-unquoters a))) - (#t (apply-env (eval-env (car e) a) (evlis-env (cdr e) a) a)))) - (#t (apply-env (eval-env (car e) a) (evlis-env (cdr e) a) a)))) - -(define (unquote x) (cons 'unquote x)) -(define (unquote-splicing x) (cons 'quasiquote x)) - -(define %the-unquoters - (cons - (cons 'unquote unquote) - (cons (cons 'unquote-splicing unquote-splicing) '()))) - -(define (add-unquoters a) - (cons %the-unquoters a)) - -(define (eval-env e a) - (eval-expand (macro-expand-env e a) a)) - -(define (macro-expand-env e a) - (if (pair? e) ((lambda (macro) - (if macro (macro-expand-env (apply-env macro (cdr e) a) a) - e)) - (lookup-macro (car e) a)) - e)) - -(define (eval-begin-env e a) - (if (null? e) *unspecified* - (if (null? (cdr e)) (eval-env (car e) a) - (begin - (eval-env (car e) a) - (eval-begin-env (cdr e) a))))) - -(define (eval-if-env e a) - (if (eval-env (car e) a) (eval-env (cadr e) a) - (if (pair? (cddr e)) (eval-env (caddr e) a)))) - -;; (define (eval-quasiquote e a) -;; (cond ((null? e) e) -;; ((atom? e) e) -;; ((eq? (car e) 'unquote) (eval-env (cadr e) a)) -;; ((and (pair? (car e)) -;; (eq? (caar e) 'unquote-splicing)) -;; (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a))) -;; (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a))))) - -(define (sexp:define e a) - (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a)) - (cons (caadr e) (eval-env (cons 'lambda (cons (cdadr e) (cddr e))) a)))) - -(define (env:define a+ a) - (set-cdr! a+ (cdr a)) - (set-cdr! a a+) - (set-cdr! (assq '*closure* a) a)) - -(define (env:macro name+entry) - (cons - (cons (car name+entry) - (make-macro (car name+entry) - (cdr name+entry))) - '())) diff --git a/guile/mes.scm b/guile/mes.scm deleted file mode 100755 index b9032657..00000000 --- a/guile/mes.scm +++ /dev/null @@ -1,228 +0,0 @@ -#! /bin/sh -# -*-scheme-*- -exec guile -L $(pwd) -e '(mes)' -s "$0" "$@" -!# - -;;; Mes --- The Maxwell Equations of Software -;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen -;;; -;;; This file is part of GNU Guix. -;;; -;;; 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 . - -;; The Maxwell Equations of Software -- John McCarthy page 13 -;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf - -(define-module (mes) - #:export (main)) - -(let ((guile (resolve-interface - '(guile) - #:select `( - ;; Debugging - apply - cons* - current-module - display - eof-object? - eval - exit - force-output - format - list - map - newline - read - - ;; Guile admin - module-define! - resolve-interface - - ;; PRIMITIVE BUILTINS - car - cdr - cons - eq? - null? - pair? - *unspecified* - - ;; READER - char->integer - integer->char - - ;; non-primitive BUILTINS - char? - number? - procedure? - string? - < - - - ) - #:renamer (symbol-prefix-proc 'guile:))) - (guile-2.0 (resolve-interface '(guile) #:select '(define))) - (guile-2.2 (resolve-interface '(guile) #:select '(quasiquote unquote))) - (ports (resolve-interface - (if (equal? (effective-version) "2.0")'(guile) '(ice-9 ports)) - #:select '( - ;; Debugging - current-error-port - current-output-port - - ;; READER - ;;peek-char - read-char - unread-char) - #:renamer (symbol-prefix-proc 'guile:)))) - (set-current-module - (make-module 10 `(,guile ,guile-2.0 ,guile-2.2 ,ports)))) - -(define (logf port string . rest) - (guile:apply guile:format (guile:cons* port string rest)) - (guile:force-output port) - #t) - -(define (stderr string . rest) - (guile:apply logf (guile:cons* (guile:current-error-port) string rest))) - -(define (stdout string . rest) - (guile:apply logf (guile:cons* (guile:current-output-port) string rest))) - -(define (debug . x) #t) -(define debug stderr) - -;; TODO -(define (atom? x) - (cond - ((guile:pair? x) #f) - ((guile:null? x) #f) - (#t #t))) - -;; PRIMITIVES -(define car guile:car) -(define cdr guile:cdr) -(define cons guile:cons) -(define eq? guile:eq?) -(define null? guile:null?) -(define pair? guile:pair?) -(define builtin? guile:procedure?) -(define char? guile:char?) -(define number? guile:number?) -(define string? guile:number?) -(define call guile:apply) -(define (peek-byte) - (unread-byte (read-byte))) -;;(define peek-byte guile:peek-char) -(define (read-byte) - (char->integer (guile:read-char))) -(define (unread-byte x) - (guile:unread-char (guile:integer->char x)) - x) -(define (lookup x a) - ;; TODO - (stderr "lookup x=~a\n" x) - x) - -(define (char->integer c) - (if (guile:eof-object? c) -1 (guile:char->integer c))) - -(include "mes.mes") -;; guile-2.2 only, guile-2.0 has no include? -(include "reader.mes") - -(define (append2 x y) - (cond ((null? x) y) - (#t (cons (car x) (append2 (cdr x) y))))) - -;; READER: TODO lookup -(define (read) - (let ((x (guile:read))) - (if (guile:eof-object? x) '() - x))) - -(define (lookup-macro e a) - #f) - -(define guile:dot '#{.}#) - -(define environment - (guile:map - (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module)))) - '( - (*closure* . #t) - ((guile:list) . (guile:list)) - (#t . #t) - (#f . #f) - - (*unspecified* . guile:*unspecified*) - - (atom? . atom?) - (car . car) - (cdr . cdr) - (cons . cons) - ;; (cond . evcon) - (eq? . eq?) - - (null? . null?) - (pair? . guile:pair?) - ;; (quote . quote) - - (evlis-env . evlis-env) - (evcon . evcon) - (pairlis . pairlis) - (assq . assq) - (assq-ref-env . assq-ref-env) - - (eval-env . eval-env) - (apply-env . apply-env) - - (read . read) - (display . guile:display) - (newline . guile:newline) - - (builtin? . builtin?) - (number? . number?) - (call . call) - - (< . guile:<) - (- . guile:-) - - ;; DERIVED - (caar . caar) - (cadr . cadr) - (cdar . cdar) - (cddr . cddr) - (caadr . caadr) - (caddr . caddr) - (cdadr . cdadr) - (cadar . cadar) - (cddar . cddar) - (cdddr . cdddr) - - (append2 . append2) - (exit . guile:exit) - - (*macro* . (guile:list)) - (*dot* . guile:dot) - - ;; - (stderr . stderr)))) - -(define (main arguments) - (let ((program (cons 'begin (read-input-file)))) - (stderr "program:~a\n" program) - (stderr "=> ~s\n" (eval-env program environment))) - (guile:newline)) - -(guile:module-define! (guile:resolve-interface '(mes)) 'main main) diff --git a/guile/mescc b/guile/mescc deleted file mode 120000 index 540fb2db..00000000 --- a/guile/mescc +++ /dev/null @@ -1 +0,0 @@ -../module/mescc \ No newline at end of file diff --git a/guile/reader.mes b/guile/reader.mes deleted file mode 100644 index c00582b8..00000000 --- a/guile/reader.mes +++ /dev/null @@ -1,141 +0,0 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen -;;; -;;; 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 . - -;;; Commentary: - -;;; copy of mes/read-0.mes, comment-out read-input-file - -;;; Code: - -(begin - - ;; (define car (make-function 'car 0)) - ;; (define cdr (make-function 'cdr 1)) - ;; (define cons (make-function 'cons 1)) - - ;; TODO: - ;; * use case/cond, expand - ;; * etc int/char? - ;; * lookup in Scheme - ;; * read characters, quote, strings - - (define (read) - (read-word (read-byte) (list) (current-module))) - - (define (read-input-file) - (define (helper x) - (if (null? x) x - (cons x (helper (read))))) - (helper (read))) - - (define-macro (cond . clauses) - (list (quote if) (null? clauses) *unspecified* - (if (null? (cdr clauses)) - (list (quote if) (car (car clauses)) - (list (cons (quote lambda) (cons (list) (cons (car (car clauses)) (cdr (car clauses)))))) - *unspecified*) - (if (eq? (car (cadr clauses)) (quote else)) - (list (quote if) (car (car clauses)) - (list (cons (quote lambda) (cons (list) (car clauses)))) - (list (cons (quote lambda) (cons (list) (cons *unspecified* (cdr (cadr clauses))))))) - (list (quote if) (car (car clauses)) - (list (cons (quote lambda) (cons (list) (car clauses)))) - (cons (quote cond) (cdr clauses))))))) - - (define (eat-whitespace) - (cond - ((eq? (peek-byte) 9) (read-byte) (eat-whitespace)) - ((eq? (peek-byte) 10) (read-byte) (eat-whitespace)) - ((eq? (peek-byte) 13) (read-byte) (eat-whitespace)) - ((eq? (peek-byte) 32) (read-byte) (eat-whitespace)) - ((eq? (peek-byte) 59) (begin (read-line-comment (read-byte)) - (eat-whitespace))) - ((eq? (peek-byte) 35) (begin (read-byte) - (if (eq? (peek-byte) 33) (begin (read-byte) - (read-block-comment (read-byte)) - (eat-whitespace)) - (unread-byte 35)))))) - - (define (read-block-comment c) - (if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte) - (read-block-comment (read-byte))) - (read-block-comment (read-byte)))) - - ;; (define (read-hex c) - ;; (if (eq? c 10) c - ;; (read-line-comment (read-byte)))) - - (define (read-line-comment c) - (if (eq? c 10) c - (read-line-comment (read-byte)))) - - (define (read-list a) - (eat-whitespace) - (if (eq? (peek-byte) 41) (begin (read-byte) (list)) - ((lambda (w) - (if (eq? w *dot*) (car (read-list a)) - (cons w (read-list a)))) - (read-word (read-byte) (list) a)))) - - ;;(define (read-string)) - - (define (lookup-char c a) - (lookup (cons (integer->char c) (list)) a)) - - (define (read-word c w a) - (cond - ((eq? c -1) (list)) - ((eq? c 10) (if (null? w) (read-word (read-byte) (list) a) - (lookup w a))) - ((eq? c 32) (read-word 10 w a)) - ((eq? c 34) (if (null? w) (read-string) - (begin (unread-byte c) (lookup w a)))) - ((eq? c 35) (cond - ((eq? (peek-byte) 33) (begin (read-byte) - (read-block-comment (read-byte)) - (read-word (read-byte) w a))) - ((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a))) - ((eq? (peek-byte) 92) (read-byte) (read-character)) - ((eq? (peek-byte) 120) (read-byte) (read-hex)) - (else (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a)))) - ((eq? c 39) (if (null? w) (cons (lookup (cons (integer->char c) (list)) a) - (cons (read-word (read-byte) w a) (list))) - (begin (unread-byte c) (lookup w a)))) - ((eq? c 40) (if (null? w) (read-list a) - (begin (unread-byte c) (lookup w a)))) - ((eq? c 41) (if (null? w) (cons (lookup (cons (integer->char c) (list)) a) - (cons (read-word (read-byte) w a) (list))) - (begin (unread-byte c) (lookup w a)))) - ((eq? c 44) (cond - ((eq? (peek-byte) 64) (begin (read-byte) - (cons - (lookup (symbol->list (quote unquote-splicing)) a) - (cons (read-word (read-byte) w a) (list))))) - (else (cons (lookup-char c a) (cons (read-word (read-byte) w a) - (list)))))) - ((eq? c 96) (cons (lookup-char c a) (cons (read-word (read-byte) w a) (list)))) - ((eq? c 59) (read-line-comment c) (read-word 10 w a)) - (else (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a)))) - - ;; ((lambda (p) - ;; ;;(display (quote program=)) (display p) (newline) - ;; (begin-env p (current-module))) - ;; (read-input-file)) - ) diff --git a/install.sh b/install.sh index 9ff242e1..88bb2db8 100755 --- a/install.sh +++ b/install.sh @@ -15,6 +15,15 @@ MES_PREFIX=${MES_PREFIX-$prefix/share/mes} MES_SEED=${MES_SEED-../MES-SEED} TINYCC_SEED=${TINYCC_SEED-../TINYCC-SEED} +GUILE_EFFECTIVE_VERSION=${GUILE_EFFECTIVE_VERSION-2.2} +datadir=${moduledir-$prefix/share/mes} +docdir=${moduledir-$prefix/share/doc/mes} +mandir=${mandir-$prefix/share/man} +moduledir=${moduledir-$datadir/module} +guile_site_dir=${guile_site_dir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION} +guile_site_ccache_dir=${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache} +docdir=${moduledir-$prefix/share/doc/mes} + mkdir -p $DESTDIR$prefix/bin cp src/mes $DESTDIR$prefix/bin/mes @@ -23,21 +32,18 @@ mkdir -p $DESTDIR$MES_PREFIX/lib cp scripts/mescc $DESTDIR$prefix/bin/mescc mkdir -p $DESTDIR$MES_PREFIX -tar -cf- doc guile include lib module scaffold | tar -xf- -C $DESTDIR$MES_PREFIX +tar -cf- doc include lib scaffold | tar -xf- -C $DESTDIR$MES_PREFIX +tar -cf- --exclude='*.go' module | tar -xf- -C $DESTDIR$MES_PREFIX +tar -cf- -C mes module | tar -xf- -C $DESTDIR$MES_PREFIX -GUILE_EFFECTIVE_VERSION=${GUILE_EFFECTIVE_VERSION-2.2} -datadir=${moduledir-$prefix/share/mes} -docdir=${moduledir-$prefix/share/doc/mes} -mandir=${mandir-$prefix/share/man} -moduledir=${moduledir-$datadir/module} -guile_site_dir=${moduledir-$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION} -guile_site_ccache_dir=${guile_site_ccache_dir-$prefix/lib/guile/$GUILE_EFFECTIVE_VERSION/site-ccache} -docdir=${moduledir-$prefix/share/doc/mes} +mkdir -p $DESTDIR$guile_site_dir +mkdir -p $DESTDIR$guile_site_ccache_dir +tar -cf- -C module --exclude='*.go' . | tar -xf- -C $DESTDIR$guile_site_dir +tar -cf- -C module --exclude='*.scm' . | tar -xf- -C $DESTDIR$guile_site_ccache_dir chmod +w $DESTDIR$prefix/bin/mescc sed \ -e "s,^#! /bin/sh,#! $SHELL," \ - -e "s,module/,$moduledir/," \ -e "s,@datadir@,$datadir,g" \ -e "s,@docdir@,$docdir,g" \ -e "s,@guile_site_ccache_dir@,$guile_site_ccache_dir,g" \ @@ -49,7 +55,7 @@ sed \ chmod +w $DESTDIR$moduledir/mes/boot-0.scm sed \ -e "s,^#! /bin/sh,#! $SHELL," \ - -e "s,module/,$moduledir/," \ + -e "s,mes/module/,$moduledir/," \ -e "s,@datadir@,$datadir,g" \ -e "s,@docdir@,$docdir,g" \ -e "s,@guile_site_ccache_dir@,$guile_site_ccache_dir,g" \ @@ -57,7 +63,7 @@ sed \ -e "s,@moduledir@,$moduledir,g" \ -e "s,@prefix@,$prefix,g" \ -e "s,@VERSION@,$VERSION,g" \ - module/mes/boot-0.scm > $DESTDIR$moduledir/mes/boot-0.scm + mes/module/mes/boot-0.scm > $DESTDIR$moduledir/mes/boot-0.scm sed \ -e "s,^#! /bin/sh,#! $SHELL," \ diff --git a/mes/include b/mes/include new file mode 120000 index 00000000..f5030fe8 --- /dev/null +++ b/mes/include @@ -0,0 +1 @@ +../include \ No newline at end of file diff --git a/mes/lib b/mes/lib new file mode 120000 index 00000000..dc598c56 --- /dev/null +++ b/mes/lib @@ -0,0 +1 @@ +../lib \ No newline at end of file diff --git a/module/mes/base.mes b/mes/module/mes/base.mes similarity index 100% rename from module/mes/base.mes rename to mes/module/mes/base.mes diff --git a/module/mes/boot-0.scm b/mes/module/mes/boot-0.scm similarity index 90% rename from module/mes/boot-0.scm rename to mes/module/mes/boot-0.scm index 32296a7c..bac5b6a8 100644 --- a/module/mes/boot-0.scm +++ b/mes/module/mes/boot-0.scm @@ -173,14 +173,12 @@ (define %prefix (getenv "MES_PREFIX")) (define %moduledir - (if (not %prefix) "module/" + (if (not %prefix) "mes/module/" (list->string - (append (string->list %prefix) - (string->list "/module") ; `module/' gets replaced upon install - (string->list "/"))))) + (append (string->list %prefix) (string->list "/module/" ))))) (include (list->string - (append2 (string->list %moduledir) (string->list "/mes/type-0.mes")))) + (append2 (string->list %moduledir) (string->list "mes/type-0.mes")))) (define (symbol->string s) (apply string (symbol->list s))) @@ -211,20 +209,26 @@ (include-from-path "mes/module.mes") (mes-use-module (mes base)) -;; ;; (mes-use-module (srfi srfi-0)) (mes-use-module (mes quasiquote)) (mes-use-module (mes let)) - (mes-use-module (mes scm)) - -(mes-use-module (srfi srfi-1)) ;; FIXME: module read order +(mes-use-module (srfi srfi-1)) (mes-use-module (srfi srfi-13)) - -(mes-use-module (mes fluids)) ;; FIXME: module read order +(mes-use-module (mes fluids)) (mes-use-module (mes catch)) - (mes-use-module (mes posix)) +(define-macro (include-from-path file) + (let loop ((path (cons* %moduledir "module" (string-split (or (getenv "GUILE_LOAD_PATH")) #\:)))) + (cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 2)) string->number)) + (core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n"))) + ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number)) + (core:display-error (string-append "include-from-path: " file "\n")))) + (if (null? path) (error "include-from-path: not found: " file) + (let ((file (string-append (car path) "/" file))) + (if (access? file R_OK) `(load ,file) + (loop (cdr path))))))) + (define-macro (define-module module . rest) `(if ,(and (pair? module) (= 1 (length module)) @@ -233,8 +237,6 @@ (define-macro (use-modules . rest) #t) -;; ;; end boot-0.scm - (mes-use-module (mes getopt-long)) (define %main #f) diff --git a/module/mes/boot-00.scm b/mes/module/mes/boot-00.scm similarity index 100% rename from module/mes/boot-00.scm rename to mes/module/mes/boot-00.scm diff --git a/module/mes/boot-01.scm b/mes/module/mes/boot-01.scm similarity index 100% rename from module/mes/boot-01.scm rename to mes/module/mes/boot-01.scm diff --git a/module/mes/boot-02.scm b/mes/module/mes/boot-02.scm similarity index 98% rename from module/mes/boot-02.scm rename to mes/module/mes/boot-02.scm index c051f745..17837445 100644 --- a/module/mes/boot-02.scm +++ b/mes/module/mes/boot-02.scm @@ -110,6 +110,10 @@ (define-macro (mes-use-module module) #t) + +(define-macro (define-module module . rest) + #t) + ;; end boot-02.scm (primitive-load 0) diff --git a/module/mes/catch.mes b/mes/module/mes/catch.mes similarity index 100% rename from module/mes/catch.mes rename to mes/module/mes/catch.mes diff --git a/module/mes/display.mes b/mes/module/mes/display.mes similarity index 100% rename from module/mes/display.mes rename to mes/module/mes/display.mes diff --git a/module/mes/fluids.mes b/mes/module/mes/fluids.mes similarity index 100% rename from module/mes/fluids.mes rename to mes/module/mes/fluids.mes diff --git a/module/mes/getopt-long.mes b/mes/module/mes/getopt-long.mes similarity index 100% rename from module/mes/getopt-long.mes rename to mes/module/mes/getopt-long.mes diff --git a/module/mes/guile.mes b/mes/module/mes/guile.mes similarity index 86% rename from module/mes/guile.mes rename to mes/module/mes/guile.mes index c50925a8..b59135b3 100644 --- a/module/mes/guile.mes +++ b/mes/module/mes/guile.mes @@ -26,17 +26,6 @@ (define-macro (cond-expand-provide . rest) #t) -(define-macro (include-from-path file) - (let loop ((path (cons %moduledir (string-split (or (getenv "GUILE_LOAD_PATH") "") #\:)))) - (cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number)) - (core:display-error (string-append "include-from-path: " file "\n"))) - ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))) - (core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n"))) - (if (null? path) (error "include-from-path: not found: " file) - (let ((file (string-append (car path) "/" file))) - (if (access? file R_OK) `(load ,file) - (loop (cdr path))))))) - (mes-use-module (mes catch)) (mes-use-module (mes posix)) (mes-use-module (srfi srfi-16)) diff --git a/module/mes/lalr.mes b/mes/module/mes/lalr.mes similarity index 100% rename from module/mes/lalr.mes rename to mes/module/mes/lalr.mes diff --git a/module/mes/lalr.scm b/mes/module/mes/lalr.scm similarity index 100% rename from module/mes/lalr.scm rename to mes/module/mes/lalr.scm diff --git a/module/mes/let.mes b/mes/module/mes/let.mes similarity index 100% rename from module/mes/let.mes rename to mes/module/mes/let.mes diff --git a/module/mes/match.mes b/mes/module/mes/match.mes similarity index 100% rename from module/mes/match.mes rename to mes/module/mes/match.mes diff --git a/module/mes/match.scm b/mes/module/mes/match.scm similarity index 100% rename from module/mes/match.scm rename to mes/module/mes/match.scm diff --git a/module/mes/mescc.mes b/mes/module/mes/mescc.mes similarity index 100% rename from module/mes/mescc.mes rename to mes/module/mes/mescc.mes diff --git a/module/mes/misc.mes b/mes/module/mes/misc.mes similarity index 100% rename from module/mes/misc.mes rename to mes/module/mes/misc.mes diff --git a/module/mes/module.mes b/mes/module/mes/module.mes similarity index 100% rename from module/mes/module.mes rename to mes/module/mes/module.mes diff --git a/module/mes/optargs.mes b/mes/module/mes/optargs.mes similarity index 100% rename from module/mes/optargs.mes rename to mes/module/mes/optargs.mes diff --git a/module/mes/optargs.scm b/mes/module/mes/optargs.scm similarity index 100% rename from module/mes/optargs.scm rename to mes/module/mes/optargs.scm diff --git a/module/mes/peg.mes b/mes/module/mes/peg.mes similarity index 100% rename from module/mes/peg.mes rename to mes/module/mes/peg.mes diff --git a/module/mes/peg/cache.scm b/mes/module/mes/peg/cache.scm similarity index 100% rename from module/mes/peg/cache.scm rename to mes/module/mes/peg/cache.scm diff --git a/module/mes/peg/codegen.scm b/mes/module/mes/peg/codegen.scm similarity index 100% rename from module/mes/peg/codegen.scm rename to mes/module/mes/peg/codegen.scm diff --git a/module/mes/peg/simplify-tree.scm b/mes/module/mes/peg/simplify-tree.scm similarity index 100% rename from module/mes/peg/simplify-tree.scm rename to mes/module/mes/peg/simplify-tree.scm diff --git a/module/mes/peg/string-peg.scm b/mes/module/mes/peg/string-peg.scm similarity index 100% rename from module/mes/peg/string-peg.scm rename to mes/module/mes/peg/string-peg.scm diff --git a/module/mes/peg/using-parsers.scm b/mes/module/mes/peg/using-parsers.scm similarity index 100% rename from module/mes/peg/using-parsers.scm rename to mes/module/mes/peg/using-parsers.scm diff --git a/module/mes/pmatch.mes b/mes/module/mes/pmatch.mes similarity index 100% rename from module/mes/pmatch.mes rename to mes/module/mes/pmatch.mes diff --git a/module/mes/pmatch.scm b/mes/module/mes/pmatch.scm similarity index 100% rename from module/mes/pmatch.scm rename to mes/module/mes/pmatch.scm diff --git a/module/mes/posix.mes b/mes/module/mes/posix.mes similarity index 100% rename from module/mes/posix.mes rename to mes/module/mes/posix.mes diff --git a/module/mes/pretty-print.mes b/mes/module/mes/pretty-print.mes similarity index 100% rename from module/mes/pretty-print.mes rename to mes/module/mes/pretty-print.mes diff --git a/module/mes/pretty-print.scm b/mes/module/mes/pretty-print.scm similarity index 100% rename from module/mes/pretty-print.scm rename to mes/module/mes/pretty-print.scm diff --git a/module/mes/psyntax-0.mes b/mes/module/mes/psyntax-0.mes similarity index 100% rename from module/mes/psyntax-0.mes rename to mes/module/mes/psyntax-0.mes diff --git a/module/mes/psyntax-1.mes b/mes/module/mes/psyntax-1.mes similarity index 100% rename from module/mes/psyntax-1.mes rename to mes/module/mes/psyntax-1.mes diff --git a/module/mes/psyntax.mes b/mes/module/mes/psyntax.mes similarity index 100% rename from module/mes/psyntax.mes rename to mes/module/mes/psyntax.mes diff --git a/module/mes/psyntax.pp b/mes/module/mes/psyntax.pp similarity index 100% rename from module/mes/psyntax.pp rename to mes/module/mes/psyntax.pp diff --git a/module/mes/psyntax.ss b/mes/module/mes/psyntax.ss similarity index 100% rename from module/mes/psyntax.ss rename to mes/module/mes/psyntax.ss diff --git a/module/mes/quasiquote.mes b/mes/module/mes/quasiquote.mes similarity index 100% rename from module/mes/quasiquote.mes rename to mes/module/mes/quasiquote.mes diff --git a/module/mes/quasisyntax.mes b/mes/module/mes/quasisyntax.mes similarity index 100% rename from module/mes/quasisyntax.mes rename to mes/module/mes/quasisyntax.mes diff --git a/module/mes/quasisyntax.scm b/mes/module/mes/quasisyntax.scm similarity index 100% rename from module/mes/quasisyntax.scm rename to mes/module/mes/quasisyntax.scm diff --git a/module/mes/repl.mes b/mes/module/mes/repl.mes similarity index 100% rename from module/mes/repl.mes rename to mes/module/mes/repl.mes diff --git a/module/mes/scm.mes b/mes/module/mes/scm.mes similarity index 100% rename from module/mes/scm.mes rename to mes/module/mes/scm.mes diff --git a/module/mes/syntax.mes b/mes/module/mes/syntax.mes similarity index 100% rename from module/mes/syntax.mes rename to mes/module/mes/syntax.mes diff --git a/module/mes/syntax.scm b/mes/module/mes/syntax.scm similarity index 100% rename from module/mes/syntax.scm rename to mes/module/mes/syntax.scm diff --git a/mes/module/mes/test.mes b/mes/module/mes/test.mes new file mode 100644 index 00000000..41d6a2c9 --- /dev/null +++ b/mes/module/mes/test.mes @@ -0,0 +1,21 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; +;;; 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 . + +(include-from-path "mes/test.scm") diff --git a/module/mes/tiny-0.mes b/mes/module/mes/tiny-0.mes similarity index 100% rename from module/mes/tiny-0.mes rename to mes/module/mes/tiny-0.mes diff --git a/module/mes/type-0.mes b/mes/module/mes/type-0.mes similarity index 100% rename from module/mes/type-0.mes rename to mes/module/mes/type-0.mes diff --git a/module/mescc/M1.mes b/mes/module/mescc/M1.mes similarity index 100% rename from module/mescc/M1.mes rename to mes/module/mescc/M1.mes diff --git a/module/mescc/as.mes b/mes/module/mescc/as.mes similarity index 100% rename from module/mescc/as.mes rename to mes/module/mescc/as.mes diff --git a/module/mescc/bytevectors.mes b/mes/module/mescc/bytevectors.mes similarity index 100% rename from module/mescc/bytevectors.mes rename to mes/module/mescc/bytevectors.mes diff --git a/module/mescc/compile.mes b/mes/module/mescc/compile.mes similarity index 100% rename from module/mescc/compile.mes rename to mes/module/mescc/compile.mes diff --git a/module/mescc/i386/as.mes b/mes/module/mescc/i386/as.mes similarity index 100% rename from module/mescc/i386/as.mes rename to mes/module/mescc/i386/as.mes diff --git a/module/mescc/info.mes b/mes/module/mescc/info.mes similarity index 100% rename from module/mescc/info.mes rename to mes/module/mescc/info.mes diff --git a/module/mescc/mescc.mes b/mes/module/mescc/mescc.mes similarity index 100% rename from module/mescc/mescc.mes rename to mes/module/mescc/mescc.mes diff --git a/module/mescc/preprocess.mes b/mes/module/mescc/preprocess.mes similarity index 100% rename from module/mescc/preprocess.mes rename to mes/module/mescc/preprocess.mes diff --git a/module/nyacc/lalr.mes b/mes/module/nyacc/lalr.mes similarity index 100% rename from module/nyacc/lalr.mes rename to mes/module/nyacc/lalr.mes diff --git a/module/nyacc/lang/c99/cpp.mes b/mes/module/nyacc/lang/c99/cpp.mes similarity index 100% rename from module/nyacc/lang/c99/cpp.mes rename to mes/module/nyacc/lang/c99/cpp.mes diff --git a/module/nyacc/lang/c99/parser.mes b/mes/module/nyacc/lang/c99/parser.mes similarity index 100% rename from module/nyacc/lang/c99/parser.mes rename to mes/module/nyacc/lang/c99/parser.mes diff --git a/module/nyacc/lang/c99/pprint.mes b/mes/module/nyacc/lang/c99/pprint.mes similarity index 100% rename from module/nyacc/lang/c99/pprint.mes rename to mes/module/nyacc/lang/c99/pprint.mes diff --git a/module/nyacc/lang/calc/parser.mes b/mes/module/nyacc/lang/calc/parser.mes similarity index 100% rename from module/nyacc/lang/calc/parser.mes rename to mes/module/nyacc/lang/calc/parser.mes diff --git a/module/nyacc/lang/util.mes b/mes/module/nyacc/lang/util.mes similarity index 100% rename from module/nyacc/lang/util.mes rename to mes/module/nyacc/lang/util.mes diff --git a/module/nyacc/lex.mes b/mes/module/nyacc/lex.mes similarity index 100% rename from module/nyacc/lex.mes rename to mes/module/nyacc/lex.mes diff --git a/module/nyacc/parse.mes b/mes/module/nyacc/parse.mes similarity index 100% rename from module/nyacc/parse.mes rename to mes/module/nyacc/parse.mes diff --git a/module/nyacc/util.mes b/mes/module/nyacc/util.mes similarity index 100% rename from module/nyacc/util.mes rename to mes/module/nyacc/util.mes diff --git a/module/rnrs/arithmetic/bitwise.mes b/mes/module/rnrs/arithmetic/bitwise.mes similarity index 100% rename from module/rnrs/arithmetic/bitwise.mes rename to mes/module/rnrs/arithmetic/bitwise.mes diff --git a/module/srfi/srfi-0.mes b/mes/module/srfi/srfi-0.mes similarity index 100% rename from module/srfi/srfi-0.mes rename to mes/module/srfi/srfi-0.mes diff --git a/module/srfi/srfi-1.mes b/mes/module/srfi/srfi-1.mes similarity index 100% rename from module/srfi/srfi-1.mes rename to mes/module/srfi/srfi-1.mes diff --git a/module/srfi/srfi-1.scm b/mes/module/srfi/srfi-1.scm similarity index 100% rename from module/srfi/srfi-1.scm rename to mes/module/srfi/srfi-1.scm diff --git a/module/srfi/srfi-13.mes b/mes/module/srfi/srfi-13.mes similarity index 100% rename from module/srfi/srfi-13.mes rename to mes/module/srfi/srfi-13.mes diff --git a/module/srfi/srfi-14.mes b/mes/module/srfi/srfi-14.mes similarity index 100% rename from module/srfi/srfi-14.mes rename to mes/module/srfi/srfi-14.mes diff --git a/module/srfi/srfi-16.mes b/mes/module/srfi/srfi-16.mes similarity index 100% rename from module/srfi/srfi-16.mes rename to mes/module/srfi/srfi-16.mes diff --git a/module/srfi/srfi-16.scm b/mes/module/srfi/srfi-16.scm similarity index 100% rename from module/srfi/srfi-16.scm rename to mes/module/srfi/srfi-16.scm diff --git a/module/srfi/srfi-26.mes b/mes/module/srfi/srfi-26.mes similarity index 100% rename from module/srfi/srfi-26.mes rename to mes/module/srfi/srfi-26.mes diff --git a/module/srfi/srfi-26.scm b/mes/module/srfi/srfi-26.scm similarity index 100% rename from module/srfi/srfi-26.scm rename to mes/module/srfi/srfi-26.scm diff --git a/module/srfi/srfi-43.mes b/mes/module/srfi/srfi-43.mes similarity index 100% rename from module/srfi/srfi-43.mes rename to mes/module/srfi/srfi-43.mes diff --git a/module/srfi/srfi-8.mes b/mes/module/srfi/srfi-8.mes similarity index 100% rename from module/srfi/srfi-8.mes rename to mes/module/srfi/srfi-8.mes diff --git a/module/srfi/srfi-9.mes b/mes/module/srfi/srfi-9.mes similarity index 100% rename from module/srfi/srfi-9.mes rename to mes/module/srfi/srfi-9.mes diff --git a/module/srfi/srfi-9/gnu.mes b/mes/module/srfi/srfi-9/gnu.mes similarity index 100% rename from module/srfi/srfi-9/gnu.mes rename to mes/module/srfi/srfi-9/gnu.mes diff --git a/module/sxml/xpath.mes b/mes/module/sxml/xpath.mes similarity index 100% rename from module/sxml/xpath.mes rename to mes/module/sxml/xpath.mes diff --git a/module/sxml/xpath.scm b/mes/module/sxml/xpath.scm similarity index 100% rename from module/sxml/xpath.scm rename to mes/module/sxml/xpath.scm diff --git a/module/language/paren.mes b/module/language/paren.mes deleted file mode 100644 index f3039ea5..00000000 --- a/module/language/paren.mes +++ /dev/null @@ -1,177 +0,0 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2008 Derek Peschel -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen -;;; -;;; 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 . - -;;; Commentary: - -;;; paren.mes is a simple yet full lalr test for Mes taken from the -;;; Gambit wiki. -;;; -;;; Run with Guile: -;;; echo '___P((()))' | guile -s <(echo '(paren-depth)' | cat cc/paren.mes -) - -;;; Code: - -(cond-expand - (guile - (use-modules (system base lalr))) - (mes - (mes-use-module (srfi srfi-9)) - (mes-use-module (mes lalr)))) - -;;; Taken from http://gambitscheme.org/wiki/index.php/Lalr_example -;;; LGPL 2.1 / Apache 2.0 - -;;; Read C source code, breaking it into the following types of tokens: -;;; the identifier ___P, other identifiers, left and right parentheses, -;;; and any other non-spacing character. White space (space, tab, and -;;; newline characters) is never a token and may come between any two -;;; tokens, before the first, or after the last. - -;;; Whenever the identifier ___P is seen, read a left parenthesis -;;; followed by a body (zero or more tokens) followed by a right -;;; parenthesis. If the body contains parentheses they must be properly -;;; paired. Other tokens in the body, including ___P, have no effect. -;;; Count the deepest nesting level used in the body. Count the maximum -;;; deepest level (of all the bodies seen so far). - -;;; At the end of the file, print the maximum deepest level, or 0 if no -;;; bodies were found. - - -;;; Global variables used by lexical analyzer and parser. -;;; The lexical analyzer needs them to print the maximum level at the -;;; end of the file. - -(define depth 0) -(define max-depth 0) - -;;; Lexical analyzer. Passes tokens to the parser. - -(define (paren-depth-lexer errorp) - (lambda () - - ;; Utility functions, for identifying characters, skipping any - ;; amount of white space, or reading multicharacter tokens. - - (letrec ((char-whitespace? - (lambda (c) - (or (char=? c #\space) - (char=? c #\tab) - (char=? c #\newline)))) - (skip-whitespace - (lambda () - (let loop ((c (peek-char))) - (if (and (not (eof-object? c)) - (char-whitespace? c)) - (begin (read-char) - (loop (peek-char))))))) - - (char-in-id? - (lambda (c) - (or (char-alphabetic? c) - (char=? c #\_)))) - (read-___P-or-other-id - (lambda (l) - (let ((c (peek-char))) - (if (char-in-id? c) - (read-___P-or-other-id (cons (read-char) l)) - ;; else - (if (equal? l '(#\P #\_ #\_ #\_)) - '___P - ;; else - 'ID)))))) - - ;; The lexer function. - - (skip-whitespace) - (let loop ((c (read-char))) - (cond - ((eof-object? c) (begin (display "max depth ") - (display max-depth) - (newline) - '*eoi*)) - ((char-whitespace? c) (begin (errorp "didn't expect whitespace " c) - (loop (read-char)))) - ((char-in-id? c) (read-___P-or-other-id (list c))) - ((char=? c #\() 'LPAREN) - ((char=? c #\)) 'RPAREN) - (else 'CHAR)))))) - -;;; Parser. - -(define paren-depth-parser - (lalr-parser - - ;; Options. - - (expect: 0) ;; even one conflict is an error - - ;; List of terminal tokens. - - (CHAR LPAREN RPAREN ID ___P) - - ;; Grammar rules. - - (file (newfile tokens)) - (newfile () : (begin (set! depth 0) - (set! max-depth 0))) - - (tokens (tokens token) - (token)) - - ;; When not after a ___P, the structure of the file is unimportant. - (token (CHAR) - (LPAREN) - (RPAREN) - (ID) - - ;; But after a ___P, we start counting parentheses. - (___P newexpr in LPAREN exprs RPAREN out) - (___P newexpr in LPAREN RPAREN out)) - (newexpr () : (set! depth 0)) - - ;; Inside an expression, ___P is treated like all other identifiers. - ;; Only parentheses do anything very interesting. I'm assuming Lalr - ;; will enforce the pairing of parentheses, so my in and out actions - ;; don't check for too many or too few closing parens. - - (exprs (exprs expr) - (expr)) - - (expr (CHAR) - (in LPAREN exprs RPAREN out) - (in LPAREN RPAREN out) - (ID) - (___P)) - (in () : (begin (set! depth (+ depth 1)) - (if (> depth max-depth) - (set! max-depth depth)))) - (out () : (set! depth (- depth 1))))) - -;;; Main program. - -(define paren-depth - (let ((errorp - (lambda args - (for-each display args) - (newline)))) - (lambda () - (paren-depth-parser (paren-depth-lexer errorp) errorp)))) diff --git a/guile/mes-0.scm b/module/mes/mes-0.scm similarity index 94% rename from guile/mes-0.scm rename to module/mes/mes-0.scm index e6714572..99a0327d 100644 --- a/guile/mes-0.scm +++ b/module/mes/mes-0.scm @@ -27,10 +27,5 @@ (define-macro (mes-use-module . rest) #t) (define builtin? procedure?) ; not strictly true, but ok for tests/*.test -(cond-expand - (mes) - (guile-2) - (guile - (use-modules (ice-9 syncase)))) (define EOF (if #f #f)) (define append2 append) diff --git a/module/mes/test.mes b/module/mes/test.mes deleted file mode 100644 index eddb5673..00000000 --- a/module/mes/test.mes +++ /dev/null @@ -1,128 +0,0 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen -;;; -;;; 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 . - -;;; Commentary: - -;;; test.mes can be loaded after base.mes. It provides a minimalistic -;;; test framework: pass-if, pass-if-not, seq?, sequal? and result. - -;;; Code: - -(cond-expand - (mes - (mes-use-module (mes base))) - (else)) - -(cond-expand - (mes - (define mes? #t) - (define guile? #f) - (define guile-2? #f) - (define guile-1.8? #f)) - (guile-2 - (define mes? #f) - (define guile? #t) - (define guile-2? #t) - (define guile-1.8? #f)) - (guile - (define mes? #f) - (define guile? #f) - (define guile-2? #f) - (define guile-1.8? #t))) - -(define result - ((lambda (pass fail) - (lambda (. t) - (if (or (null? t) (eq? (car t) 'result)) (list pass fail) - (if (eq? (car t) 'report) - (begin - ((lambda (expect) - (begin (display "expect: ") (write expect) (newline)) - (newline) - (display "passed: ") (display pass) (newline) - (display "failed: ") (display fail) (newline) - (if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline))) - (display "total: ") (display (+ pass fail)) (newline) - (exit (if (eq? expect fail) 0 fail))) - (if (null? (cdr t)) 0 (cadr t)))) - (if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1))) - (begin (display ": fail") (newline) (set! fail (+ fail 1)))))))) - 0 0)) - -(define (seq? expect a) ;;REMOVE ME - (or (eq? a expect) - (begin - (display ": fail") - (newline) - (display "expected: ") - (display expect) (newline) - (display "actual: ") - (display a) - (newline) - #f))) - -(define (sequal? expect a) ;;REMOVE ME - (or (equal? a expect) - (begin - (display ": fail") - (newline) - (display "expected: ") - (display expect) (newline) - (display "actual: ") - (display a) - (newline) - #f))) - -(define (seq2? a expect) - (or (eq? a expect) - (begin - (display ": fail") (newline) - (display "expected: ") (display expect) (newline) - (display "actual: ") (display a) (newline) - #f))) - -(define (sequal2? actual expect) - (or (equal? actual expect) - (begin - (display ": fail") (newline) - (display "expected: ") (display expect) (newline) - (display "actual: ") (display actual) (newline) - #f))) - -(define-macro (pass-if name t) - (list - 'begin - (list display "test: ") (list display name) - (list 'result t))) ;; FIXME - -(define-macro (pass-if-eq name expect . body) - (list 'pass-if name (list seq2? (cons 'begin body) expect))) - -(define-macro (pass-if-equal name expect . body) - (list 'pass-if name (list sequal2? (cons 'begin body) expect))) - -(define-macro (expect-fail name expect . body) - (list 'pass-if name (list not (list sequal2? (cons 'begin body) expect)))) - -(define-macro (pass-if-not name f) - (list - 'begin - (list display "test: ") (list display name) - (list 'result (list not f)))) ;; FIXME diff --git a/module/mes/test.scm b/module/mes/test.scm index 2e27db17..508e4098 100644 --- a/module/mes/test.scm +++ b/module/mes/test.scm @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of Mes. ;;; @@ -18,5 +18,106 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(define-module (mes test)) -(include-from-path "mes/test.mes") +;;; Commentary: + +;;; test.mes can be loaded after base.mes. It provides a minimalistic +;;; test framework: pass-if, pass-if-not, seq?, sequal? and result. + +;;; Code: + +(cond-expand + (mes + (define mes? #t) + (define guile? #f) + (define guile-2? #f) + (define guile-1.8? #f)) + (guile-2 + (define mes? #f) + (define guile? #t) + (define guile-2? #t) + (define guile-1.8? #f)) + (guile + (define mes? #f) + (define guile? #f) + (define guile-2? #f) + (define guile-1.8? #t))) + +(define result + ((lambda (pass fail) + (lambda (. t) + (if (or (null? t) (eq? (car t) 'result)) (list pass fail) + (if (eq? (car t) 'report) + (begin + ((lambda (expect) + (begin (display "expect: ") (write expect) (newline)) + (newline) + (display "passed: ") (display pass) (newline) + (display "failed: ") (display fail) (newline) + (if (not (eq? expect 0)) (begin (display "expect: ") (write expect) (newline))) + (display "total: ") (display (+ pass fail)) (newline) + (exit (if (eq? expect fail) 0 fail))) + (if (null? (cdr t)) 0 (cadr t)))) + (if (car t) (begin (display ": pass") (newline) (set! pass (+ pass 1))) + (begin (display ": fail") (newline) (set! fail (+ fail 1)))))))) + 0 0)) + +(define (seq? expect a) ;;REMOVE ME + (or (eq? a expect) + (begin + (display ": fail") + (newline) + (display "expected: ") + (display expect) (newline) + (display "actual: ") + (display a) + (newline) + #f))) + +(define (sequal? expect a) ;;REMOVE ME + (or (equal? a expect) + (begin + (display ": fail") + (newline) + (display "expected: ") + (display expect) (newline) + (display "actual: ") + (display a) + (newline) + #f))) + +(define (seq2? a expect) + (or (eq? a expect) + (begin + (display ": fail") (newline) + (display "expected: ") (display expect) (newline) + (display "actual: ") (display a) (newline) + #f))) + +(define (sequal2? actual expect) + (or (equal? actual expect) + (begin + (display ": fail") (newline) + (display "expected: ") (display expect) (newline) + (display "actual: ") (display actual) (newline) + #f))) + +(define-macro (pass-if name t) + (list + 'begin + (list display "test: ") (list display name) + (list 'result t))) ;; FIXME + +(define-macro (pass-if-eq name expect . body) + (list 'pass-if name (list seq2? (cons 'begin body) expect))) + +(define-macro (pass-if-equal name expect . body) + (list 'pass-if name (list sequal2? (cons 'begin body) expect))) + +(define-macro (expect-fail name expect . body) + (list 'pass-if name (list not (list sequal2? (cons 'begin body) expect)))) + +(define-macro (pass-if-not name f) + (list + 'begin + (list display "test: ") (list display name) + (list 'result (list not f)))) ;; FIXME diff --git a/scaffold/boot/51-module.scm b/scaffold/boot/51-module.scm index 981a4248..5a9caabb 100644 --- a/scaffold/boot/51-module.scm +++ b/scaffold/boot/51-module.scm @@ -17,7 +17,8 @@ ;;; along with Mes. If not, see . (cond-expand - (guile) + (guile + (set! %load-path (append %load-path '("mes/module")))) (mes (define (cons* . rest) (if (null? (cdr rest)) (car rest) @@ -63,11 +64,9 @@ (core:make-cell lst 0)) (define %moduledir - (if (not %prefix ) "module/" + (if (not %prefix ) "mes/module/" (list->string - (append (string->list %prefix) - (string->list "/module") ; `module/' gets replaced upon install - (string->list "/"))))) + (append (string->list %prefix) (string->list "/module/"))))) (define-macro (load file) (list 'begin diff --git a/scaffold/boot/52-define-module.scm b/scaffold/boot/52-define-module.scm index 67aad117..48277f9d 100644 --- a/scaffold/boot/52-define-module.scm +++ b/scaffold/boot/52-define-module.scm @@ -83,5 +83,5 @@ )) (define %moduledir "./") -(primitive-load "module/mes/module.mes") +(primitive-load "mes/module/mes/module.mes") (mes-use-module (scaffold boot data bar)) diff --git a/guile/gc.scm b/scaffold/gc.scm similarity index 89% rename from guile/gc.scm rename to scaffold/gc.scm index 2f680b77..c2505909 100644 --- a/guile/gc.scm +++ b/scaffold/gc.scm @@ -1,29 +1,3 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen -;;; -;;; mes.mes: 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 . - -;;; Commentary: - -;;; This is an early SICP stop-and-copy garbage collector playground, -;;; currently not used. - -;;; Code: (define-module (guile gc)) @@ -238,7 +212,7 @@ (if (eq? scan gc-free) (gc-flip) (let ((old (vector-ref new-cars scan))) (let ((new (gc-relocate old))) - (let ((old (gc-update-car scan new))) + (let ((old (gc-update-car scan new))) (let ((new (gc-relocate old))) (let ((scan (gc-update-cdr scan new))) (gc-loop scan)))))))) @@ -256,7 +230,7 @@ (define (gc-relocate old) ; old -> new (display "gc-relocate old=") (display old) (newline) (display "gc-relocate old is pair?=") (display (gc-pair? old)) (newline) - + (if (not (gc-pair? old)) old (let ((oldcr (vector-ref the-cars (cell-index old)))) (display "gc-relocate oldcr=") (display oldcr) (newline) diff --git a/scripts/mescc b/scripts/mescc index eece8746..3079e443 100755 --- a/scripts/mescc +++ b/scripts/mescc @@ -6,20 +6,23 @@ fi prefix=${prefix-@prefix@} if [ "@prefix@" = @prefix""@ -o ! -d "$prefix/share/mes/module" ] then - MES_PREFIX=${MES_PREFIX-$(cd $(dirname $0)/.. && pwd)} + MES_PREFIX=${MES_PREFIX-$(cd $(dirname $0)/.. && pwd)/mes} else MES_PREFIX=${MES_PREFIX-$prefix/share/mes} fi export MES_PREFIX mes_p=$(command -v mes) + +guile_site_dir=${guile_site_dir-@guile_site_dir@} +[ "$guile_site_dir" = @"guile_site_dir"@ ] && guile_site_dir=$(dirname $0)/../module +GUILE_LOAD_PATH=$guile_site_dir:$GUILE_LOAD_PATH + if [ '(' -z "$mes_p" -a -z "$MES" ')' -o "$MES" = "guile" -o "$MES" = "mes.guile" ]; then guile_site_ccache_dir=${guile_site_ccache_dir-@guile_site_ccache_dir@} - guile_site_dir=${guile_site_dir-@guile_site_dir@} - [ "$guile_site_ccache_dir" = @"guile_site_ccache_dir"@ ] && guile_site_ccache_dir=$(dirname $0)/../guile - [ "$guile_site_dir" = @"guile_site_dir"@ ] && guile_site_dir=$(dirname $0)/../guile + [ "$guile_site_ccache_dir" = @"guile_site_ccache_dir"@ ] && guile_site_ccache_dir=$(dirname $0)/../module + GUILE_LOAD_COMPILED_PATH=$guile_site_ccache_dir:$GUILE_LOAD_COMPILED_PATH GUILE_AUTO_COMPILE=${GUILE_AUTO_COMPILE-0} export GUILE_AUTO_COMPILE - GUILE_LOAD_COMPILED_PATH=$guile_site_ccache_dir:$GUILE_LOAD_COMPILED_PATH exec ${GUILE-guile} -L $guile_site_dir -e '(mescc)' -s "$0" "$@" else MES=${MES-$(dirname $0)/mes} diff --git a/src/mes.c b/src/mes.c index 744ab848..e33c4203 100644 --- a/src/mes.c +++ b/src/mes.c @@ -2259,7 +2259,7 @@ load_env (SCM a) ///((internal)) } if (g_stdin < 0) { - strcpy (prefix, "module/mes/"); + strcpy (prefix, "mes/module/mes/"); g_stdin = load_boot (prefix, boot, "."); } if (g_stdin < 0) diff --git a/tests/base.test-guile b/tests/base.test-guile index d293e480..8944d1de 100755 --- a/tests/base.test-guile +++ b/tests/base.test-guile @@ -20,4 +20,4 @@ test=$(dirname $0)/$(basename $0 -guile) GUILE=${GUILE-guile} -cat guile/mes-0.scm module/mes/test.mes $test | exec $GUILE -L guile -s /dev/stdin +cat module/mes/mes-0.scm module/mes/test.scm $test | exec $GUILE --no-auto-compile -L module-guile -C module-guile -L module -C module -s /dev/stdin diff --git a/tests/boot.test b/tests/boot.test index 753f4b6c..86b58354 100755 --- a/tests/boot.test +++ b/tests/boot.test @@ -27,8 +27,7 @@ exit $? ;;; along with Mes. If not, see . (begin - (primitive-load "module/mes/test.mes")) -;;(mes-use-module (mes test)) + (primitive-load "module/mes/test.scm")) (pass-if "first dummy" #t) (pass-if-not "second dummy" #f) diff --git a/tests/srfi-13.test b/tests/srfi-13.test index 882b4ce3..bad99a1b 100755 --- a/tests/srfi-13.test +++ b/tests/srfi-13.test @@ -106,5 +106,4 @@ exit $? (pass-if-equal "string-replace" "fubar" (string-replace "foobar" "u" 1 3)) - (result 'report) diff --git a/tests/srfi-9.test b/tests/srfi-9.test index 799c671a..9d32cbf7 100755 --- a/tests/srfi-9.test +++ b/tests/srfi-9.test @@ -33,8 +33,7 @@ exit $? (mes-use-module (mes test))) (guile (use-modules (srfi srfi-9)) - (use-modules (srfi srfi-9 gnu)) - (use-modules (mes test)))) + (use-modules (srfi srfi-9 gnu)))) (pass-if "first dummy" #t) (pass-if-not "second dummy" #f)