mescc: Allow invoking git mescc.mes from elsewhere.

* src/mes.c (load_env): Look in MES_PREFIX too.  Add debug printing.
* scripts/mescc.mes: Consider MES_PREFIX.
* guile/mescc.scm (%prefix): Consider MES_PREFIX.
* module/mes/base-0.mes (string->list): New function, move from type-0.mes.
  (%moduledir): Consider MES_PREFIX.
* module/mes/type-0.mes (string->list): Remove.
This commit is contained in:
Jan Nieuwenhuizen 2017-12-09 22:38:51 +01:00
parent ccddde9a84
commit a2f6511f5e
5 changed files with 73 additions and 16 deletions

View file

@ -45,7 +45,7 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/mescc.scm
#:use-module (srfi srfi-26)
#:export (main))
(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "MES_PREFIX") "") "@PREFIX@"))
(module-define! (resolve-module '(language c99 compiler)) '%prefix %prefix)
(define (parse-opts args)

View file

@ -109,7 +109,19 @@
(if (null? (cdr rest)) (car rest)
(append2 (car rest) (apply append (cdr rest))))))
(include "module/mes/type-0.mes")
(define (string->list s)
(core:car s))
(define %prefix (getenv "MES_PREFIX"))
(define %moduledir
(if (not %prefix) "module/"
(list->string
(append (string->list %prefix)
(string->list "/module") ; `module/' gets replaced upon install
(string->list "/")))))
(include (list->string
(append (string->list %moduledir) (string->list "/mes/type-0.mes"))))
(define (symbol->string s)
(apply string (symbol->list s)))
@ -117,8 +129,8 @@
(define (string-append . rest)
(apply string (apply append (map1 string->list rest))))
(define %moduledir "module/")
(define %version (if (eq? (car (string->list "@VERSION@")) #\@) "git" "@VERSION@"))
(define %version (if (eq? (car (string->list "@VERSION@")) #\@) "git"
"@VERSION@"))
(define (effective-version) %version)
(if (getenv "MES_DEBUG")

View file

@ -122,9 +122,6 @@
(define (string . lst)
(core:make-cell <cell:string> lst 0))
(define (string->list s)
(core:car s))
(define (string->symbol s)
(if (not (pair? (core:car s))) '()
(core:lookup-symbol (core:car s))))

View file

@ -1,12 +1,21 @@
#! /bin/sh
# -*-scheme-*-
MES=${MES-$(dirname $0)/mes}
moduledir=module/
echo '()' | cat $moduledir/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS -- "$@"
PREFIX=${PREFIX-@PREFIX@}
MES_PREFIX=${MES_PREFIX-$PREFIX}
if [ "$MES_PREFIX" = @PREFIX""@ ]
then
MES_PREFIX=$(cd $(dirname $0)/.. && pwd)
export MES_PREFIX
MES_MODULEDIR=${MES_MODULEDIR-$MES_PREFIX/"module"}
export MES_MODULEDIR
else
MES_MODULEDIR=${MES_MODULEDIR-$MES_PREFIX/share/mes/"module"}
export MES_MODULEDIR
fi
echo '()' | cat $MES_MODULEDIR/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS -- "$@"
#paredit:||
r=$?
([ -f a.out ] && chmod +x a.out)
exit $r
exit $?
!#
;;; Mes --- Maxwell Equations of Software
@ -49,7 +58,7 @@ exit $r
(format (current-error-port) "mescc.mes...\n")
(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
(define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "MES_PREFIX") "") "@PREFIX@"))
(define (parse-opts args)
(let* ((option-spec

View file

@ -1267,9 +1267,48 @@ SCM
load_env (SCM a) ///((internal))
{
r0 = a;
g_stdin = open ("module/mes/read-0.mes", O_RDONLY);
char *read0 = MODULEDIR "mes/read-0.mes";
g_stdin = g_stdin >= 0 ? g_stdin : open (read0, O_RDONLY);
g_stdin = -1;
if (getenv ("MES_PREFIX"))
{
char buf[128];
strcpy (buf, getenv ("MES_PREFIX"));
strcpy (buf + strlen (buf), "/module");
strcpy (buf + strlen (buf), "/mes/read-0.mes");
if (getenv ("MES_DEBUG"))
{
eputs ("MES_PREFIX reading read-0:");
eputs (buf);
eputs ("\n");
}
g_stdin = open (buf, O_RDONLY);
}
if (g_stdin < 0)
{
char *read0 = MODULEDIR "mes/read-0.mes";
if (getenv ("MES_DEBUG"))
{
eputs ("MODULEDIR reading read-0:");
eputs (read0);
eputs ("\n");
}
g_stdin = open (read0, O_RDONLY);
}
if (g_stdin < 0)
{
if (getenv ("MES_DEBUG"))
{
eputs (". reading read-0:");
eputs ("module/mes/read-0.mes");
eputs ("\n");
}
g_stdin = open ("module/mes/read-0.mes", O_RDONLY);
}
if (g_stdin < 0)
{
eputs ("boot failed, read-0.mes not found\n");
exit (1);
}
if (!g_function) r0 = mes_builtins (r0);
r2 = read_input_file_env (r0);
g_stdin = STDIN;