Add lineno and filename to pair objects.

src/error.c

@@ -28,11 +28,43 @@ extern li_object *li_stack_trace(void)
     return stack;
 }
 
+static int get_metadata(li_object *expr, const char **filename, int *lineno)
+{
+    li_pair_t *p;
+    if (!li_is_pair(expr))
+        return 0;
+    p = (li_pair_t *)expr;
+    if (p->lineno) {
+        *filename = p->filename;
+        *lineno = p->lineno;
+        return 1;
+    }
+    return get_metadata(li_cdr(expr), filename, lineno);
+}
+
+static void print_stack_trace(void)
+{
+    stack = li_list_reverse(stack);
+    fprintf(stderr, "Error:\n");
+    while (stack) {
+        li_object *expr = li_cadr(li_car(stack));
+        const char *filename;
+        int lineno;
+        if (get_metadata(expr, &filename, &lineno))
+            fprintf(stderr, "  File \"%s\", line %d\n", filename, lineno);
+        li_port_printf(li_port_stderr, "    ");
+        li_port_write(li_port_stderr, expr);
+        li_newline(li_port_stderr);
+        stack = li_cdr(stack);
+    }
+}
+
 extern void li_error_fmt(const char *msg, ...)
 {
     va_list ap;
     int ch;
     va_start(ap, msg);
+    print_stack_trace();
     fprintf(stderr, "; ERROR: ");
     while ((ch = *msg++)) {
         switch (ch) {
@@ -56,12 +88,6 @@ extern void li_error_fmt(const char *msg, ...)
     }
     va_end(ap);
     li_newline(li_port_stderr);
-    while (stack) {
-        li_port_printf(li_port_stderr, "\t");
-        li_port_write(li_port_stderr, li_cadr(li_car(stack)));
-        li_newline(li_port_stderr);
-        stack = li_cdr(stack);
-    }
     longjmp(buf, 1);
 }
 

src/lexer.l

@@ -9,7 +9,7 @@
 #include "read.h"
 
 static void bufappend(const char *s);
-extern int fileno(FILE *);
+extern const char *yyfilename;
 
 static struct {
     char *buf;
@@ -123,6 +123,8 @@ extern int push_buffer(li_port_t *port)
 
 extern void li_load(char *filename, li_env_t *env)
 {
+    const char *old_filename;
+    int old_line;
     char cwd[PATH_MAX];
     li_object *exp;
     li_port_t *port;
@@ -131,6 +133,10 @@ extern void li_load(char *filename, li_env_t *env)
     getcwd(cwd, PATH_MAX);
     chdir(dirname(filename));
     pop = push_buffer(port);
+    old_filename = yyfilename;
+    old_line = yylineno;
+    yyfilename = filename;
+    yylineno = 1;
     while ((exp = li_read(port)) != li_eof) {
         /* li_port_printf(li_port_stderr, "> "); */
         /* li_write(exp, li_port_stderr); */
@@ -142,6 +148,8 @@ extern void li_load(char *filename, li_env_t *env)
             /* li_newline(li_port_stderr); */
         }
     }
+    yyfilename = old_filename;
+    yylineno = old_line;
     if (pop)
         yypop_buffer_state();
     li_port_close(port);

src/li.h

@@ -147,6 +147,8 @@ struct li_pair_t {
     LI_OBJ_HEAD;
     li_object *car;
     li_object *cdr;
+    const char *filename;
+    int lineno;
 };
 
 /* Procedures */
@@ -274,6 +276,8 @@ extern li_bool_t li_is_list(li_object *obj);
 /** List accessors. */
 extern int li_length(li_object *obj);
 
+extern li_object *li_list_reverse(li_object *lst);
+
 /** Type casting. */
 #define li_chr_uint(obj)                ((li_character_obj_t *)(obj))->character
 #define li_to_character(obj)            li_chr_uint(obj)
@@ -359,6 +363,7 @@ extern void li_port_display(li_port_t *port, li_object *obj);
 extern void li_port_printf(li_port_t *port, const char *fmt, ...);
 
 extern FILE *li_port_fp(li_port_t *port);
+extern const char *li_port_name(li_port_t *port);
 
 #define li_write(obj, port)             li_port_write(port, obj)
 #define li_display(obj, port)           li_port_display(port, obj)

src/pair.c

@@ -69,6 +69,8 @@ extern li_pair_t *li_pair(li_object *car, li_object *cdr)
     li_object_init((li_object *)obj, &li_type_pair);
     obj->car = car;
     obj->cdr = cdr;
+    obj->filename = NULL;
+    obj->lineno = 0;
     return obj;
 }
 
@@ -95,6 +97,16 @@ extern li_bool_t li_is_list(li_object *obj)
     return LI_TRUE;
 }
 
+extern li_object *li_list_reverse(li_object *lst)
+{
+    li_object *tsl = NULL;
+    while (lst) {
+        tsl = li_cons(li_car(lst), tsl);
+        lst = li_cdr(lst);
+    }
+    return tsl;
+}
+
 /*
  * (pair? obj)
  * Returns #t if the object is a pair, #f otherwise.

src/port.c

@@ -23,6 +23,13 @@ struct li_port_t {
     li_str_t *name;
 };
 
+extern const char *li_port_name(li_port_t *port)
+{
+    if (port->name)
+        return li_string_bytes(port->name);
+    return NULL;
+}
+
 extern FILE *li_port_fp(li_port_t *port)
 {
     if (!port->fp) {

src/procedure.c

@@ -189,16 +189,6 @@ extern li_object *li_apply(li_object *proc, li_object *args) {
     return li_eval(li_cons(proc, head), li_proc_env(proc));
 }
 
-static li_object *reverse(li_object *lst)
-{
-    li_object *tsl = NULL;
-    while (lst) {
-        tsl = li_cons(li_car(lst), tsl);
-        lst = li_cdr(lst);
-    }
-    return tsl;
-}
-
 static int contains(li_object *lst, li_object *obj)
 {
     if (lst == obj)
@@ -259,7 +249,7 @@ static li_object *unwind(li_object *stack, li_object *karg)
     li_env_t *env;
     li_object *expr;
     (void)print_stack;
-    stack = reverse(stack);
+    stack = li_list_reverse(stack);
     /* print_stack(stack); */
     li_parse_args(li_car(stack), "eo", &env, &expr);
     stack = replace(env, expr, li_cdr(stack), karg);

src/read.y

@@ -3,7 +3,8 @@
 #include "li.h"
 #include "li_num.h"
 
-#define make_tagged_list(str, obj)  li_cons(li_symbol(str), li_cons(obj, NULL))
+#define make_tagged_list(str, obj) \
+    cons((li_object *)li_symbol(str), cons(obj, NULL))
 
 static void yyerror(char *s);
 extern int yylex(void);
@@ -12,8 +13,10 @@ extern void yypop_buffer_state(void);
 
 extern int push_buffer(li_port_t *port);
 static li_object *append(li_object *lst, li_object *obj);
+static li_object *cons(li_object *car, li_object *cdr);
 
 static li_object *obj = NULL;
+const char *yyfilename = NULL;
 
 %}
 
@@ -43,7 +46,7 @@ datum   : EOF_OBJECT { $$ = li_eof; }
         | SYMBOL { $$ = $1; }
         /* lists */
         | '(' data ')' { $$ = $2; }
-        | '(' data datum '.' datum ')' { $$ = append($2, li_cons($3, $5)); }
+        | '(' data datum '.' datum ')' { $$ = append($2, cons($3, $5)); }
         /* vectors */
         | '[' data ']' { $$ = li_vector($2); }
         /* bytevectors */
@@ -56,11 +59,19 @@ datum   : EOF_OBJECT { $$ = li_eof; }
         ;
 
 data    : { $$ = NULL; }
-        | data datum { $$ = append($1, li_cons($2, NULL)); }
+        | data datum { $$ = append($1, cons($2, NULL)); }
         ;
 
 %%
 
+static li_object *cons(li_object *car, li_object *cdr)
+{
+    li_pair_t *pair = (li_pair_t *)li_pair(car, cdr);
+    pair->lineno = yylineno;
+    pair->filename = yyfilename;
+    return (li_object *)pair;
+}
+
 static li_object *append(li_object *lst, li_object *obj)
 {
     li_object *tail = lst;

src/string.c

@@ -218,16 +218,6 @@ static li_object *p_string_to_symbol(li_object *args) {
     return (li_object *)li_symbol(li_string_bytes(str));
 }
 
-static li_object *li_list_reverse(li_object *lst)
-{
-    li_object *tsl = NULL;
-    while (lst) {
-        tsl = li_cons(li_car(lst), tsl);
-        lst = li_cdr(lst);
-    }
-    return tsl;
-}
-
 static li_object *p_string_split(li_object *args)
 {
     li_object *res = NULL;