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:
parent
ccddde9a84
commit
a2f6511f5e
|
@ -45,7 +45,7 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/mescc.scm
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:export (main))
|
#: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)
|
(module-define! (resolve-module '(language c99 compiler)) '%prefix %prefix)
|
||||||
|
|
||||||
(define (parse-opts args)
|
(define (parse-opts args)
|
||||||
|
|
|
@ -109,7 +109,19 @@
|
||||||
(if (null? (cdr rest)) (car rest)
|
(if (null? (cdr rest)) (car rest)
|
||||||
(append2 (car rest) (apply append (cdr 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)
|
(define (symbol->string s)
|
||||||
(apply string (symbol->list s)))
|
(apply string (symbol->list s)))
|
||||||
|
@ -117,8 +129,8 @@
|
||||||
(define (string-append . rest)
|
(define (string-append . rest)
|
||||||
(apply string (apply append (map1 string->list rest))))
|
(apply string (apply append (map1 string->list rest))))
|
||||||
|
|
||||||
(define %moduledir "module/")
|
(define %version (if (eq? (car (string->list "@VERSION@")) #\@) "git"
|
||||||
(define %version (if (eq? (car (string->list "@VERSION@")) #\@) "git" "@VERSION@"))
|
"@VERSION@"))
|
||||||
(define (effective-version) %version)
|
(define (effective-version) %version)
|
||||||
|
|
||||||
(if (getenv "MES_DEBUG")
|
(if (getenv "MES_DEBUG")
|
||||||
|
|
|
@ -122,9 +122,6 @@
|
||||||
(define (string . lst)
|
(define (string . lst)
|
||||||
(core:make-cell <cell:string> lst 0))
|
(core:make-cell <cell:string> lst 0))
|
||||||
|
|
||||||
(define (string->list s)
|
|
||||||
(core:car s))
|
|
||||||
|
|
||||||
(define (string->symbol s)
|
(define (string->symbol s)
|
||||||
(if (not (pair? (core:car s))) '()
|
(if (not (pair? (core:car s))) '()
|
||||||
(core:lookup-symbol (core:car s))))
|
(core:lookup-symbol (core:car s))))
|
||||||
|
|
|
@ -1,12 +1,21 @@
|
||||||
#! /bin/sh
|
#! /bin/sh
|
||||||
# -*-scheme-*-
|
# -*-scheme-*-
|
||||||
MES=${MES-$(dirname $0)/mes}
|
MES=${MES-$(dirname $0)/mes}
|
||||||
moduledir=module/
|
PREFIX=${PREFIX-@PREFIX@}
|
||||||
echo '()' | cat $moduledir/mes/base-0.mes $0 /dev/stdin | $MES $MES_FLAGS -- "$@"
|
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:||
|
#paredit:||
|
||||||
r=$?
|
exit $?
|
||||||
([ -f a.out ] && chmod +x a.out)
|
|
||||||
exit $r
|
|
||||||
!#
|
!#
|
||||||
|
|
||||||
;;; Mes --- Maxwell Equations of Software
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
@ -49,7 +58,7 @@ exit $r
|
||||||
|
|
||||||
(format (current-error-port) "mescc.mes...\n")
|
(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)
|
(define (parse-opts args)
|
||||||
(let* ((option-spec
|
(let* ((option-spec
|
||||||
|
|
43
src/mes.c
43
src/mes.c
|
@ -1267,9 +1267,48 @@ SCM
|
||||||
load_env (SCM a) ///((internal))
|
load_env (SCM a) ///((internal))
|
||||||
{
|
{
|
||||||
r0 = a;
|
r0 = a;
|
||||||
g_stdin = open ("module/mes/read-0.mes", 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";
|
char *read0 = MODULEDIR "mes/read-0.mes";
|
||||||
g_stdin = g_stdin >= 0 ? g_stdin : open (read0, O_RDONLY);
|
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);
|
if (!g_function) r0 = mes_builtins (r0);
|
||||||
r2 = read_input_file_env (r0);
|
r2 = read_input_file_env (r0);
|
||||||
g_stdin = STDIN;
|
g_stdin = STDIN;
|
||||||
|
|
Loading…
Reference in a new issue