From 52ca1f83e34072afc47b83d8c8a42ea9f91a35b9 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 8 Mar 2011 08:34:27 +0000 Subject: [PATCH] writing qse_scm_eval() --- qse/cmd/scm/scm.c | 42 ++++++-- qse/include/qse/scm/scm.h | 19 ++-- qse/lib/scm/Makefile.am | 2 +- qse/lib/scm/Makefile.in | 6 +- qse/lib/scm/err.c | 8 +- qse/lib/scm/eval.c | 195 ++++++++++++++++++++++++++++++-------- qse/lib/scm/mem.c | 34 +++++-- qse/lib/scm/print.c | 20 +++- qse/lib/scm/scm.c | 27 +++--- qse/lib/scm/scm.h | 57 ++++++----- 10 files changed, 302 insertions(+), 108 deletions(-) diff --git a/qse/cmd/scm/scm.c b/qse/cmd/scm/scm.c index 05edb944..a850ff6f 100644 --- a/qse/cmd/scm/scm.c +++ b/qse/cmd/scm/scm.c @@ -117,12 +117,12 @@ static int handle_args (int argc, qse_char_t* argv[]) break; case QSE_T('?'): - qse_fprintf (QSE_STDERR, QSE_T("Error: illegal option - %c\n"), opt.opt); + qse_fprintf (QSE_STDERR, QSE_T("ERROR: illegal option - %c\n"), opt.opt); print_usage (argv[0]); return -1; case QSE_T(':'): - qse_fprintf (QSE_STDERR, QSE_T("Error: missing argument for %c\n"), opt.opt); + qse_fprintf (QSE_STDERR, QSE_T("ERROR: missing argument for %c\n"), opt.opt); print_usage (argv[0]); return -1; } @@ -130,14 +130,14 @@ static int handle_args (int argc, qse_char_t* argv[]) if (opt.ind < argc) { - qse_printf (QSE_T("Error: redundant argument - %s\n"), argv[opt.ind]); + qse_printf (QSE_T("ERROR: redundant argument - %s\n"), argv[opt.ind]); print_usage (argv[0]); return -1; } if (opt_memsize <= 0) { - qse_printf (QSE_T("Error: invalid memory size given\n")); + qse_printf (QSE_T("ERROR: invalid memory size given\n")); return -1; } return 0; @@ -153,7 +153,7 @@ int scm_main (int argc, qse_char_t* argv[]) scm = qse_scm_open (QSE_NULL, 0, opt_memsize, opt_meminc); if (scm == QSE_NULL) { - qse_printf (QSE_T("Error: cannot create a scm instance\n")); + qse_printf (QSE_T("ERROR: cannot create a scm instance\n")); return -1; } @@ -164,8 +164,36 @@ int scm_main (int argc, qse_char_t* argv[]) qse_scm_attachio (scm, &io); } -//qse_scm_read (scm); -qse_scm_print (scm, qse_scm_read (scm)); +{ +qse_scm_ent_t* x1, * x2; + +x1 = qse_scm_read (scm); +if (x1 == QSE_NULL) +{ + qse_printf (QSE_T("ERROR: %s\n"), qse_scm_geterrmsg(scm)); +} +else +{ + x2 = qse_scm_eval (scm, x1); + if (x2 == QSE_NULL) + { + qse_printf (QSE_T("ERROR: %s ...\n "), qse_scm_geterrmsg(scm)); + qse_scm_print (scm, x1); + qse_printf (QSE_T("\n")); + + } + else + { + qse_printf (QSE_T("Evaluated...\n ")); + qse_scm_print (scm, x1); + qse_printf (QSE_T("\nTo...\n ")); + qse_scm_print (scm, x2); + qse_printf (QSE_T("\n")); + } + +} + +} #if 0 while (1) diff --git a/qse/include/qse/scm/scm.h b/qse/include/qse/scm/scm.h index 419c6581..e3f8f0fe 100644 --- a/qse/include/qse/scm/scm.h +++ b/qse/include/qse/scm/scm.h @@ -92,6 +92,7 @@ enum qse_scm_errnum_t { QSE_SCM_ENOERR, QSE_SCM_ENOMEM, + QSE_SCM_EINTERN, QSE_SCM_EEXIT, QSE_SCM_EEND, @@ -100,11 +101,11 @@ enum qse_scm_errnum_t QSE_SCM_EENDSTR, QSE_SCM_ESHARP, QSE_SCM_EDOT, - - QSE_SCM_EINTERN, - QSE_SCM_ELSTDEEP, QSE_SCM_ELPAREN, QSE_SCM_ERPAREN, + QSE_SCM_ELSTDEEP, + + QSE_SCM_EVARBAD, QSE_SCM_EARGBAD, QSE_SCM_EARGFEW, QSE_SCM_EARGMANY, @@ -251,8 +252,8 @@ qse_scm_ent_t* qse_scm_eval ( * The qse_scm_print() function prints an entity. */ int qse_scm_print ( - qse_scm_t* scm, /**< scheme */ - const qse_scm_ent_t* obj /**< entity */ + qse_scm_t* scm, /**< scheme */ + qse_scm_ent_t* obj /**< entity */ ); /** @@ -297,7 +298,7 @@ qse_scm_ent_t* qse_scm_makesyment ( qse_scm_ent_t* qse_scm_makesyntent ( qse_scm_t* scm, const qse_char_t* name, - int code + void* uptr ); qse_scm_ent_t* qse_scm_makeprocent ( @@ -306,6 +307,12 @@ qse_scm_ent_t* qse_scm_makeprocent ( int code ); +qse_scm_ent_t* qse_scm_makeclosent ( + qse_scm_t* scm, + qse_scm_ent_t* code, + qse_scm_ent_t* env +); + #ifdef __cplusplus } #endif diff --git a/qse/lib/scm/Makefile.am b/qse/lib/scm/Makefile.am index db454fea..ef3808d7 100644 --- a/qse/lib/scm/Makefile.am +++ b/qse/lib/scm/Makefile.am @@ -8,6 +8,6 @@ AM_CPPFLAGS = \ lib_LTLIBRARIES = libqsescm.la -libqsescm_la_SOURCES = scm.h scm.c mem.c read.c print.c err.c +libqsescm_la_SOURCES = scm.h scm.c mem.c read.c eval.c print.c err.c libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined libqsescm_la_LIBADD = -lqsecmn diff --git a/qse/lib/scm/Makefile.in b/qse/lib/scm/Makefile.in index 06c486f9..b81cfcb2 100644 --- a/qse/lib/scm/Makefile.in +++ b/qse/lib/scm/Makefile.in @@ -71,7 +71,8 @@ am__base_list = \ am__installdirs = "$(DESTDIR)$(libdir)" LTLIBRARIES = $(lib_LTLIBRARIES) libqsescm_la_DEPENDENCIES = -am_libqsescm_la_OBJECTS = scm.lo mem.lo read.lo print.lo err.lo +am_libqsescm_la_OBJECTS = scm.lo mem.lo read.lo eval.lo print.lo \ + err.lo libqsescm_la_OBJECTS = $(am_libqsescm_la_OBJECTS) libqsescm_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \ $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ @@ -238,7 +239,7 @@ AM_CPPFLAGS = \ -I$(includedir) lib_LTLIBRARIES = libqsescm.la -libqsescm_la_SOURCES = scm.h scm.c mem.c read.c print.c err.c +libqsescm_la_SOURCES = scm.h scm.c mem.c read.c eval.c print.c err.c libqsescm_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined libqsescm_la_LIBADD = -lqsecmn all: all-am @@ -316,6 +317,7 @@ distclean-compile: -rm -f *.tab.c @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/eval.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mem.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/print.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/read.Plo@am__quote@ diff --git a/qse/lib/scm/err.c b/qse/lib/scm/err.c index 65f2cf92..4de02909 100644 --- a/qse/lib/scm/err.c +++ b/qse/lib/scm/err.c @@ -25,7 +25,9 @@ const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum) static const qse_char_t* errstr[] = { QSE_T("no error"), + QSE_T("out of memory"), + QSE_T("internal error"), QSE_T("exit"), QSE_T("end of source"), @@ -34,11 +36,11 @@ const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum) QSE_T("unexpected end of string"), QSE_T("bad sharp expression"), QSE_T("wrong use of dot"), - - QSE_T("internal error"), - QSE_T("list too deep"), QSE_T("left parenthesis expected"), QSE_T("right parenthesis expected"), + QSE_T("list too deep"), + + QSE_T("bad variable"), QSE_T("bad arguments"), QSE_T("too few arguments"), QSE_T("too many arguments"), diff --git a/qse/lib/scm/eval.c b/qse/lib/scm/eval.c index 9ffec0be..dfe8637c 100644 --- a/qse/lib/scm/eval.c +++ b/qse/lib/scm/eval.c @@ -20,70 +20,189 @@ #include "scm.h" -static qse_scm_ent_t* apply (qse_scm_t* scm) +static int eval_entity (qse_scm_t* scm); + +static int save (qse_scm_t* scm, qse_scm_ent_t* ) { - if (TYPE(scm->reg.cod) == QSE_SCM_ENT_PROC) - { - /* builtin-procedure */ - } -#if 0 - else if (TYPE(scm->reg.cod) == QSE_SCM_ENT_CLO) - { - /* closure */ - } - else if (TYPE(scm->reg.cod) == QSE_SCM_ENT_CON) - { - /* continuation */ - } -#endif - else - { - } } -static qse_scm_ent_t* eval_args (qse_scm_t* scm) +static int leave (qse_scm_t* scm) { - args = cons (value, args); - if (TYPE(scm->reg.cod)) - { - } - else - { - } } -static qse_scm_ent_t* eval_entity (qse_scm_t* scm) +int qse_scm_dolambda (qse_scm_t* scm) { + qse_scm_ent_t* obj; - if (IS_SMALLINT(scm->reg.cod)) + obj = qse_scm_makeclosent (scm, scm->e.cod, scm->e.env); + if (obj == QSE_NULL) return -1; + scm->e.out = obj; + return 0; +} + +int qse_scm_doquote (qse_scm_t* scm) +{ + /* For the expression (quote 10), + * scm.e.cod is (10). + * PAIR_CAR(scm.e.cod) is 10 + */ + scm->e.out = PAIR_CAR(scm->e.cod); + return 0; +} + +static int define_finish (qse_scm_t* scm) +{ + qse_scm_ent_t* var = scm->e.cod; + //set var in the environemtn.... + + leave (scm); + return 0; +} + +int qse_scm_dodefine (qse_scm_t* scm) +{ + qse_scm_ent_t* car, * cdr; + + car = PAIR_CAR(scm->e.cod); + cdr = PAIR_CDR(scm->e.cod); + +/* TODO: support function defintion - (define (f x y) (+ x y) (* x y)) + -> support it by converting it to lambda expression + -> (define f (lambda (x y) (+ x y) (* x y)) + */ + if (IS_SMALLINT(scm,cdr) || TYPE(cdr) != QSE_SCM_ENT_PAIR) + { + /* (define x . 10) */ + /* TODO: change error code ... */ + qse_scm_seterror (scm, QSE_SCM_EARGBAD, QSE_NULL, QSE_NULL); + return -1; + } + + if (!IS_NIL(scm,PAIR_CDR(cdr))) + { + /* (define x 10 . 20) + * (define x 10 20) */ + qse_scm_seterror (scm, QSE_SCM_EARGMANY, QSE_NULL, QSE_NULL); + return -1; + } + + if (IS_SMALLINT(scm,car) || TYPE(car) != QSE_SCM_ENT_SYM) + { + /* check if the variable is a symbol + * (define 20 10) + */ + qse_scm_seterror (scm, QSE_SCM_EVARBAD, QSE_NULL, QSE_NULL); + return -1; + } + + save car... + +// let it jump to EVAL and come back to DEFINE_FINISH... + scm->e.cod = PAIR_CAR(cdr); + scm->e.op = eval_entity; + return 0; +} + +int qse_scm_dobegin (qse_scm_t* scm) +{ + /* + (begin + (print "hello") + (print "world") + ) + */ + + qse_scm_ent_t* car, * cdr; + + if (IS_SMALLINT(scm.e.cod) || TYPE(scm.e.cod) != QSE_SCM_ENT_PAIR) + { + /* (begin (+ x y) . 30) */ + qse_scm_seterror (scm, QSE_SCM_EARGBAD, QSE_NULL, QSE_NULL); + return -1; + } + + car = PAIR_CAR(scm.e.cod); + cdr = PAIR_CDR(scm.e.cod); + + if (!IS_NIL(cdr)) + { +save (BEGIN... cdr); + } + + scm.e.cod = car; + scm.e.op = eval_entity; + return 0; +} + +int qse_scm_doif (qse_scm_t* scm) +{ + return 0; +} + +static int eval_entity (qse_scm_t* scm) +{ + if (IS_SMALLINT(scm,scm->e.cod)) { } - else if (TYPE(scm->reg.cod) == QSE_SCM_ENT_SYM) + else if (TYPE(scm->e.cod) == QSE_SCM_ENT_PAIR) { - } - else if (TYPE(scm->reg.cod) == QSE_SCM_ENT_PAIR) - { - car = PAIR_CAR(scm->reg.cod); + qse_scm_ent_t* car, * cdr; + + /* the first item in the list */ + car = PAIR_CAR(scm->e.cod); if (SYNT(car)) { +qse_printf (QSE_T("xxxxx\n")); + /* the first item in the list is a syntax symbol */ + cdr = PAIR_CDR(scm->e.cod); + if (IS_SMALLINT(scm,cdr) || TYPE(cdr) != QSE_SCM_ENT_PAIR) + { + /* check if the cdr part ends the list with a dot + * as in (quote . 10) */ + qse_scm_seterror (scm, QSE_SCM_EARGBAD, 0, 0); + return -1; + } + + /* go on to the syntax function */ + scm->e.cod = cdr; + scm->e.op = SYNT_UPTR(car); } else { + /* push E1_ARG.... NIL, PAIR_CDR(code) - scm->reg.cod = car; + scm->e.cod = car; goback to eval... + */ } } + else if (TYPE(scm->e.cod) == QSE_SCM_ENT_SYM) + { + /* resolve the symbol from the environment */ + } else { } + + return 0; } qse_scm_ent_t* qse_scm_eval (qse_scm_t* scm, qse_scm_ent_t* obj) { - scm->reg.dmp = scm->nil; - scm->reg.env = scm->gloenv; - scm->reg.cod = obj; + scm->e.dmp = scm->nil; + scm->e.env = scm->gloenv; + scm->e.cod = obj; - return eval_entity (scm); + scm->e.in = obj; + scm->e.out = scm->nil; + scm->e.op = eval_entity; + + do + { + if (scm->e.op (scm) <= -1) return QSE_NULL; + break; + } + while (scm->e.op); + + return scm->e.out; } diff --git a/qse/lib/scm/mem.c b/qse/lib/scm/mem.c index 249ffcb9..3a0fe2c3 100644 --- a/qse/lib/scm/mem.c +++ b/qse/lib/scm/mem.c @@ -199,10 +199,14 @@ static void gc (qse_scm_t* scm, qse_scm_ent_t* x, qse_scm_ent_t* y) mark (scm, scm->symtab); mark (scm, scm->gloenv); - mark (scm, scm->reg.arg); - mark (scm, scm->reg.env); - mark (scm, scm->reg.cod); - mark (scm, scm->reg.dmp); + mark (scm, scm->r.s); + mark (scm, scm->r.e); + mark (scm, scm->p.s); + mark (scm, scm->p.e); + mark (scm, scm->e.arg); + mark (scm, scm->e.env); + mark (scm, scm->e.cod); + mark (scm, scm->e.dmp); /* mark the temporaries */ if (x) mark (scm, x); @@ -388,7 +392,7 @@ Calling strdup is not an option as it is not managed... qse_scm_seterror (scm, QSE_SCM_ENOMEM, QSE_NULL, QSE_NULL); return QSE_NULL; } - LAB_CODE(v) = 0; + LAB_UPTR(v) = QSE_NULL; return v; } @@ -449,17 +453,17 @@ qse_scm_ent_t* qse_scm_makesyment (qse_scm_t* scm, const qse_char_t* name) } qse_scm_ent_t* qse_scm_makesyntent ( - qse_scm_t* scm, const qse_char_t* name, int code) + qse_scm_t* scm, const qse_char_t* name, void* uptr) { qse_scm_ent_t* v; - QSE_ASSERTX (code > 0, "Syntax code must be greater than 0"); + QSE_ASSERTX (uptr != QSE_NULL, "Syntax uptr must not be null"); v = qse_scm_makesyment (scm, name); if (v == QSE_NULL) return QSE_NULL; SYNT(v) = 1; - SYNT_CODE(v) = code; + SYNT_UPTR(v) = uptr; return v; } @@ -524,3 +528,17 @@ qse_scm_ent_t* qse_scm_makeprocent ( return proc; } +qse_scm_ent_t* qse_scm_makeclosent ( + qse_scm_t* scm, qse_scm_ent_t* code, qse_scm_ent_t* env) +{ + qse_scm_ent_t* clos; + + clos = alloc_entity (scm, code, env); + if (clos == QSE_NULL) return QSE_NULL; + + TYPE(clos) = QSE_SCM_ENT_CLOS; + CLOS_CODE(clos) = code; + CLOS_ENV(clos) = env; + + return clos; +} diff --git a/qse/lib/scm/print.c b/qse/lib/scm/print.c index 8232d73b..946015b5 100644 --- a/qse/lib/scm/print.c +++ b/qse/lib/scm/print.c @@ -132,7 +132,7 @@ static QSE_INLINE qse_scm_ent_t* pop (qse_scm_t* scm) return PAIR_CAR(top); } -static QSE_INLINE print_num (qse_scm_t* scm, qse_long_t nval) +static QSE_INLINE int print_num (qse_scm_t* scm, qse_long_t nval) { qse_char_t tmp[QSE_SIZEOF(qse_long_t)*8+2]; qse_size_t len; @@ -258,10 +258,13 @@ next: break; } - #if 0 case QSE_SCM_ENT_PROC: + OUTPUT_STR (scm, QSE_T("#")); + break; + + case QSE_SCM_ENT_CLOS: + OUTPUT_STR (scm, QSE_T("#")); break; - #endif default: QSE_ASSERTX ( @@ -279,7 +282,7 @@ done: return 0; } -int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj) +int qse_scm_print (qse_scm_t* scm, qse_scm_ent_t* obj) { int n; @@ -288,7 +291,14 @@ int qse_scm_print (qse_scm_t* scm, const qse_scm_ent_t* obj) "Specify output function before calling qse_scm_print()" ); - n = print_entity (scm, obj); + QSE_ASSERTX ( + IS_NIL(scm,scm->p.s), + "The printing stack is not empty before printing - buggy!!" + ); + + scm->p.e = obj; /* remember the head of the entity to print */ + n = print_entity (scm, obj); /* call the actual printing routine */ + scm->p.e = scm->nil; /* reset what's remembered */ /* clear the printing stack if an error has occurred for GC not to keep * the entities in the stack */ diff --git a/qse/lib/scm/scm.c b/qse/lib/scm/scm.c index 71882557..4396c983 100644 --- a/qse/lib/scm/scm.c +++ b/qse/lib/scm/scm.c @@ -128,25 +128,25 @@ int qse_scm_attachio (qse_scm_t* scm, qse_scm_io_t* io) return 0; } -#define MAKE_SYNTAX_ENTITY(scm,name,code) QSE_BLOCK( \ - if (qse_scm_makesyntent (scm, name, code) == QSE_NULL) return -1; \ +#define MAKE_SYNTAX_ENTITY(scm,name,uptr) QSE_BLOCK( \ + if (qse_scm_makesyntent (scm, name, uptr) == QSE_NULL) return -1; \ ) static int build_syntax_entities (qse_scm_t* scm) { qse_scm_ent_t* v; - v = qse_scm_makesyntent (scm, QSE_T("lambda"), 1); + v = qse_scm_makesyntent (scm, QSE_T("lambda"), qse_scm_dolambda); if (v == QSE_NULL) return -1; scm->lambda = v; - v = qse_scm_makesyntent (scm, QSE_T("quote"), 2); + v = qse_scm_makesyntent (scm, QSE_T("quote"), qse_scm_doquote); if (v == QSE_NULL) return -1; scm->quote = v; - MAKE_SYNTAX_ENTITY (scm, QSE_T("define"), 3); - MAKE_SYNTAX_ENTITY (scm, QSE_T("if"), 4); - MAKE_SYNTAX_ENTITY (scm, QSE_T("begin"), 5); + MAKE_SYNTAX_ENTITY (scm, QSE_T("define"), qse_scm_dodefine); + MAKE_SYNTAX_ENTITY (scm, QSE_T("begin"), qse_scm_dobegin); + MAKE_SYNTAX_ENTITY (scm, QSE_T("if"), qse_scm_doif); return 0; } @@ -185,7 +185,6 @@ static qse_scm_t* qse_scm_init ( scm->r.curloc.colm = 0; if (qse_str_init(&scm->r.t.name, mmgr, 256) == QSE_NULL) return QSE_NULL; - /* initialize common values */ scm->nil = &static_values[0]; scm->t = &static_values[1]; @@ -201,24 +200,24 @@ static qse_scm_t* qse_scm_init ( * below. qse_scm_makepairent() calls alloc_entity() that invokes * gc() as this is the first time. As gc() marks all the key data, * we need to initialize these to nil. */ - scm->reg.arg = scm->nil; - scm->reg.dmp = scm->nil; - scm->reg.cod = scm->nil; - scm->reg.env = scm->nil; - scm->symtab = scm->nil; scm->gloenv = scm->nil; + scm->r.s = scm->nil; scm->r.e = scm->nil; scm->p.s = scm->nil; scm->p.e = scm->nil; + scm->e.arg = scm->nil; + scm->e.dmp = scm->nil; + scm->e.cod = scm->nil; + scm->e.env = scm->nil; /* build the global environment entity as a pair */ scm->gloenv = qse_scm_makepairent (scm, scm->nil, scm->nil); if (scm->gloenv == QSE_NULL) goto oops; /* update the current environment to the global environment */ - scm->reg.env = scm->gloenv; + scm->e.env = scm->gloenv; if (build_syntax_entities (scm) <= -1) goto oops; return scm; diff --git a/qse/lib/scm/scm.h b/qse/lib/scm/scm.h index 2799d2d9..a0fb473e 100644 --- a/qse/lib/scm/scm.h +++ b/qse/lib/scm/scm.h @@ -44,17 +44,11 @@ enum qse_scm_ent_type_t QSE_SCM_ENT_NAM = (1 << 6), QSE_SCM_ENT_SYM = (1 << 7), QSE_SCM_ENT_PAIR = (1 << 8), - QSE_SCM_ENT_PROC = (1 << 9) + QSE_SCM_ENT_PROC = (1 << 9), + QSE_SCM_ENT_CLOS = (1 << 10) }; -#if 0 -#define QSE_SCM_ENT_CLOSURE 64 /* 0000000001000000 */ -#define QSE_SCM_ENT_CONTINUATION 128 /* 0000000010000000 */ -#define QSE_SCM_ENT_MACRO 256 /* 0000000100000000 */ -#define QSE_SCM_ENT_PROMISE 512 /* 0000001000000000 */ -#endif - /** * The qse_scm_ent_t type defines an entity that represents an individual * value in scheme. @@ -64,7 +58,7 @@ struct qse_scm_ent_t qse_uint32_t dswcount: 2; qse_uint32_t mark: 1; qse_uint32_t atom: 1; - qse_uint32_t synt: 1; + qse_uint32_t synt: 1; /* can be set to 1 if type is QSE_SCM_ENT_SYM */ qse_uint32_t type: 27; union @@ -90,7 +84,7 @@ struct qse_scm_ent_t struct { qse_char_t* ptr; /* null-terminated string */ - int code; /* used for syntax entities only */ + void* uptr; /* used for syntax entities only */ } lab; /* label */ struct @@ -116,13 +110,15 @@ struct qse_scm_ent_t #define STR_PTR(v) ((v)->u.str.ptr) #define STR_LEN(v) ((v)->u.str.len) #define LAB_PTR(v) ((v)->u.lab.ptr) -#define LAB_CODE(v) ((v)->u.lab.code) +#define LAB_UPTR(v) ((v)->u.lab.uptr) #define SYM_NAME(v) ((v)->u.ref.ent[0]) #define SYM_PROP(v) ((v)->u.ref.ent[1]) -#define SYNT_CODE(v) LAB_CODE(SYM_NAME(v)) +#define SYNT_UPTR(v) LAB_UPTR(SYM_NAME(v)) #define PAIR_CAR(v) ((v)->u.ref.ent[0]) #define PAIR_CDR(v) ((v)->u.ref.ent[1]) #define PROC_CODE(v) ((v)->u.proc.code) +#define CLOS_CODE(v) ((v)->u.ref.ent[0]) +#define CLOS_ENV(v) ((v)->u.ref.ent[1]) /** * The qse_scm_enb_t type defines a value block. A value block is allocated @@ -179,13 +175,28 @@ struct qse_scm_t qse_scm_ent_t* s; /* stack for reading */ qse_scm_ent_t* e; /* last entity read */ - } r; + } r; + /** data for printing */ struct { qse_scm_ent_t* s; /* stack for printing */ qse_scm_ent_t* e; /* top entity being printed */ - } p; + } p; + + /* data for evaluation */ + struct + { + int (*op) (qse_scm_t*); + + qse_scm_ent_t* in; + qse_scm_ent_t* out; + + qse_scm_ent_t* arg; /* function arguments */ + qse_scm_ent_t* env; /* current environment */ + qse_scm_ent_t* cod; /* current code */ + qse_scm_ent_t* dmp; /* stack register for next evaluation */ + } e; /* common values */ qse_scm_ent_t* nil; @@ -197,16 +208,6 @@ struct qse_scm_t qse_scm_ent_t* gloenv; /* global environment */ qse_scm_ent_t* symtab; /* symbol table */ - /* registers */ - struct - { - qse_scm_ent_t* arg; /* function arguments */ - qse_scm_ent_t* env; /* current environment */ - qse_scm_ent_t* cod; /* current code */ - qse_scm_ent_t* dmp; /* stack register for next evaluation */ - } reg; - - /* fields for entity allocation */ struct { @@ -226,6 +227,14 @@ struct qse_scm_t extern "C" { #endif + +/* eval.c */ +int qse_scm_dolambda (qse_scm_t* scm); +int qse_scm_doquote (qse_scm_t* scm); +int qse_scm_dodefine (qse_scm_t* scm); +int qse_scm_dobegin (qse_scm_t* scm); +int qse_scm_doif (qse_scm_t* scm); + /* err.c */ const qse_char_t* qse_scm_dflerrstr (qse_scm_t* scm, qse_scm_errnum_t errnum);