Memoized expressions are pairs, not SMOBs

* libguile/memoize.c (MAKMEMO): Memoized objects are pairs now, not
  SMOBs.  This lets eval.scm destructure them more efficiently.
  (scm_print_memoized, scm_memoized_p, scm_memoized_expression_typecode)
  (scm_memoized_expression_data): Remove these interfaces.
  (unmemoize, scm_memoize_variable_access_x): Remove SMOB type checks.
  (scm_init_memoize): Remove SMOB type definition.

* libguile/memoize.h (scm_tc16_memoized, SCM_MEMOIZED_P)
  (scm_memoized_expression_typecode, scm_memoized_expression_data)
  (scm_memoized_p): Remove declarations.

* libguile/validate.h (SCM_VALIDATE_MEMOIZED): Remove declaration.

* libguile/eval.c (eval): Remove memoized type check, and inline the
  inum unpacking.

* module/ice-9/eval.scm (memoized-expression-case): Use car and cdr to
  destructure memoized expressions.  A big win!

libguile/eval.c

@@ -266,11 +266,9 @@ eval (SCM x, SCM env)
 
  loop:
   SCM_TICK;
-  if (!SCM_MEMOIZED_P (x))
-    abort ();
   
   mx = SCM_MEMOIZED_ARGS (x);
-  switch (SCM_MEMOIZED_TAG (x))
+  switch (SCM_I_INUM (SCM_CAR (x)))
     {
     case SCM_M_SEQ:
       eval (CAR (mx), env);

libguile/memoize.c

@@ -109,7 +109,7 @@ do_pop_fluid (void)
 scm_t_bits scm_tc16_memoized;
 
 #define MAKMEMO(n, args)                                                \
-  (scm_cell (scm_tc16_memoized | ((n) << 16), SCM_UNPACK (args)))
+  (scm_cons (SCM_I_MAKINUM (n), args))
 
 #define MAKMEMO_SEQ(head,tail) \
   MAKMEMO (SCM_M_SEQ, scm_cons (head, tail))
@@ -179,15 +179,6 @@ static const char *const memoized_tags[] =
   "call-with-prompt",
 };
 
-static int
-scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate)
-{
-  scm_puts_unlocked ("#<memoized ", port);
-  scm_write (scm_unmemoize_expression (memoized), port);
-  scm_puts_unlocked (">", port);
-  return 1;
-}
-
 
 
 
@@ -601,9 +592,6 @@ unmemoize (const SCM expr)
 {
   SCM args;
   
-  if (!SCM_MEMOIZED_P (expr))
-    abort ();
-
   args = SCM_MEMOIZED_ARGS (expr);
   switch (SCM_MEMOIZED_TAG (expr))
     {
@@ -706,47 +694,15 @@ unmemoize (const SCM expr)
 
 
 
-SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0, 
-            (SCM obj),
-	    "Return @code{#t} if @var{obj} is memoized.")
-#define FUNC_NAME s_scm_memoized_p
-{
-  return scm_from_bool (SCM_MEMOIZED_P (obj));
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_unmemoize_expression, "unmemoize-expression", 1, 0, 0, 
             (SCM m),
 	    "Unmemoize the memoized expression @var{m}.")
 #define FUNC_NAME s_scm_unmemoize_expression
 {
-  SCM_VALIDATE_MEMOIZED (1, m);
   return unmemoize (m);
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_memoized_expression_typecode, "memoized-expression-typecode", 1, 0, 0, 
-            (SCM m),
-	    "Return the typecode from the memoized expression @var{m}.")
-#define FUNC_NAME s_scm_memoized_expression_typecode
-{
-  SCM_VALIDATE_MEMOIZED (1, m);
-
-  /* The tag is a 16-bit integer so it fits in an inum.  */
-  return SCM_I_MAKINUM (SCM_MEMOIZED_TAG (m));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_memoized_expression_data, "memoized-expression-data", 1, 0, 0, 
-            (SCM m),
-	    "Return the data from the memoized expression @var{m}.")
-#define FUNC_NAME s_scm_memoized_expression_data
-{
-  SCM_VALIDATE_MEMOIZED (1, m);
-  return SCM_MEMOIZED_ARGS (m);
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_memoized_typecode, "memoized-typecode", 1, 0, 0, 
             (SCM sym),
 	    "Return the memoized typecode corresponding to the symbol @var{sym}.")
@@ -777,9 +733,8 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
 	    "Look up and cache the variable that @var{m} will access, returning the variable.")
 #define FUNC_NAME s_scm_memoize_variable_access_x
 {
-  SCM mx;
+  SCM mx = SCM_MEMOIZED_ARGS (m);
-  SCM_VALIDATE_MEMOIZED (1, m);
+
-  mx = SCM_MEMOIZED_ARGS (m);
   switch (SCM_MEMOIZED_TAG (m))
     {
     case SCM_M_TOPLEVEL_REF:
@@ -790,7 +745,7 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
           SCM var = scm_module_variable (mod, mx);
           if (scm_is_false (var) || scm_is_false (scm_variable_bound_p (var)))
             error_unbound_variable (mx);
-          SCM_SET_SMOB_OBJECT (m, var);
+          SCM_SETCDR (m, var);
           return var;
         }
 
@@ -821,7 +776,7 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
           var = scm_module_lookup (mod, CADR (mx));
           if (scm_is_false (scm_variable_bound_p (var)))
             error_unbound_variable (CADR (mx));
-          SCM_SET_SMOB_OBJECT (m, var);
+          SCM_SETCDR (m, var);
           return var;
         }
 
@@ -853,9 +808,6 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
 void
 scm_init_memoize ()
 {
-  scm_tc16_memoized = scm_make_smob_type ("%memoized", 0);
-  scm_set_smob_print (scm_tc16_memoized, scm_print_memoized);
-
 #include "libguile/memoize.x"
 
   wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind);

libguile/memoize.h

@@ -58,11 +58,8 @@ SCM_API SCM scm_sym_args;
 /* {Memoized Source}
  */
 
-SCM_INTERNAL scm_t_bits scm_tc16_memoized;
+#define SCM_MEMOIZED_TAG(x) 	(scm_to_uint16 (scm_car (x)))
-
+#define SCM_MEMOIZED_ARGS(x) 	(scm_cdr (x))
-#define SCM_MEMOIZED_P(x) 	(SCM_SMOB_PREDICATE (scm_tc16_memoized, (x)))
-#define SCM_MEMOIZED_TAG(x) 	(SCM_SMOB_FLAGS (x))
-#define SCM_MEMOIZED_ARGS(x) 	(SCM_SMOB_OBJECT (x))
 
 enum
   {
@@ -90,11 +87,8 @@ enum
 
 SCM_INTERNAL SCM scm_memoize_expression (SCM exp);
 SCM_INTERNAL SCM scm_unmemoize_expression (SCM memoized);
-SCM_INTERNAL SCM scm_memoized_expression_typecode (SCM memoized);
-SCM_INTERNAL SCM scm_memoized_expression_data (SCM memoized);
 SCM_INTERNAL SCM scm_memoized_typecode (SCM sym);
 SCM_INTERNAL SCM scm_memoize_variable_access_x (SCM memoized, SCM module);
-SCM_API SCM scm_memoized_p (SCM obj);
 
 SCM_INTERNAL void scm_init_memoize (void);
 

libguile/validate.h

@@ -4,7 +4,7 @@
 #define SCM_VALIDATE_H
 
 /* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2009,
- *   2011, 2012 Free Software Foundation, Inc.
+ *   2011, 2012, 2013 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -293,8 +293,6 @@
 
 #define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
 
-#define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, MEMOIZED_P, "memoized code")
-
 #define SCM_VALIDATE_PROC(pos, proc) \
   do { \
     SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \

module/ice-9/eval.scm

@@ -264,8 +264,8 @@
     (lambda (x)
       (syntax-case x ()
         ((_ mx c ...)
-         #'(let ((tag (memoized-expression-typecode mx))
+         #'(let ((tag (car mx))
-                 (data (memoized-expression-data mx)))
+                 (data (cdr mx)))
              (mx-match mx data tag c ...)))))))