shithub: femtolisp

Download patch

ref: 15c2b3f58a4fc0238d0ebfd18ed4f8e468897183
parent: a9a81aed1f002597ceaa01fa7e2d7ae127e2b9b7
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Mar 29 08:13:47 EDT 2023

put current fname into unbound errors

--- a/builtins.c
+++ b/builtins.c
@@ -132,7 +132,7 @@
     argcount(nargs, 1);
     symbol_t *sym = tosymbol(args[0]);
     if (sym->binding == UNBOUND)
-        fl_raise(fl_list2(UnboundError, args[0]));
+        unbound_error(args[0]);
     return sym->binding;
 }
 
--- a/flisp.boot
+++ b/flisp.boot
@@ -359,7 +359,7 @@
 							     #fn("6000n0Aw0:" #(*print-readably*))))
 				 *print-readably*) princ)
 	  print #fn(":000|07021062:" #(for-each #fn(write)) print)
-	  print-exception #fn("=000n10B;3D040<20Q;3:04710r4523P072230T247505126554777805151@\x0700B;3D040<29Q;3:04710r4523N0720T2:780512;544777505151@\xd000B;3@040<2<Q;36040=B3?0722=0T2>53@\xac00B;38040<2?Q3B0722@514720=f2@\x8d00B;38040<2AQ3G07B75051514722C0T52@i07D051;3:04710r2523I0770<514722E5142F0T51@>0722G514770514727H61:" #(type-error
+	  print-exception #fn("=000n10B;3D040<20Q;3:04710r4523P072230T247505126554777805151@\x0a00B;3D040<29Q;3:04710r4523N0720T2:780512;544777505151@\xd300B;3@040<2<Q;36040=B3B0722=750512>53@\xac00B;38040<2?Q3B0722@514720=f2@\x8d00B;38040<2AQ3G07B75051514722C0T52@i07D051;3:04710r2523I0770<514722E5142F0T51@>0722G514770514727H61:" #(type-error
   length= princ "type error: " ": expected " caddr ", got " print cadddr
   bounds-error ": index " " out of bounds for " unbound-error "eval: variable "
   " has no value" error "error: " load-error print-exception "in file " list?
--- a/flisp.c
+++ b/flisp.c
@@ -39,8 +39,9 @@
 static uint32_t N_GCHND = 0;
 
 value_t FL_NIL, FL_T, FL_F, FL_EOF, QUOTE;
-value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
+value_t IOError, ParseError, TypeError, ArgError, MemoryError;
 value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
+static value_t UnboundError;
 value_t printwidthsym, printreadablysym, printprettysym, printlengthsym;
 value_t printlevelsym, builtins_table_sym;
 
@@ -170,6 +171,11 @@
     fl_raise(fl_listn(4, BoundsError, symbol(curr_fname), arr, ind));
 }
 
+_Noreturn void unbound_error(value_t sym)
+{
+    fl_raise(fl_listn(3, UnboundError, symbol(curr_fname), sym));
+}
+
 // safe cast operators --------------------------------------------------------
 
 #define isstring fl_isstring
@@ -603,7 +609,7 @@
     else if (isbuiltin(f)) {
         value_t tab = symbol_value(builtins_table_sym);
         if (ptr(tab) == nil)
-            lerrorf(UnboundError, "builtins table");
+            unbound_error(tab);
         Stack[SP-n-1] = vector_elt(tab, uintval(f));
         curr_fname = builtins[uintval(f)].name;
         v = apply_cl(n);
@@ -1056,7 +1062,7 @@
             assert(issymbol(v));
             sym = (symbol_t*)ptr(v);
             if (sym->binding == UNBOUND)
-                fl_raise(fl_list2(UnboundError, v));
+                unbound_error(v);
             PUSH(sym->binding);
             NEXT_OP;
 
--- a/flisp.h
+++ b/flisp.h
@@ -219,8 +219,8 @@
 _Noreturn void fl_raise(value_t e);
 _Noreturn void type_error(char *expected, value_t got);
 _Noreturn void bounds_error(value_t arr, value_t ind);
+_Noreturn void unbound_error(value_t sym);
 extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
-extern value_t UnboundError;
 #define argcount(nargs, c)                                \
     do {                                                  \
         if (__unlikely(nargs != c)) {                     \
--- a/read.c
+++ b/read.c
@@ -692,7 +692,7 @@
         }
         v = symbol_value(sym);
         if (v == UNBOUND)
-            fl_raise(fl_list2(UnboundError, sym));
+            unbound_error(sym);
         return fl_apply(v, POP());
     case TOK_SHARPOPEN:
         return read_vector(label, TOK_CLOSE);
@@ -706,7 +706,7 @@
         if (issymbol(sym)) {
             v = symbol_value(sym);
             if (v == UNBOUND)
-                fl_raise(fl_list2(UnboundError, sym));
+                unbound_error(sym);
             return v;
         }
         return fl_toplevel_eval(sym);
--- a/system.lsp
+++ b/system.lsp
@@ -976,7 +976,7 @@
 	((and (pair? e)
 	      (eq? (car e) 'unbound-error)
 	      (pair? (cdr e)))
-	 (princ "eval: variable " (cadr e) " has no value"))
+	 (princ "eval: variable " (caddr e) " has no value"))
 
 	((and (pair? e)
 	      (eq? (car e) 'error))