remove pic_(minimal|core)_syntactic_env

include/picrin/macro.h

@@ -37,8 +37,6 @@ struct pic_sc {
 #define pic_senv_ptr(v) ((struct pic_senv *)pic_ptr(v))
 
 struct pic_senv *pic_null_syntactic_env(pic_state *);
-struct pic_senv *pic_minimal_syntactic_env(pic_state *);
-struct pic_senv *pic_core_syntactic_env(pic_state *);
 
 pic_sym pic_add_rename(pic_state *, struct pic_senv *, pic_sym);
 bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym, pic_sym * /* = NULL */);

src/init.c

@@ -85,14 +85,21 @@ pic_init_core(pic_state *pic)
   pic_deflibrary ("(scheme base)") {
 
     /* load core syntaces */
-    pic->lib->senv = pic_core_syntactic_env(pic);
+    pic->lib->senv = pic_null_syntactic_env(pic);
-    pic_export(pic, pic_intern_cstr(pic, "define"));
+    pic_put_rename(pic, pic->lib->senv, pic->sDEFINE, pic->sDEFINE);
-    pic_export(pic, pic_intern_cstr(pic, "set!"));
+    pic_put_rename(pic, pic->lib->senv, pic->sSETBANG, pic->sSETBANG);
-    pic_export(pic, pic_intern_cstr(pic, "quote"));
+    pic_put_rename(pic, pic->lib->senv, pic->sQUOTE, pic->sQUOTE);
-    pic_export(pic, pic_intern_cstr(pic, "lambda"));
+    pic_put_rename(pic, pic->lib->senv, pic->sLAMBDA, pic->sLAMBDA);
-    pic_export(pic, pic_intern_cstr(pic, "if"));
+    pic_put_rename(pic, pic->lib->senv, pic->sIF, pic->sIF);
-    pic_export(pic, pic_intern_cstr(pic, "begin"));
+    pic_put_rename(pic, pic->lib->senv, pic->sBEGIN, pic->sBEGIN);
-    pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
+    pic_put_rename(pic, pic->lib->senv, pic->sDEFINE_SYNTAX, pic->sDEFINE_SYNTAX);
+    pic_export(pic, pic->sDEFINE);
+    pic_export(pic, pic->sSETBANG);
+    pic_export(pic, pic->sQUOTE);
+    pic_export(pic, pic->sLAMBDA);
+    pic_export(pic, pic->sIF);
+    pic_export(pic, pic->sBEGIN);
+    pic_export(pic, pic->sDEFINE_SYNTAX);
 
     pic_init_bool(pic); DONE;
     pic_init_pair(pic); DONE;

src/lib.c

@@ -24,7 +24,7 @@ pic_make_library(pic_state *pic, pic_value name)
     return lib;
   }
 
-  senv = pic_minimal_syntactic_env(pic);
+  senv = pic_null_syntactic_env(pic);
 
   lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
   lib->senv = senv;

src/macro.c

@@ -20,14 +20,6 @@ pic_null_syntactic_env(pic_state *pic)
   senv->up = NULL;
   xh_init_int(&senv->renames, sizeof(pic_sym));
 
-  return senv;
-}
-
-struct pic_senv *
-pic_minimal_syntactic_env(pic_state *pic)
-{
-  struct pic_senv *senv = pic_null_syntactic_env(pic);
-
   pic_put_rename(pic, senv, pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY);
   pic_put_rename(pic, senv, pic->sIMPORT, pic->sIMPORT);
   pic_put_rename(pic, senv, pic->sEXPORT, pic->sEXPORT);
@@ -35,57 +27,6 @@ pic_minimal_syntactic_env(pic_state *pic)
   return senv;
 }
 
-struct pic_senv *
-pic_core_syntactic_env(pic_state *pic)
-{
-  struct pic_senv *senv = pic_minimal_syntactic_env(pic);
-
-  pic_put_rename(pic, senv, pic->sDEFINE, pic->sDEFINE);
-  pic_put_rename(pic, senv, pic->sSETBANG, pic->sSETBANG);
-  pic_put_rename(pic, senv, pic->sQUOTE, pic->sQUOTE);
-  pic_put_rename(pic, senv, pic->sLAMBDA, pic->sLAMBDA);
-  pic_put_rename(pic, senv, pic->sIF, pic->sIF);
-  pic_put_rename(pic, senv, pic->sBEGIN, pic->sBEGIN);
-  pic_put_rename(pic, senv, pic->sDEFINE_SYNTAX, pic->sDEFINE_SYNTAX);
-
-  return senv;
-}
-
-static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *, pic_value);
-
-static struct pic_senv *
-push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value assoc_box)
-{
-  struct pic_senv *senv;
-  pic_value a;
-
-  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
-  senv->up = up;
-  xh_init_int(&senv->renames, sizeof(pic_sym));
-
-  for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
-    pic_value v = pic_car(pic, a);
-
-    if (! pic_sym_p(v)) {
-      v = macroexpand(pic, v, up, assoc_box);
-    }
-    if (! pic_sym_p(v)) {
-      pic_error(pic, "syntax error");
-    }
-    pic_add_rename(pic, senv, pic_sym(v));
-  }
-  if (! pic_sym_p(a)) {
-    a = macroexpand(pic, a, up, assoc_box);
-  }
-  if (pic_sym_p(a)) {
-    pic_add_rename(pic, senv, pic_sym(a));
-  }
-  else if (! pic_nil_p(a)) {
-    pic_error(pic, "syntax error");
-  }
-  return senv;
-}
-
 pic_sym
 pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym sym)
 {
@@ -209,6 +150,39 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv, pic_value ass
   return v;
 }
 
+static struct pic_senv *
+push_scope(pic_state *pic, pic_value formals, struct pic_senv *up, pic_value assoc_box)
+{
+  struct pic_senv *senv;
+  pic_value a;
+
+  senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
+  senv->up = up;
+  xh_init_int(&senv->renames, sizeof(pic_sym));
+
+  for (a = formals; pic_pair_p(a); a = pic_cdr(pic, a)) {
+    pic_value v = pic_car(pic, a);
+
+    if (! pic_sym_p(v)) {
+      v = macroexpand(pic, v, up, assoc_box);
+    }
+    if (! pic_sym_p(v)) {
+      pic_error(pic, "syntax error");
+    }
+    pic_add_rename(pic, senv, pic_sym(v));
+  }
+  if (! pic_sym_p(a)) {
+    a = macroexpand(pic, a, up, assoc_box);
+  }
+  if (pic_sym_p(a)) {
+    pic_add_rename(pic, senv, pic_sym(a));
+  }
+  else if (! pic_nil_p(a)) {
+    pic_error(pic, "syntax error");
+  }
+  return senv;
+}
+
 static pic_value
 macroexpand_list(pic_state *pic, pic_value list, struct pic_senv *senv, pic_value assoc_box)
 {