From 1614d1343940a67dc56d69bcc0d2a37cc5b4b813 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 19 Nov 2016 23:25:24 +0100 Subject: [PATCH] Add reader in Scheme. * module/mes/read-0.mes: New file. * mes.c (char_to_integer, integer_to_char, null_p): Move to core. (peek_byte, read_byte, unread_byte): New function. (main): --dump, --load: New option. * lib.c (char_to_integer, integer_to_char): Remove. * NEWS: Update. --- .gitignore | 1 + GNUmakefile | 10 ++ NEWS | 2 +- lib.c | 14 -- mes.c | 391 ++++++++++++++++++++++-------------------- module/mes/base-0.mes | 1 + module/mes/read-0.mes | 145 ++++++++++++++++ quasiquote.c | 12 +- scripts/elf.mes | 2 +- scripts/mescc.mes | 2 +- scripts/paren.mes | 2 +- scripts/repl.mes | 2 +- tests/base.test | 7 +- tests/closure.test | 2 +- tests/cwv.test | 9 +- tests/let-syntax.test | 2 +- tests/let.test | 2 +- tests/match.test | 2 +- tests/psyntax.test | 2 +- tests/quasiquote.test | 2 +- tests/read.test | 45 +++++ tests/record.test | 2 +- tests/scm.test | 2 +- tests/vector.test | 2 +- type.c | 5 - 25 files changed, 438 insertions(+), 230 deletions(-) create mode 100644 module/mes/read-0.mes create mode 100755 tests/read.test diff --git a/.gitignore b/.gitignore index 505f3185..6f98ac5e 100644 --- a/.gitignore +++ b/.gitignore @@ -13,6 +13,7 @@ /ChangeLog /a.out /mes +/read-0.mo /out ? ?.mes diff --git a/GNUmakefile b/GNUmakefile index c67750e4..1e9b57b5 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -44,6 +44,7 @@ distclean: clean check: all guile-check mes-check TESTS:=\ + tests/read.test\ tests/base.test\ tests/closure.test\ tests/quasiquote.test\ @@ -60,10 +61,16 @@ TESTS:=\ BASE-0:=module/mes/base-0.mes MES-0:=guile/mes-0.scm MES:=./mes +# use module/mes/read-0.mes rather than C-core reader +MES_FLAGS:=--load +export MES_FLAGS mes-check: all set -e; for i in $(TESTS); do ./$$i; done +dump: all + ./mes --dump < module/mes/read-0.mes > read-0.mo + guile-check: set -e; for i in $(TESTS); do\ guile -s <(cat $(MES-0) module/mes/test.mes $$i);\ @@ -85,6 +92,9 @@ guile-mescc: mescc.cat chmod +x a.out ./a.out +paren: all + scripts/paren.mes + help: help-top install: all diff --git a/NEWS b/NEWS index d75de6ad..c9c3efdd 100644 --- a/NEWS +++ b/NEWS @@ -16,7 +16,7 @@ Please send Mes bug reports to janneke@gnu.org. *** Garbage collector aka Jam scraper. A variant on SICP's stop and copy Garbage Colletor (Jam Scraper?) algorithm has been implemented. - +*** The reader has been moved to Scheme. * Changes in 0.2 since 0.1 ** Core *** Names of symbols and strings are list of characters [WAS: c-string]. diff --git a/lib.c b/lib.c index da6fd34a..6c47045b 100644 --- a/lib.c +++ b/lib.c @@ -79,20 +79,6 @@ vector_to_list (SCM v) return x; } -SCM -integer_to_char (SCM x) -{ - assert (TYPE (x) == NUMBER); - return make_char (VALUE (x)); -} - -SCM -char_to_integer (SCM x) -{ - assert (TYPE (x) == CHAR); - return make_number (VALUE (x)); -} - SCM builtin_exit (SCM x) { diff --git a/mes.c b/mes.c index 8fd34297..f8d83485 100644 --- a/mes.c +++ b/mes.c @@ -36,23 +36,13 @@ #define MES_MINI 0 // 1 for gc-2a.test, gc-3.test #if MES_FULL -int ARENA_SIZE = 400000000; // need this much for scripts/mescc.mes -//int ARENA_SIZE = 300000000; // need this much for tests/match.scm -//int ARENA_SIZE = 30000000; // need this much for tests/record.scm -//int ARENA_SIZE = 500000; // enough for tests/scm.test -//int ARENA_SIZE = 60000; // enough for tests/base.test +int ARENA_SIZE = 200000000; int GC_SAFETY = 10000; int GC_FREE = 20000; #else -//int ARENA_SIZE = 500; // MINI -int ARENA_SIZE = 4000; // MES_MINI, gc-3.test -//int ARENA_SIZE = 10000; // gc-2a.test -//int ARENA_SIZE = 18000; // gc-2.test -->KRAK -//int ARENA_SIZE = 23000; // gc-2.test OK -// int GC_SAFETY = 1000; -// int GC_FREE = 1000; -int GC_SAFETY = 10; -int GC_FREE = 10; +int ARENA_SIZE = 15000; +int GC_SAFETY = 1000; +int GC_FREE = 100; #endif typedef long SCM; @@ -154,6 +144,9 @@ scm scm_symbol_call_with_values = {SYMBOL, "call-with-values"}; scm scm_symbol_current_module = {SYMBOL, "current-module"}; scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"}; +scm scm_symbol_the_unquoters = {SYMBOL, "*the-unquoters*"}; + +scm char_eof = {CHAR, .name="*eof*", .value=-1}; scm char_nul = {CHAR, .name="nul", .value=0}; scm char_backspace = {CHAR, .name="backspace", .value=8}; scm char_tab = {CHAR, .name="tab", .value=9}; @@ -669,11 +662,6 @@ vm_apply_env () SCM body = cddr (r1); SCM p = pairlis (args, r2, r0); return call_lambda (body, p, p, r0); - // r2 = p; - // cache_invalidate_range (r2, g_cells[r0].cdr); - // SCM r = begin_env (cddr (r1), cons (cons (cell_closure, p), p)); - // cache_invalidate_range (r2, g_cells[r0].cdr); - // return r; } else if (car (r1) == cell_closure) { SCM args = caddr (r1); @@ -682,12 +670,6 @@ vm_apply_env () aa = cdr (aa); SCM p = pairlis (args, r2, aa); return call_lambda (body, p, aa, r0); - // r2 = p; - // r3 = aa; - // cache_invalidate_range (r2, g_cells[r3].cdr); - // SCM r = begin_env (body, cons (cons (cell_closure, p), p)); - // cache_invalidate_range (r2, g_cells[r3].cdr); - // return r; } #if BOOT else if (car (r1) == cell_symbol_label) @@ -742,7 +724,7 @@ vm_eval_env () if (car (r1) == cell_symbol_define_macro) return define_env (r1, r0); if (car (r1) == cell_symbol_primitive_load) - return load_env (r0); + return begin_env (read_input_file_env (r0), r0); #else if (car (r1) == cell_symbol_define) { fprintf (stderr, "C DEFINE: "); @@ -878,9 +860,6 @@ SCM make_function (SCM name, SCM id, SCM arity) { g_cells[tmp_num3].value = FUNCTION; - // function fun_read_byte = {.function0=&read_byte, .arity=0}; - // scm scm_read_byte = {FUNCTION, .name="read-int", .function=&fun_read_byte}; - // SCM cell_read_byte = 93; function *f = (function*)malloc (sizeof (function)); f->arity = VALUE (arity); g_cells[tmp_num4].value = (long)f; @@ -926,6 +905,13 @@ cstring_to_list (char const* s) return p; } +/// read: from type.c +SCM +null_p (SCM x) +{ + return x == cell_nil ? cell_t : cell_f; +} + SCM list_of_char_equal_p (SCM a, SCM b) { @@ -1035,6 +1021,20 @@ vector_set_x (SCM x, SCM i, SCM e) return cell_unspecified; } +SCM +list_to_vector (SCM x) +{ + VALUE (tmp_num) = VALUE (length (x)); + SCM v = make_vector (tmp_num); + SCM p = VECTOR (v); + while (x != cell_nil) + { + g_cells[p++] = g_cells[vector_entry (car (x))]; + x = cdr (x); + } + return v; +} + SCM lookup (SCM s, SCM a) { @@ -1085,20 +1085,6 @@ lookup_char (int c, SCM a) return lookup (cons (make_char (c), cell_nil), a); } -SCM -list_to_vector (SCM x) -{ - g_cells[tmp_num].value = VALUE (length (x)); - SCM v = make_vector (tmp_num); - SCM p = VECTOR (v); - while (x != cell_nil) - { - g_cells[p++] = g_cells[vector_entry (car (x))]; - x = cdr (x); - } - return v; -} - SCM force_output (SCM p) ///((arity . n)) { @@ -1254,6 +1240,24 @@ peekchar () return c; } +SCM +peek_byte () +{ + return make_number (peekchar ()); +} + +SCM +read_byte () +{ + return make_number (getchar ()); +} + +SCM +unread_byte (SCM i) +{ + return ungetchar (VALUE (i)); +} + SCM peek_char () { @@ -1266,6 +1270,12 @@ read_char () return make_char (getchar ()); } +SCM +unread_char (SCM c) +{ + return ungetchar (VALUE (c)); +} + SCM write_char (SCM x) ///((arity . n)) { @@ -1294,6 +1304,20 @@ symbol_to_list (SCM x) return STRING (x); } +SCM +char_to_integer (SCM x) +{ + assert (TYPE (x) == CHAR); + return make_number (VALUE (x)); +} + +SCM +integer_to_char (SCM x) +{ + assert (TYPE (x) == NUMBER); + return make_char (VALUE (x)); +} + int readcomment (int c) { @@ -1316,7 +1340,7 @@ readword (int c, SCM w, SCM a) if (c == '\n' && VALUE (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot; if (c == EOF || c == '\n') return lookup (w, a); if (c == ' ') return readword ('\n', w, a); - if (c == '"' && w == cell_nil) return readstring (); + if (c == '"' && w == cell_nil) return read_string (); if (c == '"') {ungetchar (c); return lookup (w, a);} if (c == '(' && w == cell_nil) return readlist (a); if (c == '(') {ungetchar (c); return lookup (w, a);} @@ -1346,29 +1370,10 @@ readword (int c, SCM w, SCM a) if (c == '#' && peekchar () == 'x') {getchar (); return read_hex ();} if (c == '#' && peekchar () == '\\') {getchar (); return read_character ();} if (c == '#' && w == cell_nil && peekchar () == '(') {getchar (); return list_to_vector (readlist (a));} - if (c == '#' && peekchar () == '(') {ungetchar (c); return lookup (w, a);} if (c == '#' && peekchar () == '!') {getchar (); readblock (getchar ()); return readword (getchar (), w, a);} return readword (getchar (), append2 (w, cons (make_char (c), cell_nil)), a); } -SCM -read_hex () -{ - int n = 0; - int c = peekchar (); - while ((c >= '0' && c <= '9') - || (c >= 'A' && c <= 'F') - || (c >= 'a' && c <= 'f')) { - n <<= 4; - if (c >= 'a') n += c - 'a' + 10; - else if (c >= 'A') n += c - 'A' + 10; - else n+= c - '0'; - getchar (); - c = peekchar (); - } - return make_number (n); -} - SCM read_character () { @@ -1406,6 +1411,24 @@ read_character () return make_char (c); } +SCM +read_hex () +{ + int n = 0; + int c = peekchar (); + while ((c >= '0' && c <= '9') + || (c >= 'A' && c <= 'F') + || (c >= 'a' && c <= 'f')) { + n <<= 4; + if (c >= 'a') n += c - 'a' + 10; + else if (c >= 'A') n += c - 'A' + 10; + else n+= c - '0'; + getchar (); + c = peekchar (); + } + return make_number (n); +} + SCM append_char (SCM x, int i) { @@ -1413,7 +1436,7 @@ append_char (SCM x, int i) } SCM -readstring () +read_string () { SCM p = cell_nil; int c = getchar (); @@ -1467,110 +1490,72 @@ add_environment (SCM a, char const *name, SCM x) return acons (make_symbol (cstring_to_list (name)), x, a); } -SCM -mes_environment () ///((internal)) +void +print_f (scm *f) +{ + fprintf (stderr, " g_function=%d; //%s\n", f->function, f->name); +} + +SCM +mes_symbols () ///((internal)) { - // setup GC g_cells = (scm *)malloc (ARENA_SIZE*sizeof(scm)); g_cells[0].type = VECTOR; - g_cells[0].length = ARENA_SIZE - 1; - g_cells[0].length = 10; + g_cells[0].length = 1000; g_cells[0].vector = 0; g_cells++; - // a = add_environment (a, "%free", &g_free); hihi, gets <3 moved - // a = add_environment (a, "%the-cells", g_cells); - // a = add_environment (a, "%new-cells", g_news); - -//#include "mes.symbols.i" g_cells[0].type = CHAR; g_cells[0].value = 'c'; g_free.value = 1; // 0 is tricky -#if !MES_MINI #include "mes.symbols.i" -#else // MES_MINI - cell_nil = g_free.value++; - g_cells[cell_nil] = scm_nil; - cell_f = g_free.value++; - g_cells[cell_f] = scm_f; - cell_t = g_free.value++; - g_cells[cell_t] = scm_t; - cell_undefined = g_free.value++; - g_cells[cell_undefined] = scm_undefined; - cell_unspecified = g_free.value++; - g_cells[cell_unspecified] = scm_unspecified; - cell_closure = g_free.value++; - g_cells[cell_closure] = scm_closure; - cell_begin = g_free.value++; - g_cells[cell_begin] = scm_begin; - cell_symbol_begin = g_free.value++; - g_cells[cell_symbol_begin] = scm_symbol_begin; - - cell_symbol_sc_expander_alist = g_free.value++; - g_cells[cell_symbol_sc_expander_alist] = scm_symbol_sc_expander_alist; - cell_symbol_sc_expand = g_free.value++; - g_cells[cell_symbol_sc_expand] = scm_symbol_sc_expand; - - // cell_dot = g_free.value++; - // g_cells[cell_dot] = scm_dot; - // cell_circular = g_free.value++; - // g_cells[cell_circular] = scm_circular; - // cell_symbol_lambda = g_free.value++; - // g_cells[cell_symbol_lambda] = scm_symbol_lambda; - // cell_symbol_if = g_free.value++; - // g_cells[cell_symbol_if] = scm_symbol_if; - // cell_symbol_define = g_free.value++; - // g_cells[cell_symbol_define] = scm_symbol_define; - // cell_symbol_define_macro = g_free.value++; - // g_cells[cell_symbol_define_macro] = scm_symbol_define_macro; - -#endif // MES_MINI - SCM symbol_max = g_free.value; -#if MES_FULL -#include "define.i" -#include "lib.i" -#include "math.i" -#include "mes.i" -#include "posix.i" -#include "quasiquote.i" -#include "string.i" -#include "type.i" -#else - - cell_cons = g_free.value++; - cell_display = g_free.value++; - cell_eq_p = g_free.value++; - cell_newline = g_free.value++; - - g_cells[cell_cons] = scm_cons; - g_cells[cell_display] = scm_display; - g_cells[cell_eq_p] = scm_eq_p; - g_cells[cell_newline] = scm_newline; - - cell_make_vector = g_free.value++; - g_cells[cell_make_vector] = scm_make_vector; - -#endif - tmp = g_free.value++; tmp_num = g_free.value++; g_cells[tmp_num].type = NUMBER; tmp_num2 = g_free.value++; g_cells[tmp_num2].type = NUMBER; + tmp_num3 = g_free.value++; + g_cells[tmp_num3].type = NUMBER; + tmp_num4 = g_free.value++; + g_cells[tmp_num4].type = NUMBER; g_start = g_free.value; symbols = 0; for (int i=1; i> 8, stdout); + fputc (stack % 256, stdout); + for (int i=0; i 1 && !strcmp (argv[1], "--dump")) g_dump_p = true; if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("Usage: mes < FILE\n"); if (argc > 1 && !strcmp (argv[1], "--version")) return puts ("Mes 0.2\n"); g_stdin = stdin; SCM a = mes_environment (); - display_ (stderr, load_env (a)); + if (argc > 1 && !strcmp (argv[1], "--load")) + display_ (stderr, bload_env (a)); + else + display_ (stderr, load_env (a)); fputs ("", stderr); + gc (stack); fprintf (stderr, "\nstats: [%d]\n", g_free.value); return 0; } diff --git a/module/mes/base-0.mes b/module/mes/base-0.mes index f589c3cb..8bba7ff9 100644 --- a/module/mes/base-0.mes +++ b/module/mes/base-0.mes @@ -26,6 +26,7 @@ ;;; Code: +#f ;; FIXME -- needed for --dump, then --load (define (primitive-eval e) (eval-env e (current-module))) (define eval eval-env) (define (expand-macro e) (expand-macro-env e (current-module))) diff --git a/module/mes/read-0.mes b/module/mes/read-0.mes new file mode 100644 index 00000000..1a7d76a1 --- /dev/null +++ b/module/mes/read-0.mes @@ -0,0 +1,145 @@ +;;; -*-scheme-*- + +;;; Mes --- Maxwell Equations of Software +;;; Copyright © 2016 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: + +;;; read-0.mes - bootstrap reader from Scheme. Use +;;; ./mes --dump < module/mes/read-0.mes > read-0.mo +;;; to read, garbage collect, and dump this reader; then +;;; ./mes --load < tests/gc-3.test +;;; to use this reader to read and run the minimal gc-3.test +;;; TODO: complete this reader, remove reader from C. + +;;; Code: + +(begin + + ;; (define car (make-function 'car 0)) + ;; (define cdr (make-function 'cdr 1)) + ;; (define cons (make-function 'cons 1)) + + ;; TODO: + ;; * use case/cond, expand + ;; * etc int/char? + ;; * lookup in Scheme + ;; * read characters, quote, strings + + (define (read) + (read-word (read-byte) '() (current-module))) + + (define (read-input-file) + (define (helper x) + (if (null? x) x + (cons x (helper (read))))) + (helper (read))) + + (define-macro (cond . clauses) + (list 'if (null? clauses) *unspecified* + (if (null? (cdr clauses)) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses)))))) + *unspecified*) + (if (eq? (car (cadr clauses)) 'else) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (car clauses)))) + (list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses))))))) + (list 'if (car (car clauses)) + (list (cons 'lambda (cons '() (car clauses)))) + (cons 'cond (cdr clauses))))))) + + (define (eat-whitespace) + (cond + ((eq? (peek-byte) 9) (read-byte) (eat-whitespace)) + ((eq? (peek-byte) 10) (read-byte) (eat-whitespace)) + ((eq? (peek-byte) 13) (read-byte) (eat-whitespace)) + ((eq? (peek-byte) 32) (read-byte) (eat-whitespace)) + ((eq? (peek-byte) 59) (begin (read-line-comment (read-byte)) + (eat-whitespace))) + ((eq? (peek-byte) 35) (begin (read-byte) + (if (eq? (peek-byte) 33) (begin (read-byte) + (read-block-comment (read-byte)) + (eat-whitespace)) + (unread-byte 35)))))) + + (define (read-block-comment c) + (if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte) + (read-block-comment (read-byte))) + (read-block-comment (read-byte)))) + + ;; (define (read-hex c) + ;; (if (eq? c 10) c + ;; (read-line-comment (read-byte)))) + + (define (read-line-comment c) + (if (eq? c 10) c + (read-line-comment (read-byte)))) + + (define (read-list a) + (eat-whitespace) + (if (eq? (peek-byte) 41) (begin (read-byte) '()) + ((lambda (w) + (if (eq? w '.) (car (read-list a)) + (cons w (read-list a)))) + (read-word (read-byte) '() a)))) + + ;;(define (read-string)) + + (define (lookup-char c a) + (lookup (cons (integer->char c) '()) a)) + + (define (read-word c w a) + (cond + ((eq? c -1) '()) + ((eq? c 10) (if (null? w) (read-word (read-byte) '() a) + (lookup w a))) + ((eq? c 32) (read-word 10 w a)) + ((eq? c 34) (if (null? w) (read-string) + (begin (unread-byte c) (lookup w a)))) + ((eq? c 35) (cond + ((eq? (peek-byte) 33) (begin (read-byte) + (read-block-comment (read-byte)) + (read-word (read-byte) w a))) + ((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a))) + ((eq? (peek-byte) 92) (read-byte) (read-character)) + ((eq? (peek-byte) 120) (read-byte) (read-hex)) + (else (read-word (read-byte) (append w (cons (integer->char c) '())) a)))) + ((eq? c 39) (if (null? w) (cons (lookup (cons (integer->char c) '()) a) + (cons (read-word (read-byte) w a) '())) + (begin (unread-byte c)) (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) (cons (lookup (cons (integer->char c) '()) a) + (cons (read-word (read-byte) w a) '())) + (begin (unread-byte c) (lookup w a)))) + ((eq? c 44) (cond + ((eq? (peek-byte) 64) (begin (read-byte) + (cons + (lookup (symbol->list 'unquote-splicing) a) + (cons (read-word (read-byte) w a) '())))) + (else (cons (lookup-char c a) (cons (read-word (read-byte) w a) + '()))))) + ((eq? c 96) (cons (lookup-char c a) (cons (read-word (read-byte) w a) '()))) + ((eq? c 59) (read-line-comment c) (read-word 10 w a)) + (else (read-word (read-byte) (append w (cons (integer->char c) '())) a)))) + + ((lambda (p) + ;;(display 'program=) (display p) (newline) + (begin-env p (current-module))) + (read-input-file))) diff --git a/quasiquote.c b/quasiquote.c index 00eb72d8..6230f087 100644 --- a/quasiquote.c +++ b/quasiquote.c @@ -19,8 +19,6 @@ */ #if QUASIQUOTE -SCM add_environment (SCM a, char const *name, SCM x); - SCM unquote (SCM x) ///((no-environment)) { @@ -56,17 +54,11 @@ vm_eval_quasiquote () return cons (r2, eval_quasiquote (cdr (r1), r0)); } -SCM -the_unquoters = 0; - SCM add_unquoters (SCM a) { - if (the_unquoters == 0) - the_unquoters = cons (cons (cell_symbol_unquote, cell_unquote), - cons (cons (cell_symbol_unquote_splicing, cell_unquote_splicing), - cell_nil)); - return append2 (the_unquoters, a); + SCM q = assq_ref_cache (cell_symbol_the_unquoters, a); + return append2 (q, a); } #else // !QUASIQUOTE diff --git a/scripts/elf.mes b/scripts/elf.mes index 9d7a3233..f021a8e4 100755 --- a/scripts/elf.mes +++ b/scripts/elf.mes @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes "$@" > a.out +cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" > a.out #paredit:| chmod +x a.out exit $? diff --git a/scripts/mescc.mes b/scripts/mescc.mes index 4fc2c205..fe74f808 100755 --- a/scripts/mescc.mes +++ b/scripts/mescc.mes @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -cat ${1-$(dirname $(dirname $0))/share/doc/mes/examples/main.c} | cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes "$@" > a.out +cat ${1-$(dirname $(dirname $0))/share/doc/mes/examples/main.c} | cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" > a.out chmod +x a.out exit $? !# diff --git a/scripts/paren.mes b/scripts/paren.mes index 41c8d136..ce3bc70c 100755 --- a/scripts/paren.mes +++ b/scripts/paren.mes @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo -e 'EOF\n___P((()))' | cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes "$@" +echo -e 'EOF\n___P((()))' | cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" chmod +x a.out exit $? !# diff --git a/scripts/repl.mes b/scripts/repl.mes index 38ce8467..d2e6317c 100755 --- a/scripts/repl.mes +++ b/scripts/repl.mes @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes "$@" +cat $($(dirname $0)/include.mes $0) $0 /dev/stdin | $(dirname $0)/mes $MES_FLAGS "$@" #paredit:| exit $? !# diff --git a/tests/base.test b/tests/base.test index 4cf14190..fffcb778 100755 --- a/tests/base.test +++ b/tests/base.test @@ -1,7 +1,6 @@ #! /bin/sh # -*-scheme-*- -set -x -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# @@ -76,7 +75,7 @@ exit $? (define local-answer 41)) (pass-if-equal "begin 2" 41 (begin local-answer)) -(if (not guile?) - (pass-if-equal "load" 42 (begin (load "tests/data/load.scm") the-answer))) +;; (if (not guile?) +;; (pass-if-equal "load" 42 (begin (load "tests/data/load.scm") the-answer))) (result 'report) diff --git a/tests/closure.test b/tests/closure.test index 59baf5ff..f2dcadb3 100755 --- a/tests/closure.test +++ b/tests/closure.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/cwv.test b/tests/cwv.test index 113645e6..0fc38025 100755 --- a/tests/cwv.test +++ b/tests/cwv.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# @@ -43,6 +43,13 @@ exit $? (lambda (a b c) (+ a b c))) 6)) +(pass-if-equal "lambda" + '(1 2 3 4 5) + ((lambda (x) + (x 1 2 3 4 5)) + (lambda (one two three four five) + (list one two three four five)))) + (pass-if-equal "values 5" '(1 2 3 4 5) (call-with-values diff --git a/tests/let-syntax.test b/tests/let-syntax.test index db90afff..bfa5440b 100755 --- a/tests/let-syntax.test +++ b/tests/let-syntax.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/let.test b/tests/let.test index 7f3f6b20..2e19696b 100755 --- a/tests/let.test +++ b/tests/let.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/match.test b/tests/match.test index c2103926..c1e9f985 100755 --- a/tests/match.test +++ b/tests/match.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/psyntax.test b/tests/psyntax.test index 40826b4b..4b8d21f6 100755 --- a/tests/psyntax.test +++ b/tests/psyntax.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/quasiquote.test b/tests/quasiquote.test index 756452bf..bf65af7b 100755 --- a/tests/quasiquote.test +++ b/tests/quasiquote.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/read.test b/tests/read.test new file mode 100755 index 00000000..6ae37184 --- /dev/null +++ b/tests/read.test @@ -0,0 +1,45 @@ +#! /bin/sh +# -*-scheme-*- +# ***REMOVE THIS BLOCK COMMENT INITIALLY*** +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" +#paredit:|| +exit $? +!# + +;; FIXME +(gc) + + +0 +cons +(cons 0 1) +(display 0) (newline) +#t +#f +(display #t) (newline) +(display #f) (newline) +'foo +(display 'foo) (newline) +(display #x16) (newline) +(display #\A) (newline) +(display #\newline) (newline) +(display 'foo)(newline) +(display '(foo))(newline) +(display '('foo))(newline) +(display (cdr '(car . cdr))) (newline) +(display "foo bar") (newline) +;;barf +#! +barf +!# +(display `(display ,display)) (newline) +(display `(display ,@'(string port))) (newline) +(display #(0 1 2)) (newline) +(display (list '(foo + #! boo !# + ;;(bb 4) + ) + )) +(newline) + +;; TODO: syntax, unsyntax, unsyntax-splicing diff --git a/tests/record.test b/tests/record.test index c107c158..9b872f6f 100755 --- a/tests/record.test +++ b/tests/record.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/scm.test b/tests/scm.test index 8388f1b7..0eb6f6e8 100755 --- a/tests/scm.test +++ b/tests/scm.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/tests/vector.test b/tests/vector.test index 6280ea0f..e40ba2d2 100755 --- a/tests/vector.test +++ b/tests/vector.test @@ -1,6 +1,6 @@ #! /bin/sh # -*-scheme-*- -echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@" +echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes $MES_FLAGS "$@" #paredit:|| exit $? !# diff --git a/type.c b/type.c index 61c3b578..50b00673 100644 --- a/type.c +++ b/type.c @@ -75,11 +75,6 @@ builtin_p (SCM x) } // Non-types -SCM -null_p (SCM x) -{ - return x == cell_nil ? cell_t : cell_f; -} SCM atom_p (SCM x)