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

[nucl] implement word definition

Browse source
This commit is contained in:
Daniel Kochmański 2025-05-30 11:24:06 +02:00
parent d83fcdf836
commit d038931e1b
1 changed files with 54 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

82
src/c/nucl.c
View file

@ -762,12 +762,13 @@ nucl_extend_dictionary(cl_object name, cl_object value)
}
static cl_object
nucl_append_dictionary(cl_object entry)
nucl_append_dictionary(cl_object symbol, cl_object value)
{
cl_env_ptr the_env = ecl_core.first_env;
cl_object dict = ECL_SYM_VAL(the_env, nucl_dt);
ecl_stack_push(dict, entry);
return entry;
ECL_SET(symbol, value);
ecl_stack_push(dict, symbol);
return symbol;
}
static cl_object
@ -783,7 +784,14 @@ cl_object nucl_eval_word(int narg, cl_object word) {
cl_object strm = nucl_stdout();
switch(ecl_t_of(value)) {
case t_list:
nucl_write_cstr(strm, ">>> error: implement me");
loop_for_on_unsafe(value) {
cl_object word = ECL_CONS_CAR(value);
if(ecl_t_of(word) == t_symbol) {
nucl_eval_word(1, word);
} else {
nucl_stack_push(word);
}
} end_loop_for_on_unsafe (command);
break;
default:
_ecl_funcall2(value, word);
@ -800,12 +808,19 @@ cl_object nucl_word_def(int narg, cl_object op) {
}
if (!nucl_cstrcmp(op->symbol.name, ";", 1)) {
ECL_SETQ(the_env, nucl_cmpp, ECL_NIL);
return ECL_NIL;
(cmpp == ECL_T)
? nucl_write_cstr(strm, "$$$ error: empty definition")
: nucl_append_dictionary(cmpp, nucl_stack_to_list());
nucl_stack_pop();
} else if (!nucl_cstrcmp(op->symbol.name, ":", 1)) {
nucl_write_cstr(strm, "$$$ error: nested compilation");
return ECL_NIL;
} else if (cmpp == ECL_T) {
ECL_SETQ(the_env, nucl_cmpp, op);
} else {
nucl_stack_push(op);
cl_object word = nucl_search_dictionary(op->symbol.name);
(word == ECL_UNBOUND)
? nucl_write_cstr(strm, "$$$ error: undefined word")
: nucl_stack_push(word);
}
return ECL_NIL;
}
@ -816,6 +831,25 @@ cl_object nucl_word_fed(int narg, cl_object op) {
return ECL_NIL;
}
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);
if(Null(cmpp)) {
cl_object word = nucl_search_dictionary(op->symbol.name);
cl_object strm = nucl_stdout();
(word == ECL_UNBOUND)
? nucl_write_cstr(strm, ">>> error: undefined word")
: nucl_eval_word(1, word);
} else {
nucl_word_def(1, op);
}
return op;
}
ecl_def_function(_nucl_word_def, nucl_word_def, static, const);
ecl_def_function(_nucl_word_fed, nucl_word_fed, static, const);
cl_object nucl_word_ps(int narg, cl_object op) {
cl_index ssize = nucl_stack_size();
cl_object size = ecl_make_fixnum(ssize);
@ -831,6 +865,17 @@ cl_object nucl_word_ps(int narg, cl_object op) {
return size;
}
cl_object nucl_word_pd(int narg, cl_object op) {
cl_env_ptr the_env = ecl_core.first_env;
cl_object dict = ECL_SYM_VAL(the_env, nucl_dt);
cl_object strm = nucl_stdout();
loop_across_stack_fifo(elt, dict) {
nucl_write_object(strm, elt);
nucl_write_cstr(strm, " ");
} end_loop_across_stack();
return ECL_NIL;
}
cl_object nucl_word_dp(int narg, cl_object op) {
cl_object strm = nucl_stdout();
cl_index ssize = nucl_stack_size();
@ -845,28 +890,8 @@ 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_pd, nucl_word_pd, static, const);
ecl_def_function(_nucl_word_dp, nucl_word_dp, static, const);
/* Our dictionary is based on symbols. Each symbol in a dictionary has a name
@ -879,6 +904,7 @@ 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(".D", _nucl_word_pd),
make_dict_entry(".", _nucl_word_dp),
NULL,
};