artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2017-03-22 06:59:50 +01:00
parent 98f64ae516
commit 9a02352a15
6 changed files with 6 additions and 484 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.gitignore vendored
View file

@ -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
?

2
GNUmakefile
View file

@ -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

9
lib.c
View file

@ -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;

471
module/mes/mini-0.mes
View file

@ -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)
)

BIN
module/mes/read-0-32.mo Normal file
View file

Binary file not shown.

7
scaffold/mini-mes.c
View file

@ -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;