core: Tune debug printing.

* src/mes.c: Tune debug printing.
* src/gc.c: Likewise.
* module/mes/guile.mes: Likewise.
* HACKING: Describe it.

HACKING

@@ -2,7 +2,16 @@
 
 * SETUP
     guix environment -l guix.scm     #64 bit + 32bit
+
+or
+
     guix environment --system=i686-linux -l guix.scm #32 bit only
+
+or
+
+    guix package --profile=~/.config/guix/mes --manifest=build-aux/manifest.scm
+    . ~/.config/guix/mes/etc/profile
+
 * BUILD
 There are two major modes to build Mes: true bootstrap and
 development.
@@ -18,32 +27,48 @@ To help development we assume ./configure sets these variables for make
    M1     -- M1
    PREFIX -- ""
 
-Mes is supposed to serve as a full equivalent for Guile, however mes is much, much
+Mes is supposed to serve as a full equivalent for Guile, however Mes
-slower than guile.  That's why we usually don't use mes during development.
+~30 times slower than Guile.  That's why we usually don't use Mes
+during development.
 
-gcc is used to verify the sanity of our C sources.
+Gcc is used to verify the sanity of our C sources.
 
 i686-unknown-linux-gnu-gcc is used to compare hex/assembly, to test
-the gcc variant of mes libc: lib/libc-gcc.c and steal ideas.
+the gcc variant of Mes-libc: lib/libc-gcc.c and steal ideas.  Target
+prefix: mlibc-gcc.
 
-Guile is used to develop mescc, the C compiler in Scheme that during
+Guile is used to develop MesCC, the C compiler in Scheme that during
-bootstrapping will be executed by mes.
+bootstrapping will be executed by Mes.
-
-** BOOTSTRAP BUILD
-In bootstrap mode, we don't have gcc (CC), we don't have pa 32 bit gcc
-(CC32), we have no guile (GUILE)...but we should have hex2, M1, and
-FIXME: mes.M1.
 
 mes is built from src/*.c and some out/src/*.h files that are snarfed from
 src/*.c by build-aux/mes-snarf.scm.
 
 Running ./make.scm produces a `script' file.
 
+** BOOTSTRAP BUILD
+
+    ./build.sh
+
+In bootstrap mode, we don't have gcc (CC), we don't have a 32 bit gcc
+(CC32), we have no guile (GUILE)...but we should have hex2, M1, and
+mes.M1.  That's a bootstrap problem which is currently ignored by
+using the mes-seed package.  mes.M1 will be produced by M2-Planet from
+mes.c.
+
+
 * ROADMAP
 ** TODO 
 *** release 0.x, unsorted
   - mes+mescc: compile a mes-tcc that can compile gcc-4.7.
+  - mes: set base-0.scm as default MES_BOOT, drop cat base-0.mes silliness.
+  - mes: real module support, bonus for supporting Guile's define-module/define-public syntax.
   - mes: prepare src/mes.c for M2-Planet transpiler.
+  - mes: produce functional mes from mes.M1 transpiled by M2-Planet.
+  - mes: we're a full Scheme now, drop .MES prefix, use .SCM.
+    + find a way to fix foo.mes/foo.scm trickery (full Guile-like module support?)
+    + how about setting `guile' or even `guile-2' cond-expand features
+      for external libraries (Nyacc) we look like Guile/Guile-2
+      internally, we could make sure to start every cond-expand with (mes)
   - mes: use more efficient scheme continuation stack (wip-array?)
   - mes: drop SCM stack in C / implement call/cc a la guile-1.8 setjmp?
   - mescc: refactor type(/ptr?) system; expr->type and ast-type->type.
@@ -66,7 +91,6 @@ Running ./make.scm produces a `script' file.
   - mescc: some success with 8cc,pcc,guile/libguile/eval.c.
   - build: guile/guix/make.scm: add file-types, intermediate, hash all dependencies
   - build: make.scm: imperative->declaritive
-  - mes: real module support, bonus for supporting Guile's define-module/define-public syntax.
   - get full source syntax-case up (Andre van Tonder?) OR drop it.
     https://srfi.schemers.org/srfi-72/srfi-72.html
     psyntax/syntax-case and rewrite Nyacc without syntax-case+R7RS Ellipsis.
@@ -91,6 +115,26 @@ eenough to work on compiling tinycc's tcc.c albeit a somewhat modified version.
 *** 0.2: Support psyntax
 *** 0.1: Mes eval/apply feature complete; support syntax-rules, compile main.c using LALR, dump ELF
 
+
+* DEBUG
+  MES_DEBUG=<level> mes
+** Levels
+  1) Informational: 
+     - MODULEDIR
+     - included SCM modules and sources
+     - result of program
+     - gc stats at exit
+  2) opened files
+  3) runtime gc stats
+  4) detailed info
+     - parsed, expanded program
+     - list of builtins
+     - list of symbol
+     - opened input strings
+     - gc details
+  5) usage of opened input strings
+
+
 * Bugs
 ** mes: remove pmatch-car/pmatch-cdr hack.
 ** mes+mescc: parse tcc.c->tcc.E works, compile tcc.E -> tcc.M1 segfaults.

module/mes/guile.mes

@@ -48,7 +48,7 @@
         (if (eq? c #\*eof*) '()
             (cons c (read-string (read-char)))))
       (let ((string (list->string (read-string (read-char)))))
-        (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+        (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
             (core:display-error (string-append "drained: `" string "'\n")))
         string)))
 
@@ -68,7 +68,7 @@
   (define save-peek-char peek-char)
   (define save-read-char read-char)
   (define save-unread-char unread-char)
-  (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+  (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
       (core:display-error (string-append "with-input-from-string: `" string "'\n")))
   (let ((tell 0)
         (end (string-length string)))
@@ -118,19 +118,21 @@
 
 (define core:open-input-file open-input-file)
 (define (open-input-file file)
-  (let ((port (core:open-input-file file)))
+  (let ((port (core:open-input-file file))
-    (when (getenv "MES_DEBUG")
+        (debug (and=> (getenv "MES_DEBUG") string->number)))
-      (core:display-error (string-append "open-input-file: `" file "'\n"))
+    (when (and debug (> debug 1))
-      (core:display-error "port=")
+      (core:display-error (string-append "open-input-file: `" file "'"))
-      (core:display-error port)
+      (when (> debug 3)
-      (core:display-error "\n"))
+        (core:display-error " port=")
+        (core:display-error port)))
+    (core:display-error "\n")
     port))
 
 (define open-input-string
   (let ((save-set-current-input-port #f)
         (string-port #f))
     (lambda (string)
-      (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+      (if (and=> (getenv "MES_DEBUG") (compose (cut > <> 3) string->number))
           (core:display-error (string-append "open-input-string: `" string "'\n")))
       (set! save-set-current-input-port set-current-input-port)
       (set! string-port (cons '*string-port* (gensym)))
@@ -141,7 +143,7 @@
                   (tell 0)
                   (end (string-length string)))
               (lambda (port)
-                (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 2) string->number))
+                (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 5) string->number))
                     (core:display-error (string-append "open-input-string: `" string "' save-set-current-input-port port="))
                     (core:display-error port)
                     (core:display-error "\n"))
@@ -160,7 +162,7 @@
                             (lambda (c) (set! tell (1- tell)) c))
                       (set! set-current-input-port
                             (lambda (port)
-                              (when (getenv "MES_DEBUG")
+                              (when (and=> (getenv "MES_DEBUG") (compose (cut > <> 4) string->number))
                                 (core:display-error (string-append "open-input-string: `" string "' set-current-input-port port="))
                                 (core:display-error port)
                                 (core:display-error "\n"))

module/mes/module.mes

@@ -32,7 +32,7 @@
          'begin
          (list 'set! '*modules* (list cons (list string->symbol (module->file module)) '*modules*))
          (list 'load (list string-append '%moduledir (module->file module))))
-        (list 'if (getenv "MES_DEBUG")
+        (list 'if (and (getenv "MES_DEBUG") (list '> (list 'core:cdr (list 'car (list 'string->list (getenv "MES_DEBUG")))) 50))
               (list 'begin
                     (list core:display-error ";;; already loaded: ")
                     (list core:display-error (list 'quote module))
@@ -58,7 +58,5 @@
     (set-current-input-port (pop! *input-ports*))
     x))
 (define (mes-load-module-env module a)
-  (core:display-error "loading:") (core:write-error (string-append %moduledir (module->file module))) (core:display-error "\n")
+  (core:write-error (string-append %moduledir (module->file module))) (core:display-error "\n")
-  (primitive-load (string-append %moduledir (module->file module)))
+  (primitive-load (string-append %moduledir (module->file module))))
-  (core:display-error "dun\n")
-  )

scaffold/boot/51-module.scm

@@ -35,6 +35,12 @@
         (if (null? (cdr rest)) (car rest)
             (append2 (car rest) (apply append (cdr rest))))))
 
+  (define-macro (and . x)
+    (if (null? x) #t
+        (if (null? (cdr x)) (car x)
+            (list (quote if) (car x) (cons (quote and) (cdr x))
+                  #f))))
+
   (define (string->list s)
     (core:car s))
 

scaffold/boot/52-define-module.scm

@@ -34,6 +34,12 @@
         (if (null? (cdr rest)) (car rest)
             (append2 (car rest) (apply append (cdr rest))))))
 
+  (define-macro (and . x)
+    (if (null? x) #t
+        (if (null? (cdr x)) (car x)
+            (list (quote if) (car x) (cons (quote and) (cdr x))
+                  #f))))
+
   (define (string->list s)
     (core:car s))
 

scripts/mescc.mes

@@ -159,4 +159,4 @@ Usage: mescc.mes [OPTION]... FILE...
                                          (objects->elf objects))))))))))
 
 (main (command-line))
-()
+'done

src/gc.c

@@ -48,7 +48,7 @@ gc_flip () ///((internal))
   struct scm *cells = g_cells;
   g_cells = g_news;
   g_news = cells;
-  if (g_debug > 1)
+  if (g_debug > 2)
     {
       eputs (";;;   => jam[");
       eputs (itoa (g_free));
@@ -137,9 +137,9 @@ gc_check ()
 SCM
 gc ()
 {
-  if (g_debug == 1)
+  if (g_debug == 2)
     eputs (".");
-  if (g_debug > 1)
+  if (g_debug > 2)
     {
       eputs (";;; gc[");
       eputs (itoa (g_free));
@@ -156,7 +156,7 @@ gc ()
   g_symbols = gc_copy (g_symbols);
   g_macros = gc_copy (g_macros);
   SCM new = gc_copy (g_stack);
-  if (g_debug > 1)
+  if (g_debug > 3)
     {
       eputs ("new=");
       eputs (itoa (new));

src/mes.c

@@ -430,11 +430,13 @@ car_ (SCM x)
 SCM
 cdr_ (SCM x)
 {
-  return (TYPE (CDR (x)) == TPAIR
+  return (TYPE (x) != TCHAR
+          && TYPE (x) != TNUMBER
+          && (TYPE (CDR (x)) == TPAIR
               || TYPE (CDR (x)) == TREF
-          || TYPE (CAR (x)) == TSPECIAL
+              || TYPE (CDR (x)) == TSPECIAL
               || TYPE (CDR (x)) == TSYMBOL
-          || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+              || TYPE (CDR (x)) == TSTRING)) ? CDR (x) : MAKE_NUMBER (CDR (x));
 }
 
 SCM
@@ -573,7 +575,7 @@ check_formals (SCM f, SCM formals, SCM args) ///((internal))
       eputs (", got: ");
       eputs (itoa (alen));
       eputs ("\n");
-      display_error_ (f);
+      write_error_ (f);
       SCM e = MAKE_STRING (cstring_to_list (s));
       return error (cell_symbol_wrong_number_of_args, cons (e, f));
     }
@@ -1574,15 +1576,10 @@ mes_symbols () ///((internal))
   a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
   a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
 
-  a = acons (cell_symbol_dot, cell_dot, a);
-
-  a = acons (cell_symbol_begin, cell_begin, a);
-  a = acons (cell_symbol_quasisyntax, cell_symbol_quasisyntax, a);
-
   a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
   a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
-  a = acons (cell_symbol_sc_expand, cell_f, a);
+
 
 #if __GNUC__
   a = acons (cell_symbol_gnuc, cell_t, a);
@@ -1644,7 +1641,7 @@ mes_builtins (SCM a) ///((internal))
 #include "vector.environment.i"
 #endif
 
-  if (g_debug > 1)
+  if (g_debug > 3)
     {
       fputs ("functions: ", STDERR);
       fputs (itoa (g_function), STDERR);
@@ -1789,7 +1786,7 @@ bload_env (SCM a) ///((internal))
   set_env_x (cell_symbol_mesc, cell_t, r0);
 #endif
 
-  if (g_debug > 1)
+  if (g_debug > 3)
     {
       eputs ("symbols: ");
       SCM s = g_symbols;
@@ -1828,7 +1825,8 @@ main (int argc, char *argv[])
   if (g_debug)
     {
       eputs (";;; MODULEDIR=");
-      eputs (MODULEDIR);eputs ("\n");
+      eputs (MODULEDIR);
+      eputs ("\n");
     }
   if (p = getenv ("MES_MAX_ARENA"))
     MAX_ARENA_SIZE = atoi (p);
@@ -1857,21 +1855,39 @@ main (int argc, char *argv[])
   r0 = acons (cell_symbol_argv, lst, r0); // FIXME
   r0 = acons (cell_symbol_argv, lst, r0);
   push_cc (r2, cell_unspecified, r0, cell_unspecified);
-  if (g_debug > 1)
+
+  if (g_debug > 2)
+    {
+      eputs ("\ngc stats: [");
+      eputs (itoa (g_free));
+      eputs ("]\n");
+    }
+  if (g_debug > 3)
     {
       eputs ("program: ");
       write_error_ (r1);
       eputs ("\n");
     }
+  if (g_debug > 3)
+    {
+      eputs ("symbols: ");
+      write_error_ (g_symbols);
+      eputs ("\n");
+    }
   r3 = cell_vm_begin_expand;
   r1 = eval_apply ();
-  write_error_ (r1);
-  eputs ("\n");
   if (g_debug)
     {
-      gc (g_stack);
+      write_error_ (r1);
+      eputs ("\n");
+    }
+  if (g_debug)
+    {
       eputs ("\ngc stats: [");
       eputs (itoa (g_free));
+      gc (g_stack);
+      eputs (" => ");
+      eputs (itoa (g_free));
       eputs ("]\n");
     }
   return 0;