From d83fcdf8366b551f6f975b830766abbe6a4dc6c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 30 May 2025 10:47:19 +0200
Subject: [PATCH] [nucl] add a compilation mode (doesn't actually compile yet)

---
 src/c/nucl.c | 84 ++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 71 insertions(+), 13 deletions(-)

diff --git a/src/c/nucl.c b/src/c/nucl.c
index fa9281cdd..d3b307376 100644
--- a/src/c/nucl.c
+++ b/src/c/nucl.c
@@ -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");