much better stack traces

lisp/core.carp

@@ -19,7 +19,9 @@
                     :OK))))
 
 (defmacro defn (name args body)
-  (list 'def name (list 'fn args body)))
+  (list 'do
+        (list 'def name (list 'fn args body))
+        (list 'meta-set! name :name (str name))))
 
 (defn assert-approx-eq (target x)
   (do

lisp/examples.carp

@@ -51,4 +51,11 @@
       (string-copy "Too short")
       manage-me)))
 
+(defn crash ()
+  (error "bam!"))
 
+(defn crash-soon ()
+  (crash))
+
+(defn soon ()
+  (crash-soon))

out/project.carp

@@ -4,6 +4,7 @@
   (do
     ;;(load-lisp (str carp-dir "lisp/string_array.carp"))
     ;;(load-lisp (str carp-dir "lisp/glfw_test.carp"))
+    (load-lisp (str carp-dir "lisp/examples.carp"))
     nil
     ))
 

src/eval.c

@@ -649,8 +649,27 @@ void eval_list(Obj *env, Obj *o) {
       if(LOG_FUNC_APPLICATION) {
 	printf("evaluating form %s\n", obj_to_string(o)->s);
       }
-      
-      snprintf(function_trace[function_trace_pos], STACK_TRACE_LEN, "%s", obj_to_string(o)->s);
+
+      if(o->meta) {
+	//printf("%s\n", obj_to_string(o->meta)->s);
+	char *func_name = "";
+	Obj *func_name_data = NULL;
+	if(function && function->meta) {
+	  func_name_data = env_lookup(function->meta, obj_new_keyword("name"));
+	}
+	if(func_name_data) {
+	  func_name = obj_to_string_not_prn(func_name_data)->s;
+	} else {
+	  func_name = obj_to_string(function)->s;
+	}
+	int line = env_lookup(o->meta, obj_new_keyword("line"))->i;
+	int pos = env_lookup(o->meta, obj_new_keyword("pos"))->i;
+	char *file = env_lookup(o->meta, obj_new_keyword("file"))->s;
+	snprintf(function_trace[function_trace_pos], STACK_TRACE_LEN, "%-20s %-60s %d:%d", func_name, file, line, pos);
+      }
+      else {
+	snprintf(function_trace[function_trace_pos], STACK_TRACE_LEN, "%s", "no meta data"); // obj_to_string(o)->s);
+      }
       function_trace_pos++;
 
       //printf("apply start: "); obj_print_cout(function); printf("\n");
@@ -744,8 +763,8 @@ Obj *eval(Obj *env, Obj *form) {
   return result;
 }
 
-void eval_text(Obj *env, char *text, bool print) {
-  Obj *forms = read_string(env, text);
+void eval_text(Obj *env, char *text, bool print, Obj *filename) {
+  Obj *forms = read_string(env, text, filename);
   Obj *form = forms;
   stack_push(forms);
   while(form && form->car) {

src/eval.h

@@ -24,6 +24,6 @@ void apply(Obj *function, Obj **args, int arg_count);
 
 Obj *eval(Obj *env, Obj *form);
 void eval_internal(Obj *env, Obj *o);
-void eval_text(Obj *env, char *text, bool print);
+void eval_text(Obj *env, char *text, bool print, Obj *filename);
 
 

src/main.c

@@ -7,7 +7,7 @@ int main() {
   stack_pos = 0;
   shadow_stack_pos = 0;
   env_new_global();
-  eval_text(global_env, "(load-lisp (str (getenv \"CARP_DIR\") \"lisp/boot.carp\"))", false);
+  eval_text(global_env, "(load-lisp (str (getenv \"CARP_DIR\") \"lisp/boot.carp\"))", false, obj_new_string("main.c"));
   pop_stacks_to_zero();
   repl(global_env);  
   assert(obj_total == 0);

src/primops.c

@@ -9,6 +9,13 @@
 #include "eval.h"
 #include "reader.h"
 
+void register_primop(char *name, Primop primop) {
+  Obj *o = obj_new_primop(primop);
+  env_extend(global_env, obj_new_symbol(name), o);
+  o->meta = obj_new_environment(NULL);
+  obj_dict_set(o->meta, obj_new_keyword("name"), obj_new_string(name));
+}
+
 Obj *open_file(const char *filename) {
   assert(filename);
   
@@ -956,7 +963,7 @@ Obj *p_load_lisp(Obj** args, int arg_count) {
   Obj *file_string = open_file(args[0]->s);
   shadow_stack_push(file_string);
   if(file_string->tag == 'S') {
-    Obj *forms = read_string(global_env, file_string->s);
+    Obj *forms = read_string(global_env, file_string->s, args[0]);
     shadow_stack_push(forms);
     Obj *form = forms;
     while(form && form->car) {
@@ -1011,12 +1018,12 @@ Obj *p_unload_dylib(Obj** args, int arg_count) {
 Obj *p_read(Obj** args, int arg_count) {
   //assert_or_return_nil(args[0], "No argument to 'read'.", args[0]);
   //assert_or_return_nil(args[0]->tag == 'S', "'read' must take a string as an argument.", args[0]);
-  Obj *forms = read_string(global_env, args[0]->s);
+  Obj *forms = read_string(global_env, args[0]->s, obj_new_string("p_read"));
   return forms->car;
 }
 
 Obj *p_read_many(Obj** args, int arg_count) {
-  Obj *forms = read_string(global_env, args[0]->s);
+  Obj *forms = read_string(global_env, args[0]->s, obj_new_string("p_read_many"));
   return forms;
 }
 

src/primops.h

@@ -3,7 +3,8 @@
 #include "obj.h"
 
 #define define(name, value) env_extend(global_env, obj_new_symbol(name), value);
-#define register_primop(name, primop) env_extend(global_env, obj_new_symbol(name), obj_new_primop(primop));
+
+void register_primop(char *name, Primop primop);
 
 Obj *p_open_file(Obj** args, int arg_count);
 Obj *p_save_file(Obj** args, int arg_count);

src/reader.c

@@ -54,15 +54,16 @@ void print_read_pos() {
   printf("Line: %d, pos: %d.\n", read_line_nr, read_line_pos);
 }
 
-void set_line_info(Obj *o, int line, int pos) {
+void set_line_info(Obj *o, int line, int pos, Obj *filename) {
   if(!o->meta) {
     o->meta = obj_new_environment(NULL);
   }
   obj_dict_set(o->meta, obj_new_keyword("line"), obj_new_int(line));
   obj_dict_set(o->meta, obj_new_keyword("pos"), obj_new_int(pos));
+  obj_dict_set(o->meta, obj_new_keyword("file"), filename);
 }
 
-Obj *read_internal(Obj *env, char *s) {
+Obj *read_internal(Obj *env, char *s, Obj *filename) {
   skip_whitespace(s);
 
   if(CURRENT == ')' || CURRENT == ']') {
@@ -73,7 +74,7 @@ Obj *read_internal(Obj *env, char *s) {
   }
   else if(CURRENT == '(' || CURRENT == '[') {
     Obj *list = obj_new_cons(NULL, NULL);
-    set_line_info(list, read_line_nr, read_line_pos);
+    set_line_info(list, read_line_nr, read_line_pos, filename);
     Obj *prev = list;
     read_pos++;
     while(1) {
@@ -87,7 +88,7 @@ Obj *read_internal(Obj *env, char *s) {
 	read_pos++;
 	break;
       }
-      Obj *o = read_internal(env, s);
+      Obj *o = read_internal(env, s, filename);
       Obj *new = obj_new_cons(NULL, NULL);
       prev->car = o;
       prev->cdr = new;
@@ -110,7 +111,7 @@ Obj *read_internal(Obj *env, char *s) {
 	read_pos++;
 	break;
       }
-      Obj *key = read_internal(env, s);
+      Obj *key = read_internal(env, s, filename);
 
       if(CURRENT == '}') {
 	printf("Uneven number of forms in dictionary.\n");
@@ -118,7 +119,7 @@ Obj *read_internal(Obj *env, char *s) {
 	return nil;
       }
       
-      Obj *value = read_internal(env, s);
+      Obj *value = read_internal(env, s, filename);
       
       Obj *new = obj_new_cons(NULL, NULL);
       Obj *pair = obj_new_cons(key, value);
@@ -168,7 +169,7 @@ Obj *read_internal(Obj *env, char *s) {
   }
   else if(CURRENT == '\'') {
     read_pos++;
-    Obj *sym = read_internal(env, s);
+    Obj *sym = read_internal(env, s, filename);
     Obj *cons2 = obj_new_cons(sym, nil);
     Obj *cons1 = obj_new_cons(lisp_quote, cons2);
     return cons1;
@@ -183,7 +184,7 @@ Obj *read_internal(Obj *env, char *s) {
     }
     name[i] = '\0';
     Obj *symbol = obj_new_symbol(name);
-    set_line_info(symbol, line, pos);
+    set_line_info(symbol, line, pos, filename);
     return symbol;
   }
   else if(CURRENT == ':') {
@@ -243,14 +244,14 @@ Obj *read_internal(Obj *env, char *s) {
   }
 }
 
-Obj *read_string(Obj *env, char *s) {
+Obj *read_string(Obj *env, char *s, Obj *filename) {
   read_line_nr = 1;
   read_line_pos = 0;
   read_pos = 0;
   Obj *top_forms = NULL;
   Obj *prev = NULL;
   while(s[read_pos] != '\0') {
-    Obj *o = read_internal(env, s);
+    Obj *o = read_internal(env, s, filename);
     Obj *cons = obj_new_cons(NULL, NULL);
     cons->car = o;
     if(!top_forms) {

src/reader.h

@@ -2,4 +2,4 @@
 
 #include "obj.h"
 
-Obj *read_string(Obj *env, char *s);
+Obj *read_string(Obj *env, char *s, Obj *filename);

src/repl.c

@@ -25,7 +25,7 @@ void repl(Obj *env) {
     if(strcmp(input, "q\n") == 0) {
       break;
     }
-    eval_text(env, input, true);
+    eval_text(env, input, true, obj_new_string("repl"));
     pop_stacks_to_zero();
     printf("\n");
     //assert(stack_pos == 0);