mescc: Run full scheme reader read-0.mes.

* lib.c (load_env)[MINI_MES]: Load full reader, module/mes/read-0.mes.
* GNUmakefile (module/mes/read-0-32.mo): Update dependency.
* module/mes/mini-0.mes: Remove.
* doc/examples/t.c (struct_test):
* module/mes/read-0-32.mo: New file: bootstrap binary reader.

diff --git a/.gitignore b/.gitignore
index cbf2a3d5a714e6da6218ab913e4b8131e40af9d2..deae9fad475e6df584e5246bc14c856ff1b987b3 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -34,7 +34,6 @@
 /module/mes/tiny-0-32.mo
 #keep this: bootstrap
 #/module/mes/read-0-32.mo
-/module/mes/mini-0.mo
 /module/mes/read-0.mo
 /out
 ?

diff --git a/GNUmakefile b/GNUmakefile
index 0f9a634e5c25e8cd59f6f88f2b717ea7a338c9ba..df0fa53188f13fcd7ef1c3bf9dce85e61d09a593 100644 (file)
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -100,7 +100,7 @@ mes-32: mes.c lib.c
        guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib'
        mv mes mes-32
 
-module/mes/read-0-32.mo: module/mes/mini-0.mes mes-32
+module/mes/read-0-32.mo: module/mes/read-0.mes mes-32
        MES_MINI=1 ./mes-32 --dump < $< > $@
 
 module/mes/tiny-0-32.mo: module/mes/tiny-0.mes mes-32

diff --git a/lib.c b/lib.c
index 503d3ce4efda4e83c0480e70e9d5a194377c4ccc..5ef86037379a05bc7d6d7cfda2f48fdae7c1576f 100644 (file)
--- a/lib.c
+++ b/lib.c
@@ -205,13 +205,8 @@ SCM
 load_env (SCM a) ///((internal))
 {
   r0 = a;
-  if (getenv ("MES_MINI"))
-    g_stdin = fopen ("module/mes/mini-0.mes", "r");
-  else
-    {
-      g_stdin = fopen ("module/mes/read-0.mes", "r");
-      g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
-    }
+  g_stdin = fopen ("module/mes/read-0.mes", "r");
+  g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mes", "r");
   if (!g_function) r0 = mes_builtins (r0);
   r2 = read_input_file_env (r0);
   g_stdin = stdin;

diff --git a/module/mes/mini-0.mes b/module/mes/mini-0.mes
deleted file mode 100644 (file)
index 887b92d..0000000
--- a/module/mes/mini-0.mes
+++ /dev/null
@@ -1,471 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; bootstrap reader.  This file is read by a minimal core reader.  It
-;;; only supports s-exps and line-comments; quotes, character
-;;; literals, string literals cannot be used here.
-
-;;; Code:
-
-(begin
-
-  (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 10))
-
-  ((lambda (a+ a)
-
-     ;; (write-byte (make-cell 0 0 48))
-     ;; (write-byte (make-cell 0 0 48))
-     ;; (write-byte (make-cell 0 0 48))
-     ;; (write-byte (make-cell 0 0 10))
-
-     (set-cdr! a+ (cdr a))
-     (set-cdr! a a+)
-     (set-cdr! (assq (quote *closure*) a) a+)
-     (car a+))
-   (cons (cons (quote env:define) #f) (list))
-   (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 10))
-
-  (set! env:define
-        (lambda (a+ a)
-
-          ;; (write-byte (make-cell 0 0 48))
-          ;; (write-byte (make-cell 0 0 49))
-          ;; (write-byte (make-cell 0 0 48))
-          ;; (write-byte (make-cell 0 0 10))
-
-          (set-cdr! a+ (cdr a))
-          (set-cdr! a a+)
-          (set-cdr! (assq (quote *closure*) a) a+)
-          (car a+)))
-
-  (env:define (cons (cons (quote <cell:macro>) 5) (list)) (current-module))
-
-  ;; (core:display (quote cm:))
-  ;; (core:display <cell:macro>)
-  ;; (write-byte (make-cell 0 0 10))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 50)) (write-byte (make-cell 0 0 10))
-
-  (env:define (cons (cons (quote <cell:pair>) 7) (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 51)) (write-byte (make-cell 0 0 10))
-
-  (env:define (cons (cons (quote sexp:define) #f) (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 52)) (write-byte (make-cell 0 0 10))
-
-  (env:define (cons (cons (quote env:macro) #f) (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 53)) (write-byte (make-cell 0 0 10))
-
-  (env:define (cons (cons (quote cons*) #f) (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 54)) (write-byte (make-cell 0 0 10))
-
-  (env:define (cons (cons (quote not)
-                          (lambda (x) (if x #f #t)))
-                    (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 55)) (write-byte (make-cell 0 0 10))
-
-
-  (env:define (cons (cons (quote pair?)
-                          (lambda (x) (eq? (core:type x) <cell:pair>)))
-                    (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 56)) (write-byte (make-cell 0 0 10))
-
-
-  (env:define (cons (cons (quote atom?)
-                          (lambda (x) (not (pair? x))))
-                    (list)) (current-module))
-
-  ;; (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 57)) (write-byte (make-cell 0 0 10))
-
-
-  (set! sexp:define
-        (lambda (e a)
-
-          ;; (write-byte (make-cell 0 0 48))
-          ;; (write-byte (make-cell 0 0 57))
-          ;; (write-byte (make-cell 0 0 48))
-          ;; (write-byte (make-cell 0 0 10))
-
-          (if (atom? (cadr e)) (cons (cadr e) (core:eval (car (cddr e)) a))
-              (cons (car (cadr e)) (core:eval (cons (quote lambda) (cons (cdr (cadr e)) (cddr e))) a)))))
-
-  ;; (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 48)) (write-byte (make-cell 0 0 10))
-
-  (set! env:macro
-        (lambda (name+entry)
-
-          (write-byte (make-cell 0 0 49))
-          (write-byte (make-cell 0 0 48))
-          (write-byte (make-cell 0 0 48))
-          (write-byte (make-cell 0 0 10))
-
-
-          (cons
-           (cons (car name+entry)
-                 (make-cell <cell:macro> (core:car (car name+entry)) (cdr name+entry)))
-           (list))))
-
-  ;; (core:display (quote yyy-XXXmacro-m:))
-  ;; (write-byte (make-cell 0 0 10))
-
-  ;; (core:display (quote macro-m:))
-  ;; (core:display (make-cell <cell:macro> core:display 1))
-  ;; (write-byte (make-cell 0 0 10))
-
-  ;; (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 10))
-
-  (set! cons*
-        (lambda (. rest)
-
-          ;; (write-byte (make-cell 0 0 49))
-          ;; (write-byte (make-cell 0 0 49))
-          ;; (write-byte (make-cell 0 0 48))
-          ;; (write-byte (make-cell 0 0 10))
-
-          ;; (core:display (quote rest:))
-          ;; (core:display rest)
-          ;; (write-byte (make-cell 0 0 10))
-
-          (if (null? (cdr rest)) (car rest)
-              (cons (car rest) (core:apply cons* (cdr rest) (current-module))))))
-
-  (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 50)) (write-byte (make-cell 0 0 10))
-
-  (env:define
-   (env:macro
-    (sexp:define
-     (quote
-      (define-macro (define ARGS . BODY)
-
-        ;; (write-byte (make-cell 0 0 49))
-        ;; (write-byte (make-cell 0 0 50))
-        ;; (write-byte (make-cell 0 0 48))
-        ;; (write-byte (make-cell 0 0 10))
-
-        (cons* (quote env:define)
-               (cons* (quote cons)
-                      (cons* (quote sexp:define)
-                             (list (quote quote)
-                                   (cons (quote DEFINE) (cons ARGS BODY)))
-                             (quote ((current-module))))
-                      (quote ((list))))
-               (quote ((current-module))))))
-     (current-module))) (current-module))
-
-  (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 51)) (write-byte (make-cell 0 0 10))
-
-  (env:define
-   (env:macro
-    (sexp:define
-     (quote
-      (define-macro (define-macro ARGS . BODY)
-        (cons* (quote env:define)
-               (list (quote env:macro)
-                     (cons* (quote sexp:define)
-                            (list (quote quote)
-                                  (cons (quote DEFINE-MACRO) (cons ARGS BODY)))
-                            (quote ((current-module)))))
-               (quote ((current-module))))))
-     (current-module))) (current-module))
-
-  (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 52)) (write-byte (make-cell 0 0 10))
-  (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 52)) (write-byte (make-cell 0 0 10))
-
-  ;; (core:display (quote define:))
-  ;; (core:display define)
-  ;; (write-byte (make-cell 0 0 10))
-
-  (define <cell:character> 0)
-
-  ;; (core:display <cell:character>)
-  ;; (write-byte (make-cell 0 0 10))
-  ;; (write-byte (make-cell 0 0 49)) (write-byte (make-cell 0 0 53)) (write-byte (make-cell 0 0 10))
-
-  (define <cell:keyword> 4)
-  (define <cell:string> 10)
-
-  (define (newline . rest) (core:stderr (list->string (list (integer->char 10)))))
-  (define (display x . rest) (core:stderr x))
-
-  (define (list->symbol lst) (make-symbol lst))
-
-  (define (symbol->list s)
-    (core:car s))
-
-  (define (list->string lst)
-    (make-cell <cell:string> lst 0))
-
-  (define (integer->char x)
-    (make-cell <cell:character> 0 x))
-
-  (define (symbol->keyword s)
-    (make-cell <cell:keyword> (symbol->list s) 0))
-
-  (define (read)
-    (read-word (read-byte) (list) (current-module)))
-
-  (define (read-env a)
-    (read-word (read-byte) (list) a))
-
-  (define (read-input-file)
-    (define (helper x)
-      (if (null? x) x
-          (cons x (helper (read)))))
-    (helper (read)))
-
-  (define-macro (cond . clauses)
-    (list (quote if) (pair? clauses)
-          (list (quote if) (car (car clauses))
-                (if (pair? (cdar clauses))
-                    (if (eq? (car (cdar clauses)) (quote =>))
-                        (append2 (cdr (cdar clauses)) (list (caar clauses)))
-                        (list (cons (quote lambda) (cons (list) (car clauses)))))
-                    (list (cons (quote lambda) (cons (list) (car clauses)))))
-                (if (pair? (cdr clauses))
-                    (cons (quote cond) (cdr clauses))))))
-
-  (define (eat-whitespace c)
-    (cond
-     ((eq? c 32) (eat-whitespace (read-byte)))
-     ((eq? c 10) (eat-whitespace (read-byte)))
-     ((eq? c 9) (eat-whitespace (read-byte)))
-     ((eq? c 12) (eat-whitespace (read-byte)))
-     ((eq? c 13) (eat-whitespace (read-byte)))
-     ((eq? c 59) (begin (read-line-comment c)
-                        (eat-whitespace (read-byte))))
-     ((eq? c 35) (cond ((eq? (peek-byte) 33)
-                        (read-byte)
-                        (read-block-comment 33 (read-byte))
-                        (eat-whitespace (read-byte)))
-                       ((eq? (peek-byte) 59)
-                        (read-byte)
-                        (read-word (read-byte) (list) (list))
-                        (eat-whitespace (read-byte)))
-                       ((eq? (peek-byte) 124)
-                        (read-byte)
-                        (read-block-comment 124 (read-byte))
-                        (eat-whitespace (read-byte)))
-                       (#t (unread-byte 35))))
-     (#t (unread-byte c))))
-
-
-  (define (read-block-comment s c)
-    (if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
-                      (read-block-comment s (read-byte)))
-        (read-block-comment s (read-byte))))
-
-  (define (read-line-comment c)
-    (if (eq? c 10) c
-        (read-line-comment (read-byte))))
-
-  (define (read-list a)
-    (eat-whitespace (read-byte))
-    (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-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-macro (or . x)
-    (if (null? x) #f
-        (if (null? (cdr x)) (car x)
-            (list (quote if) (car x) (car x)
-                  (cons (quote or) (cdr x))))))
-  (define (not x)
-    (if x #f #t))
-  
-  (define (read-character)
-    (define (read-octal c p n)
-      (if (not (and (> p 47) (< p 56))) n
-          (read-octal (read-byte) (peek-byte) (+ (ash n 3) (- p 48)))))
-
-    (define (read-name c p n)
-      (define (lookup-char n)
-        (cond ((assq n (quote ((*foe* . -1)
-                               (lun . 0)
-                               (mrala . 7)
-                               (ecapskcab . 8)
-                               (bat . 9)
-                               (enilwen . 10)
-                               (batv . 11)
-                               (egap . 12)
-                               (nruter . 13)
-                               (ecaps . 32)))) => cdr)
-              (#t (error (quote char-not-supported) n))))
-      (if (not (or (eq? p 42) (and (> p 96) (< p 123)))) (integer->char (lookup-char (list->symbol (cons (integer->char c) n))))
-          (read-name (read-byte) (peek-byte) (cons (integer->char c) n))))
-
-    ((lambda (c p)
-       (cond ((and (> c 47) (< c 56) (> p 47) (< p 56))
-              (integer->char (read-octal c p (- c 48))))
-             ((and (or (= c 42) (and (> c 96) (< c 123)))
-                   (or (= p 42) (and (> p 96) (< p 123)))) (read-name c p (list)))
-             (#t (integer->char c))))
-     (read-byte) (peek-byte)))
-
-  (define (read-hex)
-    (define (calc c)
-      (cond ((and (> c 64) (< c 71)) (+ (- c 65) 10))
-            ((and (> c 96) (< c 103)) (+ (- c 97) 10))
-            ((and (> c 47) (< c 58)) (- c 48))
-            (#t 0)))
-    (define (read-hex c p n)
-      (if (not (or (and (> p 64) (< p 71))
-                   (and (> p 96) (< p 103))
-                   (and (> p 47) (< p 58)))) (+ (ash n 4) (calc c))
-                   (read-hex (read-byte) (peek-byte) (+ (ash n 4) (calc c)))))
-    ((lambda (c p)
-       (read-hex c p 0))
-     (read-byte) (peek-byte)))
-
-  (define (read-string)
-    (define (append-char s c)
-      (append2 s (cons (integer->char c) (list))))
-    (define (read-string c p s)
-      (cond
-       ((and (eq? c 92) (or (eq? p 92) (eq? p 34)))
-        ((lambda (c)
-           (read-string (read-byte) (peek-byte) (append-char s c)))
-         (read-byte)))
-       ((and (eq? c 92) (eq? p 110))
-        (read-byte)
-        (read-string (read-byte) (peek-byte) (append-char s 10)))
-       ((eq? c 34) s)
-       ((eq? c -1) (error (quote EOF-in-string)))
-       (#t (read-string (read-byte) (peek-byte) (append-char s c)))))
-    (list->string (read-string (read-byte) (peek-byte) (list))))
-
-  (define (map1 f lst)
-    (if (null? lst) (list)
-        (cons (f (car lst)) (map1 f (cdr lst)))))
-
-  (define (lookup w a)
-    (core:lookup (map1 integer->char w) a))
-
-  (define (read-hash c w a)
-    (cond
-     ((eq? c 33) (begin (read-block-comment 33 (read-byte))
-                        (read-word (read-byte) w a)))
-     ((eq? c 124) (begin (read-block-comment 124 (read-byte))
-                         (read-word (read-byte) w a)))
-     ((eq? c 40) (list->vector (read-list a)))
-     ((eq? c 92) (read-character))
-     ((eq? c 120) (read-hex))
-     ((eq? c 44) (cond ((eq? (peek-byte) 64)
-                        (read-byte)
-                        (cons (quote unsyntax-splicing)
-                              (cons (read-word (read-byte) w a) w)))
-                       (#t (cons (quote unsyntax)
-                                 (cons (read-word (read-byte) w a) w)))))
-     ((eq? c 39) (cons (quote syntax) (cons (read-word (read-byte) w a) w)))
-     ((eq? c 58) (symbol->keyword (read-word (read-byte) w a)))
-     ((eq? c 59) (begin (read-word (read-byte) w a)
-                        (read-word (read-byte) w a)))
-     ((eq? c 96) (cons (quote quasisyntax)
-                       (cons (read-word (read-byte) w a) w)))
-     (#t (read-word c (append2 w (cons 35 w)) a))))
-    
-  (define (read-word c w a)
-
-     (write-byte (make-cell 0 0 66))
-     (write-byte (make-cell 0 0 66))
-     (write-byte (make-cell 0 0 58))
-     (write-byte c)
-     (write-byte (make-cell 0 0 10))
-
-    (cond
-     ((or (and (> c 96) (< c 123))
-          (eq? c 45)
-          (eq? c 63)
-          (and (> c 47) (< c 58)))
-      (read-word (read-byte) (append2 w (cons c (list))) a))
-     ((eq? c 10) (if (null? w) (read-word (read-byte) (list) a) (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) (quote *FOOBAR*)
-                     (begin (unread-byte c) (lookup w a))))
-     ((eq? c 34) (if (null? w) (read-string)
-                     (begin (unread-byte c) (lookup w a))))
-     ((eq? c 32) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
-     ((eq? c 10) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
-     ((eq? c 35) (read-hash (read-byte) w a))
-     ((eq? c 39) (if (null? w) (cons (quote quote)
-                                     (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
-                           (quote unquote-splicing)
-                           (cons (read-word (read-byte) w a) (list)))))
-                  (#t (cons (quote unquote)
-                            (cons (read-word (read-byte) w a) (list))))))
-     ((eq? c 96) (cons (quote quasiquote) (cons (read-word (read-byte) w a) (list))))
-     ((eq? c 59) (read-line-comment c) (read-word 10 w a))
-     ((eq? c 9) (read-word 32 w a))
-     ((eq? c 12) (read-word 32 w a))
-     ((eq? c -1) (list))
-     (#t (read-word (read-byte) (append2 w (cons c (list))) a))))
-
-  (write-byte (make-cell 0 0 65))
-  (write-byte (make-cell 0 0 66))
-  (write-byte (make-cell 0 0 67))
-  (write-byte (make-cell 0 0 10))
-
-  (core:display (quote bla-bla))
-  (write-byte (make-cell 0 0 10))
-
-  ((lambda (p)
-     ;;(core:display (quote here-we-go))
-     (write-byte (make-cell 0 0 65))
-     (write-byte (make-cell 0 0 65))
-     (write-byte (make-cell 0 0 65))
-     (write-byte (make-cell 0 0 65))
-     (write-byte (make-cell 0 0 10))
-
-     (core:display (quote blub-blub))
-     (write-byte (make-cell 0 0 10))
-
-     (write-byte (make-cell 0 0 112))
-     (write-byte (make-cell 0 0 58))
-     ;;(core:display (quote p:))
-     (core:display p)
-     (write-byte (make-cell 0 0 10))
-     (core:eval (cons (quote begin) p) (current-module)))
-   (read-input-file))
-  
-  ;;(read-input-file)
-
-)

diff --git a/module/mes/read-0-32.mo b/module/mes/read-0-32.mo
new file mode 100644 (file)
index 0000000..1efbbfd
Binary files /dev/null and b/module/mes/read-0-32.mo differ

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index d8556cf9299cf8e9607f4b6daad060140d80afc6..91f3689551817fd91d0d83922f467e941a70cac4 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -37,10 +37,9 @@
 #define NYACC_CDR nyacc_cdr
 #endif
 
-// int ARENA_SIZE = 1200000;
-// char arena[1200000];
-int ARENA_SIZE = 2000000;
-char arena[2000000];
+
+int ARENA_SIZE = 4000000;
+char arena[4000000];
 
 typedef int SCM;