diff --git a/r2rs.sh b/r2rs.sh new file mode 100755 index 000000000..9820d287a --- /dev/null +++ b/r2rs.sh @@ -0,0 +1,10 @@ +#!/bin/sh + +rm -f r2rs + +pushd build/c +make r2rs +mv r2rs ../../ +popd + +./r2rs diff --git a/src/c/Makefile.in b/src/c/Makefile.in index 16547299a..9691c56a1 100644 --- a/src/c/Makefile.in +++ b/src/c/Makefile.in @@ -122,6 +122,9 @@ $(HDIR)/%.h: $(top_srcdir)/h/%.h nucl: $(NUCL_SRCS) nucl.c $(CC) $(NUCL_CFLG) -o $@ $^ +r2rs: $(NUCL_SRCS) character.c reader.c reader/parse_fixnum.c r2rs.c + $(CC) $(NUCL_CFLG) -o $@ $^ + ../libeclmin.a: $(OBJS) all_symbols.o all_symbols2.o $(RM) $@ $(AR) cr $@ $(OBJS) diff --git a/src/c/r2rs.c b/src/c/r2rs.c new file mode 100644 index 000000000..8deeb4447 --- /dev/null +++ b/src/c/r2rs.c @@ -0,0 +1,120 @@ +/* Implementation of R2RS, An UnCommonLisp. */ + +/* -- imports --------------------------------------------------------------- */ +#include +#include +#include +#include + +cl_object ecl_make_nucl_stream(FILE *f); + +/* -- globals --------------------------------------------------------------- */ +static cl_object ostr = ECL_NIL; /* input stream */ +static cl_object istr = ECL_NIL; /* output stream */ +static cl_object rtab = ECL_NIL; /* reader table */ + + +/* -- stream ---------------------------------------------------------------- */ +void +init_r2rs_streams(void) { + ostr = ecl_make_nucl_stream(stdout); + istr = ecl_make_nucl_stream(stdin); +} + + +/* -- reader ---------------------------------------------------------------- */ + +static cl_object +alloc_readtable(void) { + cl_object rtable = ecl_alloc_object(t_readtable); + struct ecl_readtable_entry *rtab = (struct ecl_readtable_entry *) + ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry)); + rtable->readtable.locked = 0; + rtable->readtable.parse_token = NULL; + rtable->readtable.read_case = ecl_case_upcase; /* enum ecl_readtable_case */ + rtable->readtable.table = rtab; + for (int i = 0; i < RTABSIZE; i++) { + rtab[i].syntax_type = cat_constituent; /* enum ecl_chattrib */ + rtab[i].macro = ECL_NIL; + rtab[i].table = ECL_NIL; + } +#ifdef ECL_UNICODE + rtable->readtable.hash = ECL_NIL; +#endif + return rtable; +} + +static cl_object +r2rs_parse_token(cl_object token, cl_object in, int flags) { + return ECL_NIL; +} + +static cl_object +_niy(int narg, cl_object in, cl_object c, cl_object d) +{ + ecl_internal_error("not implemented yet"); +} + +static cl_object +_nif(int narg, cl_object in, cl_object c, cl_object d) +{ + ecl_internal_error("deliberely unspecified"); +} + +ecl_def_function(niy, _niy, static, const); +ecl_def_function(nif, _nif, static, const); + +void +init_r2rs_reader(void) { + cl_object niy = niy; + cl_object nif = nif; + rtab = alloc_readtable(); + rtab->readtable.parse_token = r2rs_parse_token; + /* blanks */ + ecl_readtable_set(rtab, '\t', cat_whitespace, ECL_NIL, ECL_NIL); + ecl_readtable_set(rtab, '\n', cat_whitespace, ECL_NIL, ECL_NIL); + ecl_readtable_set(rtab, '\f', cat_whitespace, ECL_NIL, ECL_NIL); + ecl_readtable_set(rtab, '\r', cat_whitespace, ECL_NIL, ECL_NIL); + ecl_readtable_set(rtab, ' ', cat_whitespace, ECL_NIL, ECL_NIL); + /* Special characters */ + ecl_readtable_set(rtab, ')', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, '(', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, ']', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, '[', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, '}', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, '{', cat_terminating, niy, ECL_NIL); + ecl_readtable_set(rtab, '"', cat_terminating, niy, ECL_NIL); + /* Deliberately unspecified (we make them special) */ + ecl_readtable_set(rtab, '#', cat_terminating, nif, ECL_NIL); + ecl_readtable_set(rtab, '`', cat_terminating, nif, ECL_NIL); + ecl_readtable_set(rtab, '\'', cat_terminating, nif, ECL_NIL); + ecl_readtable_set(rtab, '@', cat_terminating, nif, ECL_NIL); + ecl_readtable_set(rtab, '\\', cat_terminating, nif, ECL_NIL); + ecl_readtable_set(rtab, '|', cat_terminating, nif, ECL_NIL); +} + + +/* -- Entry point ----------------------------------------------------------- */ + +int main() { + cl_env_ptr the_env = ecl_core.first_env; + ecl_set_option(ECL_OPT_BIND_STACK_SIZE, 32); + ecl_set_option(ECL_OPT_BIND_STACK_SAFETY_AREA, 8); + ecl_set_option(ECL_OPT_FRAME_STACK_SIZE, 32); + ecl_set_option(ECL_OPT_FRAME_STACK_SAFETY_AREA, 8); + ecl_set_option(ECL_OPT_LISP_STACK_SIZE, 32); + ecl_set_option(ECL_OPT_LISP_STACK_SAFETY_AREA, 8); + + ecl_boot(); + ecl_add_module(ecl_module_process); + ecl_add_module(ecl_module_stacks); + + init_r2rs_reader(); + + printf("Hello ECL! %p\n", the_env); + /* nucl_repl(); */ + printf("Good bye ECL! %p\n", the_env); + + ecl_halt(); + return 0; +}