From c5d61b45c84762a194e1a6ca6ad6c5d99d68d2bb Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 12 Jul 2010 16:08:43 +0000
Subject: [PATCH] Simplify lookup.c's interface.

Environment operations now take only symbols, and check.  The
interpreter now extracts symbols from variables, not lookup.c.

This prevents non-symbols from passing into strengthen_symbol and
weaken_symbol in intern.c, which would barf on them.
---
 src/microcode/interp.c | 17 ++++++++++-------
 src/microcode/lookup.c | 24 ++++++++----------------
 2 files changed, 18 insertions(+), 23 deletions(-)

diff --git a/src/microcode/interp.c b/src/microcode/interp.c
index ef56c0d9d..14058a871 100644
--- a/src/microcode/interp.c
+++ b/src/microcode/interp.c
@@ -576,7 +576,8 @@ Interpret (int pop_return_p)
     case TC_VARIABLE:
       {
 	SCHEME_OBJECT val = GET_VAL;
-	long temp = (lookup_variable (GET_ENV, GET_EXP, (&val)));
+	SCHEME_OBJECT name = (GET_VARIABLE_SYMBOL (GET_EXP));
+	long temp = (lookup_variable (GET_ENV, name, (&val)));
 	if (temp != PRIM_DONE)
 	  {
 	    /* Back out of the evaluation. */
@@ -765,8 +766,6 @@ Interpret (int pop_return_p)
 	SCHEME_OBJECT val;
 	long code;
 
-	if (!ENVIRONMENT_P (GET_VAL))
-	  POP_RETURN_ERROR (ERR_BAD_FRAME);
 	code = (lookup_variable (GET_VAL,
 				 (MEMORY_REF (GET_EXP, ACCESS_NAME)),
 				 (&val)));
@@ -785,14 +784,18 @@ Interpret (int pop_return_p)
 
     case RC_EXECUTE_ASSIGNMENT_FINISH:
       {
+	SCHEME_OBJECT variable = (MEMORY_REF (GET_EXP, ASSIGN_NAME));
 	SCHEME_OBJECT old_val;
 	long code;
 
 	POP_ENV ();
-	code = (assign_variable (GET_ENV,
-				 (MEMORY_REF (GET_EXP, ASSIGN_NAME)),
-				 GET_VAL,
-				 (&old_val)));
+	if (TC_VARIABLE == (OBJECT_TYPE (variable)))
+	  code = (assign_variable (GET_ENV,
+				   (GET_VARIABLE_SYMBOL (variable)),
+				   GET_VAL,
+				   (&old_val)));
+	else
+	  code = ERR_BAD_FRAME;
 	if (code == PRIM_DONE)
 	  SET_VAL (old_val);
 	else
diff --git a/src/microcode/lookup.c b/src/microcode/lookup.c
index 2d785e52d..93781f63b 100644
--- a/src/microcode/lookup.c
+++ b/src/microcode/lookup.c
@@ -178,15 +178,10 @@ lookup_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
   SCHEME_OBJECT * cell;
   SCHEME_OBJECT value;
 
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) && (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
 
-  cell
-    = (find_binding_cell (environment,
-			  (((OBJECT_TYPE (symbol)) == TC_VARIABLE)
-			   ? (GET_VARIABLE_SYMBOL (symbol))
-			   : symbol),
-			  0));
+  cell = (find_binding_cell (environment, symbol, 0));
   if (cell == 0)
     return (ERR_UNBOUND_VARIABLE);
 
@@ -324,15 +319,10 @@ long
 assign_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
 		 SCHEME_OBJECT value, SCHEME_OBJECT * value_ret)
 {
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) || (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
   {
-    SCHEME_OBJECT * cell
-      = (find_binding_cell (environment,
-			    (((OBJECT_TYPE (symbol)) == TC_VARIABLE)
-			     ? (GET_VARIABLE_SYMBOL (symbol))
-			     : symbol),
-			    0));
+    SCHEME_OBJECT * cell = (find_binding_cell (environment, symbol, 0));
     if (cell == 0)
       return (ERR_UNBOUND_VARIABLE);
     return (assign_variable_end (cell, value, value_ret, 0));
@@ -434,7 +424,7 @@ long
 define_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
 		 SCHEME_OBJECT value)
 {
-  if (!ENVIRONMENT_P (environment))
+  if (! ((ENVIRONMENT_P (environment)) || (SYMBOL_P (symbol))))
     return (ERR_BAD_FRAME);
 
   /* If there is already a binding, just assign to it.  */
@@ -552,7 +542,9 @@ link_variables (SCHEME_OBJECT target_environment, SCHEME_OBJECT target_symbol,
   SCHEME_OBJECT * target_cell;
 
   if (! ((ENVIRONMENT_P (target_environment))
-	 && (ENVIRONMENT_P (source_environment))))
+	 && (ENVIRONMENT_P (source_environment))
+	 && (SYMBOL_P (target_symbol))
+	 && (SYMBOL_P (source_symbol))))
     return (ERR_BAD_FRAME);
 
   source_cell = (find_binding_cell (source_environment, source_symbol, 0));
-- 
2.25.1