Merge branch 'inter-referential-definitions'

codegen.c

@@ -23,6 +23,7 @@ typedef struct analyze_scope {
   int depth;
   bool varg;
   xvect args, locals, captures; /* rest args variable is counted as a local */
+  pic_value defer;
   struct analyze_scope *up;
 } analyze_scope;
 
@@ -159,6 +160,7 @@ push_scope(analyze_state *state, pic_value formals)
     scope->args = args;
     scope->locals = locals;
     scope->captures = captures;
+    scope->defer = pic_nil_value();
 
     state->scope = scope;
 
@@ -258,6 +260,7 @@ define_var(analyze_state *state, pic_sym sym)
 }
 
 static pic_value analyze_node(analyze_state *, pic_value, bool);
+static pic_value analyze_procedure(analyze_state *, pic_value, pic_value, pic_value);
 
 static pic_value
 analyze(analyze_state *state, pic_value obj, bool tailpos)
@@ -281,6 +284,7 @@ analyze(analyze_state *state, pic_value obj, bool tailpos)
 
   pic_gc_arena_restore(pic, ai);
   pic_gc_protect(pic, res);
+  pic_gc_protect(pic, state->scope->defer);
   return res;
 }
 
@@ -327,6 +331,42 @@ analyze_var(analyze_state *state, pic_sym sym)
   }
 }
 
+static pic_value
+analyze_defer(analyze_state *state, pic_value name, pic_value formal, pic_value body)
+{
+  pic_state *pic = state->pic;
+  const pic_sym sNOWHERE = pic_intern_cstr(pic, " nowhere ");
+  pic_value skel;
+
+  skel = pic_list2(pic, pic_sym_value(state->sGREF), pic_sym_value(sNOWHERE));
+
+  pic_push(pic, pic_list4(pic, name, formal, body, skel), state->scope->defer);
+
+  return skel;
+}
+
+static void
+analyze_deferred(analyze_state *state)
+{
+  pic_state *pic = state->pic;
+  pic_value defer, val, name, formal, body, dst;
+
+  pic_for_each (defer, pic_reverse(pic, state->scope->defer)) {
+    name = pic_list_ref(pic, defer, 0);
+    formal = pic_list_ref(pic, defer, 1);
+    body = pic_list_ref(pic, defer, 2);
+    dst = pic_list_ref(pic, defer, 3);
+
+    val = analyze_procedure(state, name, formal, body);
+
+    /* copy */
+    pic_pair_ptr(dst)->car = pic_car(pic, val);
+    pic_pair_ptr(dst)->cdr = pic_cdr(pic, val);
+  }
+
+  state->scope->defer = pic_nil_value();
+}
+
 static pic_value
 analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_value body_exprs)
 {
@@ -353,6 +393,8 @@ analyze_procedure(analyze_state *state, pic_value name, pic_value formals, pic_v
     /* To know what kind of local variables are defined, analyze body at first. */
     body = analyze(state, pic_cons(pic, pic_sym_value(pic->rBEGIN), body_exprs), true);
 
+    analyze_deferred(state);
+
     locals = pic_nil_value();
     for (i = scope->locals.size; i > 0; --i) {
       var = xv_get(&scope->locals, i - 1);
@@ -387,7 +429,7 @@ analyze_lambda(analyze_state *state, pic_value obj)
   formals = pic_list_ref(pic, obj, 1);
   body_exprs = pic_list_tail(pic, obj, 2);
 
-  return analyze_procedure(state, pic_false_value(), formals, body_exprs);
+  return analyze_defer(state, pic_false_value(), formals, body_exprs);
 }
 
 static pic_value
@@ -425,7 +467,7 @@ analyze_define(analyze_state *state, pic_value obj)
     formals = pic_list_ref(pic, pic_list_ref(pic, obj, 2), 1);
     body_exprs = pic_list_tail(pic, pic_list_ref(pic, obj, 2), 2);
 
-    val = analyze_procedure(state, pic_sym_value(sym), formals, body_exprs);
+    val = analyze_defer(state, pic_sym_value(sym), formals, body_exprs);
   } else {
     if (pic_length(pic, obj) != 3) {
       pic_error(pic, "syntax error");
@@ -806,6 +848,8 @@ pic_analyze(pic_state *pic, pic_value obj)
 
   obj = analyze(state, obj, true);
 
+  analyze_deferred(state);
+
   destroy_analyze_state(state);
   return obj;
 }

gc.c

@@ -453,6 +453,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     if (senv->up) {
       gc_mark_object(pic, (struct pic_object *)senv->up);
     }
+    gc_mark(pic, senv->defer);
     break;
   }
   case PIC_TT_LIB: {

include/picrin/macro.h

@@ -12,6 +12,7 @@ extern "C" {
 struct pic_senv {
   PIC_OBJECT_HEADER
   xhash map;
+  pic_value defer;
   struct pic_senv *up;
 };
 

macro.c

@@ -91,6 +91,7 @@ make_identifier(pic_state *pic, pic_sym sym, struct pic_senv *senv)
 }
 
 static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
+static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_senv *);
 
 static pic_value
 macroexpand_symbol(pic_state *pic, pic_sym sym, struct pic_senv *senv)
@@ -123,6 +124,35 @@ macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
   return x;
 }
 
+static pic_value
+macroexpand_defer(pic_state *pic, pic_value expr, struct pic_senv *senv)
+{
+  pic_value skel = pic_list1(pic, pic_none_value()); /* (#<none>) */
+
+  pic_push(pic, pic_cons(pic, expr, skel), senv->defer);
+
+  return skel;
+}
+
+static void
+macroexpand_deferred(pic_state *pic, struct pic_senv *senv)
+{
+  pic_value defer, val, src, dst;
+
+  pic_for_each (defer, pic_reverse(pic, senv->defer)) {
+    src = pic_car(pic, defer);
+    dst = pic_cdr(pic, defer);
+
+    val = macroexpand_lambda(pic, src, senv);
+
+    /* copy */
+    pic_pair_ptr(dst)->car = pic_car(pic, val);
+    pic_pair_ptr(dst)->cdr = pic_cdr(pic, val);
+  }
+
+  senv->defer = pic_nil_value();
+}
+
 static pic_value
 macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
 {
@@ -154,6 +184,8 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
   formal = macroexpand_list(pic, pic_cadr(pic, expr), in);
   body = macroexpand_list(pic, pic_cddr(pic, expr), in);
 
+  macroexpand_deferred(pic, in);
+
   return pic_cons(pic, pic_sym_value(pic->rLAMBDA), pic_cons(pic, formal, body));
 }
 
@@ -280,7 +312,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
         return macroexpand_defsyntax(pic, expr, senv);
       }
       else if (tag == pic->rLAMBDA) {
-        return macroexpand_lambda(pic, expr, senv);
+        return macroexpand_defer(pic, expr, senv);
       }
       else if (tag == pic->rDEFINE) {
         return macroexpand_define(pic, expr, senv);
@@ -336,8 +368,12 @@ pic_macroexpand(pic_state *pic, pic_value expr, struct pic_lib *lib)
   prev = pic->lib;
   pic->lib = lib;
 
+  lib->env->defer = pic_nil_value(); /* the last expansion could fail and leave defer field old */
+
   v = macroexpand(pic, expr, lib->env);
 
+  macroexpand_deferred(pic, lib->env);
+
   pic->lib = prev;
 
 #if DEBUG
@@ -356,6 +392,7 @@ pic_senv_new(pic_state *pic, struct pic_senv *up)
 
   senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
   senv->up = up;
+  senv->defer = pic_nil_value();
   xh_init_int(&senv->map, sizeof(pic_sym));
 
   return senv;