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

mini-mes: Parse with Nyacc.

Browse source 
* doc/examples/mini-mes.c: Parse with Nyacc.
This commit is contained in:
Jan Nieuwenhuizen 2017-01-02 07:50:44 +01:00
parent 8989dab8b0
commit 0315d42306
1 changed files with 58 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

112
scaffold/mini-mes.c
View file

@ -1,6 +1,6 @@
/* -*-comment-start: "//";comment-end:""-*- /* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software * Mes --- Maxwell Equations of Software
* Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
* *
* This file is part of Mes. * This file is part of Mes.
* *
@ -21,18 +21,22 @@
#define MES_MINI 1 #define MES_MINI 1
#if __GNUC__ #if __GNUC__
#define FIXME_NYACC 1
#define __NYACC__ 0 #define __NYACC__ 0
#define NYACC #define NYACC_CAR
#define NYACC2 #define NYACC_CDR
#else #else
#define __NYACC__ 1 #define __NYACC__ 1
#define NYACC nyacc #define NYACC_CAR nyacc_car
#define NYACC2 nyacc2 #define NYACC_CDR nyacc_cdr
#endif #endif
typedef long size_t; typedef long size_t;
void *malloc (size_t i); void *malloc (size_t i);
#if __GNUC__
int int
open (char const *s, int mode) open (char const *s, int mode)
{ {
@ -82,6 +86,7 @@ free (void *p)
int *n = (int*)p-1; int *n = (int*)p-1;
//munmap ((void*)p, *n); //munmap ((void*)p, *n);
} }
#endif // __GNUC__
#define EOF -1 #define EOF -1
#define STDIN 0 #define STDIN 0
@ -105,8 +110,8 @@ strlen (char const* s)
int int
strcmp (char const* a, char const* b) strcmp (char const* a, char const* b)
{ {
while (*a && *b && *a == *b) {*a++;b++;} while (*a && *b && *a == *b) {a++;b++;}
return *a == *b; return *a - *b;
} }
int int
@ -161,7 +166,12 @@ assert_fail (char* s)
*((int*)0) = 0; *((int*)0) = 0;
} }
#define assert(x) ((x) ? (void)0 : assert_fail(#x)) #if __NYACC__ || FIXME_NYACC
#define assert(x) ((x) ? (void)0 : assert_fail(0))
// #else
// NYACC
// #define assert(x) ((x) ? (void)0 : assert_fail(#x))
#endif
#define false 0 #define false 0
#define true 1 #define true 1
typedef int bool; typedef int bool;
@ -169,7 +179,11 @@ typedef int bool;
int ARENA_SIZE = 100000; int ARENA_SIZE = 100000;
typedef int SCM; typedef int SCM;
#if __NYACC__ || FIXME_NYACC
enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
#else
enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART}; enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
#endif
typedef SCM (*function0_t) (void); typedef SCM (*function0_t) (void);
typedef SCM (*function1_t) (SCM); typedef SCM (*function1_t) (SCM);
typedef SCM (*function2_t) (SCM, SCM); typedef SCM (*function2_t) (SCM, SCM);
@ -195,7 +209,7 @@ typedef struct scm_struct {
SCM car; SCM car;
SCM ref; SCM ref;
int length; int length;
} NYACC; } NYACC_CAR;
union { union {
int value; int value;
int function; int function;
@ -205,7 +219,7 @@ typedef struct scm_struct {
SCM macro; SCM macro;
SCM vector; SCM vector;
int hits; int hits;
} NYACC2; } NYACC_CDR;
} scm; } scm;
scm scm_nil = {SPECIAL, "()"}; scm scm_nil = {SPECIAL, "()"};
@ -284,7 +298,7 @@ SCM cell_cdr;
// scm scm_eq_p = {FUNCTION, "eq?", 0}; // scm scm_eq_p = {FUNCTION, "eq?", 0};
// SCM cell_eq_p; // SCM cell_eq_p;
#define TYPE(x) g_cells[x].type #define TYPE(x) (g_cells[x].type)
#define CAR(x) g_cells[x].car #define CAR(x) g_cells[x].car
#define LENGTH(x) g_cells[x].length #define LENGTH(x) g_cells[x].length
@ -298,7 +312,12 @@ SCM cell_cdr;
//#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (CONTINUATION), n, g_stack) //#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (CONTINUATION), n, g_stack)
//#define MAKE_NUMBER(n) make_cell (tmp_num_ (NUMBER), 0, tmp_num2_ (n)) //#define MAKE_NUMBER(n) make_cell (tmp_num_ (NUMBER), 0, tmp_num2_ (n))
//#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0) //#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0)
#define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0)
#if __NYACC__ || FIXME_NYACC
#define MAKE_STRING(x) make_cell (tmp_num_ (TSTRING), x, 0)
// #else
// #define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0)
#endif
SCM SCM
alloc (int n) alloc (int n)
@ -317,13 +336,13 @@ make_cell (SCM type, SCM car, SCM cdr)
TYPE (x) = VALUE (type); TYPE (x) = VALUE (type);
if (VALUE (type) == CHAR || VALUE (type) == NUMBER) { if (VALUE (type) == CHAR || VALUE (type) == NUMBER) {
if (car) CAR (x) = CAR (car); if (car) CAR (x) = CAR (car);
if (cdr) CDR (x) = CDR (cdr); if (cdr) CDR(x) = CDR(cdr);
} else if (VALUE (type) == FUNCTION) { } else if (VALUE (type) == FUNCTION) {
if (car) CAR (x) = car; if (car) CAR (x) = car;
if (cdr) CDR (x) = CDR (cdr); if (cdr) CDR(x) = CDR(cdr);
} else { } else {
CAR (x) = car; CAR (x) = car;
CDR (x) = cdr; CDR(x) = cdr;
} }
return x; return x;
} }
@ -353,7 +372,8 @@ SCM
car (SCM x) car (SCM x)
{ {
#if MES_MINI #if MES_MINI
assert("!car"); //Nyacc
//assert ("!car");
#else #else
if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car)); if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_car));
#endif #endif
@ -364,26 +384,14 @@ SCM
cdr (SCM x) cdr (SCM x)
{ {
#if MES_MINI #if MES_MINI
assert("!car"); //Nyacc
//assert ("!cdr");
#else #else
if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr)); if (TYPE (x) != PAIR) error (cell_symbol_not_a_pair, cons (x, cell_symbol_cdr));
#endif #endif
return CDR (x); return CDR(x);
} }
// SCM
// eq_p (SCM x, SCM y)
// {
// return (x == y
// || ((TYPE (x) == KEYWORD && TYPE (y) == KEYWORD
// && STRING (x) == STRING (y)))
// || (TYPE (x) == CHAR && TYPE (y) == CHAR
// && VALUE (x) == VALUE (y))
// || (TYPE (x) == NUMBER && TYPE (y) == NUMBER
// && VALUE (x) == VALUE (y)))
// ? cell_t : cell_f;
// }
SCM SCM
gc_push_frame () gc_push_frame ()
{ {
@ -486,11 +494,15 @@ SCM
gc_init_cells () gc_init_cells ()
{ {
g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm)); g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm));
g_cells[0].type = VECTOR; #if __NYACC__ || FIXME_NYACC
TYPE (0) = TVECTOR;
// #else
// TYPE (0) = VECTOR;
#endif
LENGTH (0) = 1000; LENGTH (0) = 1000;
VECTOR (0) = 0; VECTOR (0) = 0;
g_cells++; g_cells++;
g_cells[0].type = CHAR; TYPE (0) = CHAR;
VALUE (0) = 'c'; VALUE (0) = 'c';
} }
@ -584,8 +596,8 @@ mes_environment () ///((internal))
SCM SCM
mes_builtins (SCM a) mes_builtins (SCM a)
{ {
#if __GNUC__ && 0 // FIXME: Nyacc #if __GNUC__
// #include "mes.i" //#include "mes.i"
// #include "lib.i" // #include "lib.i"
// #include "math.i" // #include "math.i"
@ -618,12 +630,6 @@ functions[g_function++] = fun_cdr;
cell_cdr = g_free++; cell_cdr = g_free++;
g_cells[cell_cdr] = scm_cdr; g_cells[cell_cdr] = scm_cdr;
// scm_eq_p.function = g_function;
// functions[g_function++] = fun_eq_p;
// cell_eq_p = g_free++;
// g_cells[cell_eq_p] = scm_eq_p;
scm_make_cell.string = cstring_to_list (scm_make_cell.name); scm_make_cell.string = cstring_to_list (scm_make_cell.name);
g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string); g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a); a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
@ -639,11 +645,6 @@ a = acons (make_symbol (scm_car.string), cell_car, a);
scm_cdr.string = cstring_to_list (scm_cdr.name); scm_cdr.string = cstring_to_list (scm_cdr.name);
g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string); g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
a = acons (make_symbol (scm_cdr.string), cell_cdr, a); a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
// scm_eq_p.string = cstring_to_list (scm_eq_p.name);
// g_cells[cell_eq_p].string = MAKE_STRING (scm_eq_p.string);
// a = acons (make_symbol (scm_eq_p.string), cell_eq_p, a);
#endif #endif
return a; return a;
} }
@ -686,7 +687,7 @@ string_to_cstring (SCM s)
{ {
static char buf[1024]; static char buf[1024];
char *p = buf; char *p = buf;
s = STRING (s); s = STRING(s);
while (s != cell_nil) while (s != cell_nil)
{ {
*p++ = VALUE (car (s)); *p++ = VALUE (car (s));
@ -700,11 +701,19 @@ SCM
stderr_ (SCM x) stderr_ (SCM x)
{ {
//SCM write; //SCM write;
if (TYPE (x) == STRING) #if __NYACC__ || FIXME_NYACC
if (TYPE (x) == TSTRING)
// #else
// if (TYPE (x) == STRING)
#endif
eputs (string_to_cstring (x)); eputs (string_to_cstring (x));
// else if ((write = assq_ref_cache (cell_symbol_write, r0)) != cell_undefined) // else if ((write = assq_ref_cache (cell_symbol_write, r0)) != cell_undefined)
// apply (assq_ref_cache (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0); // apply (assq_ref_cache (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL) #if __NYACC__ || FIXME_NYACC
else if (TYPE (x) == SPECIAL || TYPE (x) == TSTRING || TYPE (x) == SYMBOL)
// #else
// else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL)
#endif
eputs (string_to_cstring (x)); eputs (string_to_cstring (x));
else if (TYPE (x) == NUMBER) else if (TYPE (x) == NUMBER)
eputs (itoa (VALUE (x))); eputs (itoa (VALUE (x)));
@ -716,11 +725,6 @@ stderr_ (SCM x)
int int
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
eputs (itoa (234));
eputs ("\n");
assert(!"boo");
return 33;
#if __GNUC__ #if __GNUC__
//g_debug = getenv ("MES_DEBUG"); //g_debug = getenv ("MES_DEBUG");
#endif #endif