eval.c closures are now applicable smobs, not tc3s

* libguile/debug.c (scm_procedure_name): Remove a SCM_CLOSUREP case and
  some dead code.
  (scm_procedure_module): Remove. This was introduced a few months ago
  for the hygienic expander, but now it is no longer needed, as the
  expander keeps track of this information itself.

* libguile/debug.h: Remove scm_procedure_module.

* libguile/eval.c: Instead of using tc3 closures, define a "boot
  closure" applicable smob type, and represent closures with that. The
  advantage is that after eval.scm is compiled, boot closures take up no
  address space (besides a smob number) in the runtime, and require no
  special cases in procedure dispatch.

* libguile/eval.h: Remove the internal functions scm_i_call_closure_0
  and scm_closure_apply, and the public function scm_closure.

* libguile/gc.c (scm_storage_prehistory): No tc3_closure displacement
  registration.
  (scm_i_tag_name): Remove closure case, and a dead cclo case.

* libguile/vm.c (apply_foreign):
* libguile/print.c (iprin1):
* libguile/procs.c (scm_procedure_p, scm_procedure_documentation);
* libguile/evalext.c (scm_self_evaluating_p):
* libguile/goops.c (scm_class_of): Remove tc3_closure/tcs_closure cases.
* libguile/hash.c (scm_hasher):

* libguile/hooks.c (scm_add_hook_x): Use new scm_i_procedure_arity.

* libguile/macros.c (macro_print): Print all macros using the same code.
  (scm_macro_transformer): Return any procedure, not just programs.

* libguile/procprop.h:
* libguile/procprop.c (scm_i_procedure_arity): Instead of returning a
  list that the caller has to parse, have the same prototype as
  scm_i_program_arity. An incompatible change, but it's an internal
  function anyway.
  (scm_procedure_properties, scm_set_procedure_properties)
  (scm_procedure_property, scm_set_procedure_property): Remove closure
  cases, and use scm_i_program_arity for arity.

* libguile/procs.h (SCM_CLOSUREP, SCM_CLOSCAR, SCM_CODE)
  (SCM_CLOSURE_NUM_REQUIRED_ARGS, SCM_CLOSURE_HAS_REST_ARGS)
  (SCM_CLOSURE_BODY, SCM_PROCPROPS, SCM_SETPROCPROPS, SCM_ENV)
  (SCM_TOP_LEVEL): Remove these macros that pertain to boot closures
  only. Only eval.c should know abut boot closures.
* libguile/procs.c (scm_closure_p): Remove this function. There is a
  simple stub in deprecated.scm now.
  (scm_thunk_p): Use scm_i_program_arity.
* libguile/tags.h (scm_tc3_closure): Remove. Yay, another tc3 to play
  with!
  (scm_tcs_closures): Remove.

* libguile/validate.h (SCM_VALIDATE_CLOSURE): Remove.

* module/ice-9/deprecated.scm (closure?): Add stub.

* module/ice-9/documentation.scm (object-documentation)
* module/ice-9/session.scm (help-doc, arity)
* module/oop/goops.scm (compute-getters-n-setters)
* module/oop/goops/describe.scm (describe)
* module/system/repl/describe.scm (display-object, display-type):
  Remove calls to closure?.

18 files changed, 170 insertions, 335 deletions

diff --git a/libguile/debug.c b/libguile/debug.c
index 0310ffbe1..b220efd8b 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -143,14 +143,6 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
   default:
     {
       SCM name = scm_procedure_property (proc, scm_sym_name);
-#if 0
-      /* Source property scm_sym_procname not implemented yet... */
-      SCM name = scm_source_property (SCM_CAR (SCM_CLOSURE_BODY (proc)), scm_sym_procname);
-      if (scm_is_false (name))
-	name = scm_procedure_property (proc, scm_sym_name);
-#endif
-      if (scm_is_false (name) && SCM_CLOSUREP (proc))
-	name = scm_reverse_lookup (SCM_ENV (proc), proc);
       if (scm_is_false (name) && SCM_PROGRAM_P (proc))
         name = scm_program_name (proc);
       return name;
@@ -193,27 +185,6 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_procedure_module, "procedure-module", 1, 0, 0, 
-           (SCM proc),
-	    "Return the module that was current when @var{proc} was defined.")
-#define FUNC_NAME s_scm_procedure_module
-{
-  SCM_VALIDATE_PROC (SCM_ARG1, proc);
-
-  if (scm_is_true (scm_program_p (proc)))
-    return scm_program_module (proc);
-  else if (SCM_CLOSUREP (proc))
-    {
-      SCM env = SCM_ENV (proc);
-      while (scm_is_pair (env))
-        env = scm_cdr (env);
-      return env;
-    }
-  else
-    return SCM_BOOL_F;
-}
-#undef FUNC_NAME
-
 
 
 
diff --git a/libguile/debug.h b/libguile/debug.h
index 2ca0b529a..6a1ee5a61 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -43,7 +43,6 @@ typedef union scm_t_debug_info
 
 SCM_API SCM scm_reverse_lookup (SCM env, SCM data);
 SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk);
-SCM_API SCM scm_procedure_module (SCM proc);
 SCM_API SCM scm_procedure_source (SCM proc);
 SCM_API SCM scm_procedure_name (SCM proc);
 SCM_API SCM scm_with_traps (SCM thunk);
diff --git a/libguile/eval.c b/libguile/eval.c
index b68c0ca82..4525e4faa 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -97,6 +97,21 @@
 */
 
 
+/* Boot closures. We only see these when compiling eval.scm, because once
+   eval.scm is in the house, closures are standard VM closures.
+ */
+
+static scm_t_bits scm_tc16_boot_closure;
+#define RETURN_BOOT_CLOSURE(code, env) SCM_RETURN_NEWSMOB2 (scm_tc16_boot_closure, (code), (env))
+#define BOOT_CLOSURE_P(obj) SCM_TYP16_PREDICATE (scm_tc16_boot_closure, (obj))
+#define BOOT_CLOSURE_CODE(x) SCM_SMOB_OBJECT (x)
+#define BOOT_CLOSURE_ENV(x) SCM_SMOB_OBJECT_2 (x)
+#define BOOT_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (CAR (BOOT_CLOSURE_CODE (x)))
+#define BOOT_CLOSURE_HAS_REST_ARGS(x) scm_is_true (CADR (BOOT_CLOSURE_CODE (x)))
+#define BOOT_CLOSURE_BODY(x) CDDR (BOOT_CLOSURE_CODE (x))
+
+
+
 #if 0
 #define CAR(x)   SCM_CAR(x)
 #define CDR(x)   SCM_CDR(x)
@@ -192,7 +207,7 @@ eval (SCM x, SCM env)
       }
           
     case SCM_M_LAMBDA:
-      return scm_closure (mx, CAPTURE_ENV (env));
+      RETURN_BOOT_CLOSURE (mx, CAPTURE_ENV (env));
 
     case SCM_M_QUOTE:
       return mx;
@@ -210,11 +225,11 @@ eval (SCM x, SCM env)
     apply_proc:
       /* Go here to tail-apply a procedure.  PROC is the procedure and
        * ARGS is the list of arguments. */
-      if (SCM_CLOSUREP (proc))
+      if (BOOT_CLOSURE_P (proc))
         {
-          int nreq = SCM_CLOSURE_NUM_REQUIRED_ARGS (proc);
-          SCM new_env = SCM_ENV (proc);
-          if (SCM_CLOSURE_HAS_REST_ARGS (proc))
+          int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
+          SCM new_env = BOOT_CLOSURE_ENV (proc);
+          if (BOOT_CLOSURE_HAS_REST_ARGS (proc))
             {
               if (SCM_UNLIKELY (scm_ilength (args) < nreq))
                 scm_wrong_num_args (proc);
@@ -229,7 +244,7 @@ eval (SCM x, SCM env)
               for (; scm_is_pair (args); args = CDR (args))
                 new_env = scm_cons (CAR (args), new_env);
             }
-          x = SCM_CLOSURE_BODY (proc);
+          x = BOOT_CLOSURE_BODY (proc);
           env = new_env;
           goto loop;
         }
@@ -242,11 +257,11 @@ eval (SCM x, SCM env)
           
       mx = CDR (mx);
 
-      if (SCM_CLOSUREP (proc))
+      if (BOOT_CLOSURE_P (proc))
         {
-          int nreq = SCM_CLOSURE_NUM_REQUIRED_ARGS (proc);
-          SCM new_env = SCM_ENV (proc);
-          if (SCM_CLOSURE_HAS_REST_ARGS (proc))
+          int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
+          SCM new_env = BOOT_CLOSURE_ENV (proc);
+          if (BOOT_CLOSURE_HAS_REST_ARGS (proc))
             {
               if (SCM_UNLIKELY (scm_ilength (mx) < nreq))
                 scm_wrong_num_args (proc);
@@ -267,7 +282,7 @@ eval (SCM x, SCM env)
               if (SCM_UNLIKELY (nreq != 0))
                 scm_wrong_num_args (proc);
             }
-          x = SCM_CLOSURE_BODY (proc);
+          x = BOOT_CLOSURE_BODY (proc);
           env = new_env;
           goto loop;
         }
@@ -390,42 +405,6 @@ eval (SCM x, SCM env)
     }
 }
 
-SCM
-scm_closure_apply (SCM proc, SCM args)
-{
-  unsigned int nargs;
-  int nreq;
-  SCM env;
-
-  /* Args contains a list of all args. */
-  {
-    int ilen = scm_ilength (args);
-    if (ilen < 0)
-      scm_wrong_num_args (proc);
-    nargs = ilen;
-  }
-
-  nreq = SCM_CLOSURE_NUM_REQUIRED_ARGS (proc);
-  env = SCM_ENV (proc);
-  if (SCM_CLOSURE_HAS_REST_ARGS (proc))
-    {
-      if (SCM_UNLIKELY (scm_ilength (args) < nreq))
-        scm_wrong_num_args (proc);
-      for (; nreq; nreq--, args = CDR (args))
-        env = scm_cons (CAR (args), env);
-      env = scm_cons (args, env);
-    }
-  else
-    {
-      for (; scm_is_pair (args); args = CDR (args), nreq--)
-        env = scm_cons (CAR (args), env);
-      if (SCM_UNLIKELY (nreq != 0))
-        scm_wrong_num_args (proc);
-    }
-  return eval (SCM_CLOSURE_BODY (proc), env);
-}
-
-
 scm_t_option scm_eval_opts[] = {
   { SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." },
   { 0 }
@@ -814,18 +793,6 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
 #undef FUNC_NAME
 
 
-SCM 
-scm_closure (SCM code, SCM env)
-{
-  SCM z;
-  SCM closcar = scm_cons (code, SCM_EOL);
-  z = scm_immutable_cell (SCM_UNPACK (closcar) + scm_tc3_closure,
-			  (scm_t_bits) env);
-  scm_remember_upto_here (closcar);
-  return z;
-}
-
-
 static SCM
 scm_c_primitive_eval (SCM exp)
 {
@@ -907,6 +874,45 @@ scm_apply (SCM proc, SCM arg1, SCM args)
 }
 
 
+static SCM
+boot_closure_apply (SCM closure, SCM args)
+{
+  int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure);
+  SCM new_env = BOOT_CLOSURE_ENV (closure);
+  if (BOOT_CLOSURE_HAS_REST_ARGS (closure))
+    {
+      if (SCM_UNLIKELY (scm_ilength (args) < nreq))
+        scm_wrong_num_args (closure);
+      for (; nreq; nreq--, args = CDR (args))
+        new_env = scm_cons (CAR (args), new_env);
+      new_env = scm_cons (args, new_env);
+    }
+  else
+    {
+      if (SCM_UNLIKELY (scm_ilength (args) != nreq))
+        scm_wrong_num_args (closure);
+      for (; scm_is_pair (args); args = CDR (args))
+        new_env = scm_cons (CAR (args), new_env);
+    }
+  return eval (BOOT_CLOSURE_BODY (closure), new_env);
+}
+
+static int
+boot_closure_print (SCM closure, SCM port, scm_print_state *pstate)
+{
+  SCM args;
+  scm_puts ("#<boot-closure ", port);
+  scm_uintprint ((unsigned long)SCM2PTR (closure), 16, port);
+  scm_putc (' ', port);
+  args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure)),
+                        scm_from_locale_symbol ("_"));
+  if (BOOT_CLOSURE_HAS_REST_ARGS (closure))
+    args = scm_cons_star (scm_from_locale_symbol ("_"), args);
+  scm_display (args, port);
+  scm_putc ('>', port);
+  return 1;
+}
+
 void 
 scm_init_eval ()
 {
@@ -922,6 +928,10 @@ scm_init_eval ()
   f_apply = scm_c_define_gsubr ("apply", 2, 0, 1, scm_apply);
   scm_permanent_object (f_apply);
 
+  scm_tc16_boot_closure = scm_make_smob_type ("boot-closure", 0);
+  scm_set_smob_apply (scm_tc16_boot_closure, boot_closure_apply, 0, 0, 1);
+  scm_set_smob_print (scm_tc16_boot_closure, boot_closure_print);
+
   primitive_eval = scm_c_make_gsubr ("primitive-eval", 1, 0, 0,
                                      scm_c_primitive_eval);
   var_primitive_eval = scm_define (SCM_SUBR_NAME (primitive_eval),
diff --git a/libguile/eval.h b/libguile/eval.h
index 62b84c11b..6341f14b4 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -73,14 +73,11 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args);
 SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args);
 SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args);
-SCM_INTERNAL SCM scm_i_call_closure_0 (SCM proc);
 SCM_API SCM scm_nconc2last (SCM lst);
 SCM_API SCM scm_apply (SCM proc, SCM arg1, SCM args);
-SCM_INTERNAL SCM scm_closure_apply (SCM proc, SCM args);
 #define scm_dapply(proc,arg1,args) scm_apply (proc, arg1, args)
 SCM_API SCM scm_map (SCM proc, SCM arg1, SCM args);
 SCM_API SCM scm_for_each (SCM proc, SCM arg1, SCM args);
-SCM_API SCM scm_closure (SCM code, SCM env);
 SCM_API SCM scm_primitive_eval (SCM exp);
 #define scm_primitive_eval_x(exp) scm_primitive_eval (exp)
 SCM_API SCM scm_eval (SCM exp, SCM module);
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 1d5aa9319..27dd98506 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -75,7 +75,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
     case scm_tc3_cons:
       switch (SCM_TYP7 (obj))
 	{
-	case scm_tcs_closures:
 	case scm_tc7_vector:
 	case scm_tc7_wvect:
 	case scm_tc7_number:
diff --git a/libguile/gc.c b/libguile/gc.c
index 15f424ab3..6a702507c 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -631,7 +631,7 @@ scm_storage_prehistory ()
      pointer to an 8-octet aligned region).  For `scm_tc3_struct', this is
      handled in `scm_alloc_struct ()'.  */
   GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
-  GC_REGISTER_DISPLACEMENT (scm_tc3_closure);
+  /* GC_REGISTER_DISPLACEMENT (scm_tc3_unused); */
 
   /* Sanity check.  */
   if (!GC_is_visible (scm_sys_protects))
@@ -754,18 +754,12 @@ scm_i_tag_name (scm_t_bits tag)
       return "cons (immediate car)";
     case scm_tcs_cons_nimcar:
       return "cons (non-immediate car)";
-    case scm_tcs_closures:
-      return "closures";
     case scm_tc7_pws:
       return "pws";
     case scm_tc7_wvect:
       return "weak vector";
     case scm_tc7_vector:
       return "vector";
-#ifdef CCLO
-    case scm_tc7_cclo:
-      return "compiled closure";
-#endif
     case scm_tc7_number:
       switch (tag)
 	{
diff --git a/libguile/goops.c b/libguile/goops.c
index 76ca14b28..f6b18ace5 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -205,8 +205,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	{
 	case scm_tcs_cons_nimcar:
 	  return scm_class_pair;
-	case scm_tcs_closures:
-	  return scm_class_procedure;
 	case scm_tc7_symbol:
 	  return scm_class_symbol;
 	case scm_tc7_vector:
@@ -292,7 +290,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
     case scm_tc3_struct:
     case scm_tc3_tc7_1:
     case scm_tc3_tc7_2:
-    case scm_tc3_closure:
+      /* case scm_tc3_unused: */
       /* Never reached */
       break;
     }
diff --git a/libguile/hash.c b/libguile/hash.c
index e352b1c25..e56fab0b6 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -169,7 +169,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
       else return 1;
     case scm_tc7_port:
       return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
-    case scm_tcs_closures: 
+      /* case scm_tcs_closures: */
     case scm_tc7_gsubr:
       return 262 % n;
     }
diff --git a/libguile/hooks.c b/libguile/hooks.c
index c6541fadd..d7bf018be 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -203,16 +203,13 @@ SCM_DEFINE (scm_add_hook_x, "add-hook!", 2, 1, 0,
 	    "procedure is not specified.")
 #define FUNC_NAME s_scm_add_hook_x
 {
-  SCM arity, rest;
-  int n_args;
+  SCM rest;
+  int n_args, p_req, p_opt, p_rest;
   SCM_VALIDATE_HOOK (1, hook);
-  SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (proc)),
+  SCM_ASSERT (scm_i_procedure_arity (proc, &p_req, &p_opt, &p_rest),
 	      proc, SCM_ARG2, FUNC_NAME);
   n_args = SCM_HOOK_ARITY (hook);
-  if (scm_to_int (SCM_CAR (arity)) > n_args
-      || (scm_is_false (SCM_CADDR (arity))
-	  && (scm_to_int (SCM_CAR (arity)) + scm_to_int (SCM_CADR (arity))
-	      < n_args)))
+  if (p_req > n_args || (!p_rest && p_req + p_opt < n_args))
     scm_wrong_type_arg (FUNC_NAME, 2, proc);
   rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook));
   SCM_SET_HOOK_PROCEDURES (hook,
diff --git a/libguile/macros.c b/libguile/macros.c
index d7c054e72..0d714000c 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -46,46 +46,42 @@ static int
 macro_print (SCM macro, SCM port, scm_print_state *pstate)
 {
   SCM code = SCM_MACRO_CODE (macro);
-  if (!SCM_CLOSUREP (code)
-      || scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE))
-      || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
-					macro, port, pstate)))
-    {
-      scm_puts ("#<", port);
 
-      if (SCM_MACRO_TYPE (macro) < 4 && SCM_MACRO_IS_EXTENDED (macro))
-	scm_puts ("extended-", port);
+  scm_puts ("#<", port);
+
+  if (SCM_MACRO_TYPE (macro) < 4 && SCM_MACRO_IS_EXTENDED (macro))
+    scm_puts ("extended-", port);
 
-      if (!SCM_CLOSUREP (code) && !SCM_PROGRAM_P (code))
-	scm_puts ("primitive-", port);
+  /* FIXME: doesn't catch boot closures; but do we care? */
+  if (!SCM_PROGRAM_P (code))
+    scm_puts ("primitive-", port);
 
-      if (SCM_MACRO_TYPE (macro) == 0)
-	scm_puts ("syntax", port);
+  if (SCM_MACRO_TYPE (macro) == 0)
+    scm_puts ("syntax", port);
 #if SCM_ENABLE_DEPRECATED == 1
-      if (SCM_MACRO_TYPE (macro) == 1)
-	scm_puts ("macro", port);
+  if (SCM_MACRO_TYPE (macro) == 1)
+    scm_puts ("macro", port);
 #endif
-      if (SCM_MACRO_TYPE (macro) == 2)
-	scm_puts ("macro!", port);
-      if (SCM_MACRO_TYPE (macro) == 3)
-	scm_puts ("builtin-macro!", port);
-      if (SCM_MACRO_TYPE (macro) == 4)
-	scm_puts ("syncase-macro", port);
-
-      scm_putc (' ', port);
-      scm_iprin1 (scm_macro_name (macro), port, pstate);
+  if (SCM_MACRO_TYPE (macro) == 2)
+    scm_puts ("macro!", port);
+  if (SCM_MACRO_TYPE (macro) == 3)
+    scm_puts ("builtin-macro!", port);
+  if (SCM_MACRO_TYPE (macro) == 4)
+    scm_puts ("syncase-macro", port);
 
-      if (SCM_MACRO_IS_EXTENDED (macro))
-        {
-          scm_putc (' ', port);
-          scm_write (SCM_SMOB_OBJECT_2 (macro), port);
-          scm_putc (' ', port);
-          scm_write (SCM_SMOB_OBJECT_3 (macro), port);
-        }
+  scm_putc (' ', port);
+  scm_iprin1 (scm_macro_name (macro), port, pstate);
 
-      scm_putc ('>', port);
+  if (SCM_MACRO_IS_EXTENDED (macro))
+    {
+      scm_putc (' ', port);
+      scm_write (SCM_SMOB_OBJECT_2 (macro), port);
+      scm_putc (' ', port);
+      scm_write (SCM_SMOB_OBJECT_3 (macro), port);
     }
 
+  scm_putc ('>', port);
+
   return 1;
 }
 
@@ -273,7 +269,7 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0,
   SCM_VALIDATE_SMOB (1, m, macro);
   data = SCM_PACK (SCM_SMOB_DATA (m));
   
-  if (SCM_CLOSUREP (data) || SCM_PROGRAM_P (data))
+  if (scm_is_true (scm_procedure_p (data)))
     return data;
   else
     return SCM_BOOL_F;
diff --git a/libguile/print.c b/libguile/print.c
index 9d737c8e2..a268a0c23 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -428,7 +428,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 {
   switch (SCM_ITAG3 (exp))
     {
-    case scm_tc3_closure:
     case scm_tc3_tc7_1:
     case scm_tc3_tc7_2:
       /* These tc3 tags should never occur in an immediate value.  They are
@@ -561,22 +560,6 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	circref:
 	  print_circref (port, pstate, exp);
 	  break;
-	case scm_tcs_closures:
-	  if (scm_is_false (scm_procedure_p (SCM_PRINT_CLOSURE))
-	      || scm_is_false (scm_printer_apply (SCM_PRINT_CLOSURE,
-						exp, port, pstate)))
-	    {
-	      scm_puts ("#<procedure", port);
-	      scm_putc (' ', port);
-	      scm_iprin1 (scm_procedure_name (exp), port, pstate);
-	      scm_putc (' ', port);
-              scm_iprin1
-                (scm_cons (SCM_I_MAKINUM (SCM_CLOSURE_NUM_REQUIRED_ARGS (exp)),
-                           scm_from_bool (SCM_CLOSURE_HAS_REST_ARGS (exp))),
-                 port, pstate);
-	      scm_putc ('>', port);
-	    }
-	  break;
 	case scm_tc7_number:
           switch SCM_TYP16 (exp) {
           case scm_tc16_big:
@@ -820,6 +803,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  EXIT_NESTED_DATA (pstate);
 	  break;
 	default:
+          /* case scm_tcs_closures: */
 	punk:
 	  scm_ipruk ("type", exp, port);
 	}
diff --git a/libguile/procprop.c b/libguile/procprop.c
index c69dbd238..c452c28d7 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -41,65 +41,49 @@
 SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
 SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
 
-static SCM non_closure_props;
-static scm_i_pthread_mutex_t non_closure_props_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+static SCM props;
+static scm_i_pthread_mutex_t props_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
-SCM
-scm_i_procedure_arity (SCM proc)
+int
+scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest)
 {
-  int a = 0, o = 0, r = 0;
   if (SCM_IMP (proc))
-    return SCM_BOOL_F;
+    return 0;
  loop:
   switch (SCM_TYP7 (proc))
     {
     case scm_tc7_program:
-      if (scm_i_program_arity (proc, &a, &o, &r))
-        break;
-      else
-        return SCM_BOOL_F;
+      return scm_i_program_arity (proc, req, opt, rest);
     case scm_tc7_smob:
       if (SCM_SMOB_APPLICABLE_P (proc))
 	{
 	  int type = SCM_SMOB_DESCRIPTOR (proc).gsubr_type;
-	  a += SCM_GSUBR_REQ (type);
-	  o = SCM_GSUBR_OPT (type);
-	  r = SCM_GSUBR_REST (type);
-	  break;
+	  *req = SCM_GSUBR_REQ (type);
+	  *opt = SCM_GSUBR_OPT (type);
+	  *rest = SCM_GSUBR_REST (type);
+          return 1;
 	}
       else
-	{
-	  return SCM_BOOL_F;
-	}
+        return 0;
     case scm_tc7_gsubr:
       {
 	unsigned int type = SCM_GSUBR_TYPE (proc);
-	a = SCM_GSUBR_REQ (type);
-	o = SCM_GSUBR_OPT (type);
-	r = SCM_GSUBR_REST (type);
-	break;
+	*req = SCM_GSUBR_REQ (type);
+	*opt = SCM_GSUBR_OPT (type);
+	*rest = SCM_GSUBR_REST (type);
+        return 1;
       }
     case scm_tc7_pws:
       proc = SCM_PROCEDURE (proc);
       goto loop;
-    case scm_tcs_closures:
-      a = SCM_CLOSURE_NUM_REQUIRED_ARGS (proc);
-      r = SCM_CLOSURE_HAS_REST_ARGS (proc) ? 1 : 0;
-      break;
     case scm_tcs_struct:
-      if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
-	{
-	  r = 1;
-	  break;
-	}
-      else if (!SCM_STRUCT_APPLICABLE_P (proc))
-        return SCM_BOOL_F;
+      if (!SCM_STRUCT_APPLICABLE_P (proc))
+        return 0;
       proc = SCM_STRUCT_PROCEDURE (proc);
       goto loop;
     default:
-      return SCM_BOOL_F;
+      return 0;
     }
-  return scm_list_3 (scm_from_int (a), scm_from_int (o), scm_from_bool(r));
 }
 
 /* FIXME: instead of the weak hash, perhaps for some kinds of procedures, use
@@ -111,18 +95,22 @@ SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0,
 	    "Return @var{obj}'s property list.")
 #define FUNC_NAME s_scm_procedure_properties
 {
-  SCM props;
+  SCM ret;
+  int req, opt, rest;
   
   SCM_VALIDATE_PROC (1, proc);
-  if (SCM_CLOSUREP (proc))
-    props = SCM_PROCPROPS (proc);
-  else
-    {
-      scm_i_pthread_mutex_lock (&non_closure_props_lock);
-      props = scm_hashq_ref (non_closure_props, proc, SCM_EOL);
-      scm_i_pthread_mutex_unlock (&non_closure_props_lock);
-    }
-  return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc), props);
+
+  scm_i_pthread_mutex_lock (&props_lock);
+  ret = scm_hashq_ref (props, proc, SCM_EOL);
+  scm_i_pthread_mutex_unlock (&props_lock);
+
+  scm_i_procedure_arity (proc, &req, &opt, &rest);
+
+  return scm_acons (scm_sym_arity,
+                    scm_list_3 (scm_from_int (req),
+                                scm_from_int (opt),
+                                scm_from_bool (rest)),
+                    ret);
 }
 #undef FUNC_NAME
 
@@ -133,14 +121,10 @@ SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0
 {
   SCM_VALIDATE_PROC (1, proc);
 
-  if (SCM_CLOSUREP (proc))
-    SCM_SETPROCPROPS (proc, alist);
-  else
-    {
-      scm_i_pthread_mutex_lock (&non_closure_props_lock);
-      scm_hashq_set_x (non_closure_props, proc, alist);
-      scm_i_pthread_mutex_unlock (&non_closure_props_lock);
-    }
+  scm_i_pthread_mutex_lock (&props_lock);
+  scm_hashq_set_x (props, proc, alist);
+  scm_i_pthread_mutex_unlock (&props_lock);
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -154,19 +138,22 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
 
   if (scm_is_eq (key, scm_sym_arity))
     /* avoid a cons in this case */
-    return scm_i_procedure_arity (proc);
+    {
+      int req, opt, rest;
+      scm_i_procedure_arity (proc, &req, &opt, &rest);
+      return scm_list_3 (scm_from_int (req),
+                         scm_from_int (opt),
+                         scm_from_bool (rest));
+    }
   else
     {
-      SCM props;
-      if (SCM_CLOSUREP (proc))
-        props = SCM_PROCPROPS (proc);
-      else
-        {
-          scm_i_pthread_mutex_lock (&non_closure_props_lock);
-          props = scm_hashq_ref (non_closure_props, proc, SCM_EOL);
-          scm_i_pthread_mutex_unlock (&non_closure_props_lock);
-        }
-      return scm_assq_ref (props, key);
+      SCM ret;
+
+      scm_i_pthread_mutex_lock (&props_lock);
+      ret = scm_hashq_ref (props, proc, SCM_EOL);
+      scm_i_pthread_mutex_unlock (&props_lock);
+
+      return scm_assq_ref (ret, key);
     }
 }
 #undef FUNC_NAME
@@ -182,18 +169,12 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
   if (scm_is_eq (key, scm_sym_arity))
     SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
 
-  if (SCM_CLOSUREP (proc))
-    SCM_SETPROCPROPS (proc,
-                      scm_assq_set_x (SCM_PROCPROPS (proc), key, val));
-  else
-    {
-      scm_i_pthread_mutex_lock (&non_closure_props_lock);
-      scm_hashq_set_x (non_closure_props, proc,
-                       scm_assq_set_x (scm_hashq_ref (non_closure_props, proc,
-                                                      SCM_EOL),
-                                       key, val));
-      scm_i_pthread_mutex_unlock (&non_closure_props_lock);
-    }
+  scm_i_pthread_mutex_lock (&props_lock);
+  scm_hashq_set_x (props, proc,
+                   scm_assq_set_x (scm_hashq_ref (props, proc,
+                                                  SCM_EOL),
+                                   key, val));
+  scm_i_pthread_mutex_unlock (&props_lock);
 
   return SCM_UNSPECIFIED;
 }
@@ -205,7 +186,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
 void
 scm_init_procprop ()
 {
-  non_closure_props = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+  props = scm_make_weak_key_hash_table (SCM_UNDEFINED);
 #include "libguile/procprop.x"
 }
 
diff --git a/libguile/procprop.h b/libguile/procprop.h
index 7a1131489..50f04b261 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -33,7 +33,7 @@ SCM_API SCM scm_sym_system_procedure;
 
 
 
-SCM_INTERNAL SCM scm_i_procedure_arity (SCM proc);
+SCM_INTERNAL int scm_i_procedure_arity (SCM proc, int *req, int *opt, int *rest);
 SCM_API SCM scm_procedure_properties (SCM proc);
 SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM alist);
 SCM_API SCM scm_procedure_property (SCM proc, SCM key);
diff --git a/libguile/procs.c b/libguile/procs.c
index c163bf6f1..71d50bdd7 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -100,7 +100,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
 	if (!((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC)
               || SCM_STRUCT_APPLICABLE_P (obj)))
 	  break;
-      case scm_tcs_closures:
       case scm_tc7_gsubr:
       case scm_tc7_pws:
       case scm_tc7_program:
@@ -114,45 +113,14 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_closure_p, "closure?", 1, 0, 0, 
-           (SCM obj),
-	    "Return @code{#t} if @var{obj} is a closure.")
-#define FUNC_NAME s_scm_closure_p
-{
-  return scm_from_bool (SCM_CLOSUREP (obj));
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, 
 	    (SCM obj),
 	    "Return @code{#t} if @var{obj} is a thunk.")
 #define FUNC_NAME s_scm_thunk_p
 {
-  if (SCM_NIMP (obj))
-    {
-    again:
-      switch (SCM_TYP7 (obj))
-	{
-	case scm_tcs_closures:
-	  return scm_from_bool (SCM_CLOSURE_NUM_REQUIRED_ARGS (obj) == 0);
-	case scm_tc7_gsubr:
-	  return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
-	case scm_tc7_program:
-          {
-            int a, o, r;
-            if (scm_i_program_arity (obj, &a, &o, &r))
-              return scm_from_bool (a == 0);
-            else
-              return SCM_BOOL_F;
-          }
-	case scm_tc7_pws:
-	  obj = SCM_PROCEDURE (obj);
-	  goto again;
-	default:
-          return SCM_BOOL_F;
-	}
-    }
-  return SCM_BOOL_F;
+  int req, opt, rest;
+  return scm_from_bool (scm_i_procedure_arity (obj, &req, &opt, &rest)
+                        && req == 0);
 }
 #undef FUNC_NAME
 
@@ -181,25 +149,11 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
 	    "documentation for that procedure.")
 #define FUNC_NAME s_scm_procedure_documentation
 {
-  SCM code;
-  SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
-	      proc, SCM_ARG1, FUNC_NAME);
+  SCM_VALIDATE_PROC (SCM_ARG1, proc);
   if (SCM_PROGRAM_P (proc))
     return scm_assq_ref (scm_program_properties (proc), sym_documentation);
-  switch (SCM_TYP7 (proc))
-    {
-    case scm_tcs_closures:
-      code = SCM_CLOSURE_BODY (proc);
-      if (scm_is_null (SCM_CDR (code)))
-	return SCM_BOOL_F;
-      code = SCM_CAR (code);
-      if (scm_is_string (code))
-	return code;
-      else
-	return SCM_BOOL_F;
-    default:
-      return SCM_BOOL_F;
-    }
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
diff --git a/libguile/procs.h b/libguile/procs.h
index 369d9e142..cb19e4c4b 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -47,20 +47,6 @@
 
 
 
-/* Closures
- */
-
-#define SCM_CLOSUREP(x) (!SCM_IMP(x) && (SCM_TYP3 (x) == scm_tc3_closure))
-#define SCM_CLOSCAR(x) SCM_PACK (SCM_CELL_WORD_0 (x) - scm_tc3_closure)
-#define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x))
-#define SCM_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (SCM_CAR (SCM_CODE (x)))
-#define SCM_CLOSURE_HAS_REST_ARGS(x) scm_is_true (SCM_CADR (SCM_CODE (x)))
-#define SCM_CLOSURE_BODY(x) SCM_CDDR (SCM_CODE (x))
-#define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x))
-#define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
-#define SCM_ENV(x) SCM_CELL_OBJECT_1 (x)
-#define SCM_TOP_LEVEL(ENV)  (scm_is_null (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV)))))
-
 /* Procedure-with-setter
 
    Four representations for procedure-with-setters were
@@ -122,7 +108,6 @@ SCM_API SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
 SCM_API SCM scm_c_define_subr_with_generic (const char *name, long type,
 					    SCM (*fcn)(), SCM *gf);
 SCM_API SCM scm_procedure_p (SCM obj);
-SCM_API SCM scm_closure_p (SCM obj);
 SCM_API SCM scm_thunk_p (SCM obj);
 SCM_API int scm_subr_p (SCM obj);
 SCM_API SCM scm_procedure_documentation (SCM proc);
diff --git a/libguile/tags.h b/libguile/tags.h
index 19260c301..915f6f3ed 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -386,7 +386,7 @@ typedef scm_t_uintptr scm_t_bits;
 #define scm_tc3_cons	 	 0
 #define scm_tc3_struct    	 1
 #define scm_tc3_int_1		 (scm_tc2_int + 0)
-#define scm_tc3_closure		 3
+#define scm_tc3_unused		 3
 #define scm_tc3_imm24		 4
 #define scm_tc3_tc7_1		 5
 #define scm_tc3_int_2		 (scm_tc2_int + 4)
@@ -652,26 +652,6 @@ enum scm_tc8_tags
   case scm_tc3_struct + 112:\
   case scm_tc3_struct + 120
 
-/* For closures
- */
-#define scm_tcs_closures \
-       scm_tc3_closure + 0:\
-  case scm_tc3_closure + 8:\
-  case scm_tc3_closure + 16:\
-  case scm_tc3_closure + 24:\
-  case scm_tc3_closure + 32:\
-  case scm_tc3_closure + 40:\
-  case scm_tc3_closure + 48:\
-  case scm_tc3_closure + 56:\
-  case scm_tc3_closure + 64:\
-  case scm_tc3_closure + 72:\
-  case scm_tc3_closure + 80:\
-  case scm_tc3_closure + 88:\
-  case scm_tc3_closure + 96:\
-  case scm_tc3_closure + 104:\
-  case scm_tc3_closure + 112:\
-  case scm_tc3_closure + 120
-
 /* For subrs
  */
 #define scm_tcs_subrs \
diff --git a/libguile/validate.h b/libguile/validate.h
index be4ed484b..094565812 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -296,8 +296,6 @@
 
 #define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, MEMOIZED_P, "memoized code")
 
-#define SCM_VALIDATE_CLOSURE(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, CLOSUREP, "closure")
-
 #define SCM_VALIDATE_PROC(pos, proc) \
   do { \
     SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
diff --git a/libguile/vm.c b/libguile/vm.c
index fdca9ea54..37f74e582 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -269,14 +269,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
 
   switch (SCM_TYP7 (proc))
     {
-    case scm_tcs_closures:
-      /* FIXME: pre-boot closures should be smobs */
-      {
-        SCM arglist = SCM_EOL;
-        while (nargs--)
-          arglist = scm_cons (args[nargs], arglist);
-        return scm_closure_apply (proc, arglist);
-      }
     case scm_tc7_smob:
       if (!SCM_SMOB_APPLICABLE_P (proc))
         goto badproc;