mescc: Allow invoking git mescc.mes from elsewhere.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 9 Dec 2017 21:38:51 +0000 (22:38 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 9 Dec 2017 21:38:51 +0000 (22:38 +0100)
* 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.

guile/mescc.scm
module/mes/base-0.mes
module/mes/type-0.mes
scripts/mescc.mes
src/mes.c

index 55447215c20e49c8257ffe9b67a20171abd9917f..770e8244b9135804d118958ef7344c9506f0075f 100755 (executable)
@@ -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)
index f575d32a85c5e094f845df759103f632727feb73..0334cc2871e8f963065b3251732c8c1bec45787f 100644 (file)
       (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)))
 (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")
index c82c946835443be4b6024f221e7cd04fdfdc69e1..122fc26179e9973e0ae5610c5ef8b0c6aa404152 100644 (file)
 (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))))
index 677ea56d5cbdc859cbe2f72429b62a5906f5146e..8e908838de146c9f7f087387ac7b85539070deed 100755 (executable)
@@ -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
index d410153a7ae9b556faf6fdf64191883b33025b06..8b2201e42d3a1eefa3c3d4b1233a75f88e415050 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -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;