diff --git a/.gitignore b/.gitignore index cbf2a3d5..deae9fad 100644 --- 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 0f9a634e..df0fa531 100644 --- 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 503d3ce4..5ef86037 100644 --- 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 index 887b92d4..00000000 --- a/module/mes/mini-0.mes +++ /dev/null @@ -1,471 +0,0 @@ -;;; -*-scheme-*- - -;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017 Jan Nieuwenhuizen -;;; -;;; 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 . - -;;; 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 ) 5) (list)) (current-module)) - - ;; (core:display (quote cm:)) - ;; (core:display ) - ;; (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 ) 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) ))) - (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 (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 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 0) - - ;; (core:display ) - ;; (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 4) - (define 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 lst 0)) - - (define (integer->char x) - (make-cell 0 x)) - - (define (symbol->keyword s) - (make-cell (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 index 00000000..1efbbfd7 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 d8556cf9..91f36895 100644 --- 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;