mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-10 23:20:23 -07:00
Code Issues Projects Releases Packages Wiki Activity

[nucl] add a compilation mode (doesn't actually compile yet)

Browse source
This commit is contained in:
Daniel Kochmański 2025-05-30 10:47:19 +02:00
parent a317f03c01
commit d83fcdf836
1 changed files with 71 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

84
src/c/nucl.c
View file

@ -116,6 +116,7 @@ DEFINE_SPECIAL(nucl_ostrm, "*ISTRM*", ECL_NIL); /* standard input */
DEFINE_SPECIAL(nucl_istrm, "*OSTRM*", ECL_NIL); /* standard output */
DEFINE_SPECIAL(nucl_fp, "*FP*", ECL_NIL); /* stack frame */
DEFINE_SPECIAL(nucl_dt, "*DT*", ECL_NIL); /* dictionary */
DEFINE_SPECIAL(nucl_cmpp, "*cmpp*", ECL_NIL); /* compilep */
/* -- Since now on we will often use the stack, so here are some operators - */
@ -717,6 +718,17 @@ nucl_strcmp(cl_object x, cl_object y)
return 1;
}
static bool
nucl_cstrcmp(cl_object x, const char *s, cl_index fp2)
{
/* only base strings */
cl_index fp1 = x->base_string.fillp;
if(fp1==fp2)
return memcmp(x->base_string.self, s, fp1);
else
return 1;
}
static cl_object
nucl_search_dictionary(cl_object name)
{
@ -766,19 +778,41 @@ word_reader(int narg, cl_object strm, cl_object c)
return nucl_search_dictionary(string);
}
cl_object nucl_call_word(int narg, cl_object op) {
cl_object nucl_eval_word(int narg, cl_object word) {
cl_object value = word->symbol.value;
cl_object strm = nucl_stdout();
cl_object word = nucl_search_dictionary(op->symbol.name);
(word == ECL_UNBOUND)
? nucl_write_cstr(strm, ">>> error: undefined word")
: _ecl_funcall2(word->symbol.value, word);
return op;
switch(ecl_t_of(value)) {
case t_list:
nucl_write_cstr(strm, ">>> error: implement me");
break;
default:
_ecl_funcall2(value, word);
}
}
cl_object nucl_word_def(int narg, cl_object op) {
cl_object ostrm = nucl_stdout();
/* cl_object istrm = nucl_stdin(); */
nucl_write_cstr(ostrm, ">>> nucl_call_word: define word.\n");
cl_env_ptr the_env = ecl_core.first_env;
cl_object cmpp = ECL_SYM_VAL(the_env, nucl_cmpp);
cl_object strm = nucl_stdout();
if(Null(cmpp)) {
ECL_SETQ(the_env, nucl_cmpp, ECL_T);
return ECL_NIL;
}
if (!nucl_cstrcmp(op->symbol.name, ";", 1)) {
ECL_SETQ(the_env, nucl_cmpp, ECL_NIL);
return ECL_NIL;
} else if (!nucl_cstrcmp(op->symbol.name, ":", 1)) {
nucl_write_cstr(strm, "$$$ error: nested compilation");
return ECL_NIL;
} else {
nucl_stack_push(op);
}
return ECL_NIL;
}
cl_object nucl_word_fed(int narg, cl_object op) {
cl_object strm = nucl_stdout();
nucl_write_cstr(strm, "$$$ error: not compiling");
return ECL_NIL;
}
@ -811,7 +845,26 @@ cl_object nucl_word_dp(int narg, cl_object op) {
}
}
cl_object nucl_call_word(int narg, cl_object op) {
cl_env_ptr the_env = ecl_core.first_env;
cl_object strm = nucl_stdout();
cl_object cmpp = ECL_SYM_VAL(the_env, nucl_cmpp);
cl_object word = nucl_search_dictionary(op->symbol.name);
if(Null(cmpp)) {
cl_object strm = nucl_stdout();
(word == ECL_UNBOUND)
? nucl_write_cstr(strm, ">>> error: undefined word")
: _ecl_funcall2(word->symbol.value, word);
} else {
(word == ECL_UNBOUND)
? nucl_write_cstr(strm, "$$$ error: undefined word")
: nucl_word_def(1, word);
}
return op;
}
ecl_def_function(_nucl_word_def, nucl_word_def, static, const);
ecl_def_function(_nucl_word_fed, nucl_word_fed, static, const);
ecl_def_function(_nucl_word_ps, nucl_word_ps, static, const);
ecl_def_function(_nucl_word_dp, nucl_word_dp, static, const);
@ -824,6 +877,7 @@ ecl_def_function(_nucl_word_dp, nucl_word_dp, static, const);
static cl_object nucl_dictionary_default_entries[] = {
make_dict_entry(":", _nucl_word_def),
make_dict_entry(";", _nucl_word_fed),
make_dict_entry(".S", _nucl_word_ps),
make_dict_entry(".", _nucl_word_dp),
NULL,
@ -849,7 +903,7 @@ cl_object nucl_read_command (cl_object istrm)
return result;
}
cl_object nucl_exec_command (cl_object command)
cl_object nucl_execute_command (cl_object command)
{
loop_for_on_unsafe(command) {
cl_object word = ECL_CONS_CAR(command);
@ -876,11 +930,15 @@ void nucl_repl (void)
open_nucl_frame(frame); /* top level frame */
do {
nucl_write_cstr(ostrm, "nucl> ");
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
nucl_write_cstr(ostrm, "nucl> ");
else
nucl_write_cstr(ostrm, "... ");
result = nucl_read_command(istrm);
command = nucl_stack_pop();
nucl_exec_command(command);
nucl_write_cstr(ostrm, "... ok\n");
nucl_execute_command(command);
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
nucl_write_cstr(ostrm, "... ok\n");
} while(result != ECL_EOF);
close_nucl_frame(frame);
nucl_write_cstr(ostrm, "... bye\n");