Make the environment handling system aware of bindings as first-class values.

9 files changed, 101 insertions, 183 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 31b6576..f88f6c2 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -36,7 +36,6 @@ ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBinding.m		\
                        MLKSingleFloat.m MLKStream.m			\
                        MLKStringInputStream.m MLKSymbol.m		\
                        MLKThrowException.m				\
-                       MLKUndefinedVariableException.m			\
                        NSObject-MLKPrinting.m NSString-MLKPrinting.m
 ToiletKit_LDFLAGS = -lgmp
 #LIBRARIES_DEPEND_UPON
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 630b505..31f23b7 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -42,7 +42,7 @@
             initWithParent:(parent                                      \
                             ? (id) parent_member                        \
                             : nil)                                      \
-                  bindings:variable]                                    \
+                    values:variable]                                    \
    : (id) (parent ? (id) RETAIN (parent_member) : nil));
 
 
@@ -330,7 +330,7 @@ static MLKDynamicContext *global_context;
     }
   NS_HANDLER
     {
-      if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"])
+      if ([[localException name] isEqualToString: @"MLKUnboundVariableError"])
         NS_VALUERETURN (nil, id);
       else
         [localException raise];
@@ -351,7 +351,7 @@ static MLKDynamicContext *global_context;
     }
   NS_HANDLER
     {
-      if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"])
+      if ([[localException name] isEqualToString: @"MLKUnboundVariableError"])
         NS_VALUERETURN (nil, id);
       else
         [localException raise];
@@ -369,7 +369,7 @@ static MLKDynamicContext *global_context;
     }
   NS_HANDLER
     {
-      if ([[localException name] isEqualToString: @"MLKUndefinedVariableException"])
+      if ([[localException name] isEqualToString: @"MLKUnboundVariableError"])
         NS_VALUERETURN (nil, id);
       else
         [localException raise];
diff --git a/MLKEnvironment.h b/MLKEnvironment.h
index ef357f6..0789b1a 100644
--- a/MLKEnvironment.h
+++ b/MLKEnvironment.h
@@ -17,6 +17,7 @@
  */
 
 #import "MLKLispValue.h"
+#import "MLKBinding.h"
 
 @class NSMutableDictionary, MLKSymbol, NSSet;
 
@@ -27,28 +28,25 @@
   NSMutableDictionary *_bindings;
 }
 
-+(void) initialize;
-
 -(MLKEnvironment *) init;
 -(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent;
--(MLKEnvironment *) initWithBindings:(NSDictionary *)bindings;
--(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent bindings:(NSDictionary *)bindings;
+-(MLKEnvironment *) initWithValues:(NSDictionary *)bindings;
+-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent
+                            values:(NSDictionary *)bindings;
 
 -(MLKEnvironment *) parent;
 
 -(NSSet *) bindings;
 -(void) addBindingForSymbol:(MLKSymbol *)symbol;
 -(void) addBindings:(NSDictionary *)bindings;
+-(void) addValues:(NSDictionary *)bindings;
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol;
 -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol;
+-(MLKBinding *) bindingForSymbol:(MLKSymbol *)symbol;
 -(id) valueForSymbol:(MLKSymbol *)symbol;
 
 -(MLKEnvironment *) environmentForSymbol:(MLKSymbol *)symbol;
 
-// Private methods.
--(void) setBinding:(MLKSymbol *)symbol to:(id)value inEnvironment:(MLKEnvironment *)env;
--(id) valueForSymbol:(MLKSymbol *)symbol inEnvironment:(MLKEnvironment *)env;
-
 -(BOOL) boundp:(MLKSymbol *)symbol;
 -(void) makunbound:(MLKSymbol *)symbol;
 
diff --git a/MLKEnvironment.m b/MLKEnvironment.m
index 73ea749..29f7740 100644
--- a/MLKEnvironment.m
+++ b/MLKEnvironment.m
@@ -18,45 +18,39 @@
 
 #import <Foundation/NSArray.h>
 #import <Foundation/NSDictionary.h>
+#import <Foundation/NSException.h>
 #import <Foundation/NSNull.h>
 #import <Foundation/NSSet.h>
 
 #import "MLKEnvironment.h"
-#import "MLKUndefinedVariableException.h"
+#import "NSObject-MLKPrinting.h"
 #import "runtime-compatibility.h"
 
 
-static id UNBOUND;
-
-
 @implementation MLKEnvironment
-+(void) initialize
-{
-  UNBOUND = [[NSObject alloc] init];
-}
-
 -(MLKEnvironment *) init
 {
-  return [self initWithParent:nil bindings:nil];
+  return [self initWithParent:nil values:nil];
 }
 
--(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent bindings:(NSDictionary *)bindings
+-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent
+                            values:(NSDictionary *)bindings
 {
   self = [super init];
   _bindings = [[NSMutableDictionary alloc] initWithCapacity:10];
   ASSIGN (_parent, parent);
-  [self addBindings: bindings];
+  [self addValues:bindings];
   return self;
 }
 
 -(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent
 {
-  return [self initWithParent:parent bindings:nil];
+  return [self initWithParent:parent values:nil];
 }
 
--(MLKEnvironment *) initWithBindings:(NSDictionary *)bindings
+-(MLKEnvironment *) initWithValues:(NSDictionary *)bindings
 {
-  return [self initWithParent:nil bindings:bindings];
+  return [self initWithParent:nil values:bindings];
 }
 
 -(MLKEnvironment *) parent
@@ -74,54 +68,41 @@ static id UNBOUND;
 
 -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol;
 {
-  [self setBinding:(symbol ? (id)symbol : (id)[NSNull null])
-        to:value
-        inEnvironment:self];
-}
+  MLKBinding *binding;
 
--(void) setBinding:(MLKSymbol *)symbol to:(id)value inEnvironment:(MLKEnvironment *)env
-{
-  value = value ? value : (id) [NSNull null];
-  if ([_bindings objectForKey:symbol])
-    [_bindings setObject:value forKey:symbol];
-  else
-    if (_parent)
-      [_parent setBinding:symbol to:value inEnvironment:env];
-    else
-      [[[MLKUndefinedVariableException alloc] initWithEnvironment:env
-                                              variableName:symbol]
-        raise];
+  if (!(binding = [self bindingForSymbol:symbol]))
+    [NSException raise:@"MLKUnboundVariableError"
+                 format:@"The variable %@ is unbound.",
+                       [symbol descriptionForLisp]];
+
+  [binding setValue:value];
 }
 
 -(id) valueForSymbol:(MLKSymbol *)symbol
 {
-  return [self valueForSymbol:(symbol ? (id)symbol : (id)[NSNull null])
-               inEnvironment:self];
+  MLKBinding *binding;
+
+  if (!(binding = [self bindingForSymbol:symbol]))
+    [NSException raise:@"MLKUnboundVariableError"
+                 format:@"The variable %@ is unbound.",
+                       [symbol descriptionForLisp]];
+      
+  return [binding value];
 }
 
--(id) valueForSymbol:(MLKSymbol *)symbol inEnvironment:(MLKEnvironment *)env
+-(MLKBinding*) bindingForSymbol:(MLKSymbol *)symbol
 {
-  id value;
-  if ((value = [_bindings objectForKey:symbol]))
-    {
-      if (value == [NSNull null])
-        return nil;
-      else if (value == UNBOUND)
-        [[[MLKUndefinedVariableException alloc] initWithEnvironment:env
-                                                variableName:symbol]
-          raise];
-      else
-        return value;
-    }
+  MLKBinding *binding;
+  
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+
+  if ((binding = [_bindings objectForKey:symbol]))
+    return binding;
   else
     if (_parent)
-      return [_parent valueForSymbol:symbol];
+      return [_parent bindingForSymbol:symbol];
     else
-      [[[MLKUndefinedVariableException alloc] initWithEnvironment:env
-                                              variableName:symbol]
-        raise];
-
-  return nil;  // avoid a stupid compiler warning
+      return nil;
 }
 
 -(void) addBindings:(NSDictionary *)bindings
@@ -129,15 +110,35 @@ static id UNBOUND;
   [_bindings addEntriesFromDictionary:bindings];
 }
 
+-(void) addValues:(NSDictionary *)bindings
+{
+  int i;
+  NSArray *keys;
+
+  keys = [bindings allKeys];
+  for (i = 0; i < [keys count]; i++)
+    {
+      id key = [keys objectAtIndex:i];
+      id value = [bindings objectForKey:key];
+
+      value = (value == [NSNull null]) ? nil : value;
+
+      [_bindings setObject:[MLKBinding bindingWithValue:value]
+                 forKey:key];
+    }
+}
+
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol;
 {
-  value = value ? value : (id) [NSNull null];
-  [_bindings setObject:value forKey:symbol];
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  [_bindings setObject:[MLKBinding bindingWithValue:value]
+             forKey:symbol];
 }
 
 -(void) addBindingForSymbol:(MLKSymbol *)symbol
 {
-  [_bindings setObject:UNBOUND forKey:(symbol ? (id)symbol : (id)[NSNull null])];
+  [_bindings setObject:[MLKBinding binding]
+             forKey:(symbol ? (id)symbol : (id)[NSNull null])];
 }
 
 -(MLKEnvironment *) environmentForSymbol:(MLKSymbol *)symbol
@@ -152,21 +153,20 @@ static id UNBOUND;
 
 -(BOOL) boundp:(MLKSymbol *)symbol
 {
-  id value;
-  if ((value = [_bindings objectForKey:symbol]))
-    return (value != UNBOUND);
-  else if (_parent)
-    return [_parent boundp:symbol];
+  MLKBinding *binding;
+
+  if ((binding = [self bindingForSymbol:symbol]))
+    return [binding boundp];
   else
     return NO;
 }
 
 -(void) makunbound:(MLKSymbol *)symbol
 {
-  if ([_bindings objectForKey:symbol])
-    [_bindings setObject:UNBOUND forKey:symbol];
-  else if (_parent)
-    return [_parent makunbound:symbol];
+  MLKBinding *binding;
+
+  if ((binding = [self bindingForSymbol:symbol]))
+    [binding makunbound];
 }
 
 -(void) dealloc
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index 5eca3d6..2bf2bc4 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -18,6 +18,8 @@
 
 #import "MLKLispValue.h"
 
+#import <Foundation/NSSet.h>
+
 @class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSLinkedList, NSSet,
        NSMutableDictionary, NSString, MLKCons, MLKFuncallable;
 
@@ -29,8 +31,8 @@
   MLKEnvironment *_macros;
   MLKEnvironment *_symbolMacros;
   MLKEnvironment *_goTags;
-  NSMutableDictionary *_functionLocations;
-  NSMutableDictionary *_variableLocations;
+  NSMutableSet *_functions;
+  NSMutableSet *_variables;
   id _declarations;
   MLKLexicalContext *_parent;
 }
@@ -58,10 +60,10 @@
 -(void) setSymbolMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol;
 
 -(id) goTagForSymbol:(MLKSymbol *)symbol;
--(id) variableLocationForSymbol:(MLKSymbol *)symbol;
 
--(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables
-                                          functions:(NSDictionary *)functions;
+// FIXME?
+//-(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables
+//                                          functions:(NSDictionary *)functions;
 
 -(void) addVariable:(MLKSymbol *)symbol;
 -(void) addFunction:(MLKSymbol *)symbol;
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index 5b664f4..d7511fb 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -43,7 +43,7 @@
             initWithParent:(parent                                      \
                             ? (id) parent_member                        \
                             : nil)                                      \
-                  bindings:variable]                                    \
+                    values:variable]                                    \
    : (id) (parent ? (id) RETAIN (parent_member) : nil));
 
 
@@ -59,7 +59,7 @@ static MLKSymbol *LEXICAL;
 @implementation MLKLexicalContext
 +(void) initialize
 {
-  MLKDynamicContext *dynamic_context = [MLKDynamicContext globalContext];
+  /* MLKDynamicContext *dynamic_context = */ [MLKDynamicContext globalContext];
   MLKLexicalEnvironment *globalenv = [MLKLexicalEnvironment globalEnvironment];
   cl = [MLKPackage findPackage:@"COMMON-LISP"];
   sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
@@ -84,26 +84,12 @@ static MLKSymbol *LEXICAL;
                          symbolMacros:(NSDictionary *)symbolMacros
                          declarations:(id)declarations
 {
-  int i;
-  NSArray *e;
-
   self = [super init];
 
   ASSIGN (_parent, (aContext ? aContext : [MLKLexicalContext globalContext]));
   
-  ASSIGN (_variableLocations, [NSMutableDictionary dictionary]);
-  e = [vars allObjects];
-  for (i = 0; i < [e count]; i++)
-    {
-      [self addVariable:[e objectAtIndex:i]];
-    }
-  
-  ASSIGN (_functionLocations, [NSMutableDictionary dictionary]);
-  e = [functions allObjects];
-  for (i = 0; i < [e count]; i++)
-    {
-      [self addFunction:[e objectAtIndex:i]];
-    }
+  ASSIGN (_variables, [NSMutableSet setWithSet:vars]);
+  ASSIGN (_functions, [NSMutableSet setWithSet:functions]);
 
   _goTags = MAKE_ENVIRONMENT (goTags, _parent, _parent->_goTags);
   _macros = MAKE_ENVIRONMENT (macros, _parent, _parent->_macros);
@@ -148,9 +134,10 @@ static MLKSymbol *LEXICAL;
 
 -(BOOL) symbolNamesFunction:(MLKSymbol *)symbol
 {
-  if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])])
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  if ([_functions containsObject:symbol])
     return YES;
-  else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])])
+  else if ([_knownMacros containsObject:symbol])
     return NO;
   else
     return (_parent && [_parent symbolNamesFunction:symbol]);  
@@ -158,9 +145,10 @@ static MLKSymbol *LEXICAL;
 
 -(BOOL) symbolNamesMacro:(MLKSymbol *)symbol
 {
-  if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])])
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  if ([_functions containsObject:symbol])
     return NO;
-  else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])])
+  else if ([_knownMacros containsObject:symbol])
     return YES;
   else
     return (_parent && [_parent symbolNamesMacro:symbol]);  
@@ -168,9 +156,10 @@ static MLKSymbol *LEXICAL;
 
 -(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol
 {
-  if ([_variableLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])])
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  if ([_variables containsObject:symbol])
     return NO;
-  else if ([_knownSymbolMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])])
+  else if ([_knownSymbolMacros containsObject:symbol])
     return YES;
   else
     return (_parent && [_parent symbolNamesSymbolMacro:symbol]);  
@@ -214,12 +203,14 @@ static MLKSymbol *LEXICAL;
 
 -(void) addVariable:(MLKSymbol *)symbol
 {
-  [_variableLocations setObject:[NSNull null] forKey:symbol];
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  [_variables addObject:symbol];
 }
 
 -(void) addFunction:(MLKSymbol *)symbol
 {
-  [_functionLocations setObject:[NSNull null] forKey:symbol];
+  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  [_functions addObject:symbol];
 }
 
 -(void) dealloc
@@ -229,7 +220,8 @@ static MLKSymbol *LEXICAL;
   RELEASE (_knownSymbolMacros);
   RELEASE (_symbolMacros);
   RELEASE (_goTags);
-  RELEASE (_functionLocations);
+  RELEASE (_functions);
+  RELEASE (_variables);
   RELEASE (_declarations);
   RELEASE (_parent);
   [super dealloc];
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index 62ff1d7..66d5cb2 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -42,7 +42,7 @@
             initWithParent:(parent                                      \
                             ? (id) parent_member                        \
                             : nil)                                      \
-                  bindings:variable]                                    \
+                    values:variable]                                    \
    : (id) (parent ? (id) RETAIN (parent_member) : nil));
 
 
diff --git a/MLKUndefinedVariableException.h b/MLKUndefinedVariableException.h
deleted file mode 100644
index 1fe7e86..0000000
--- a/MLKUndefinedVariableException.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/* -*- mode: objc; coding: utf-8 -*- */
-/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
- * Copyright (C) 2008  Matthias Andreas Benkard.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or (at
- * your option) any later version.
- *
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
- */
-
-#import <Foundation/NSException.h>
-
-@class MLKSymbol, MLKEnvironment;
-
-
-@interface MLKUndefinedVariableException : NSException
-{
-  MLKSymbol *variableName;
-  MLKEnvironment *environment;
-}
-
--(MLKUndefinedVariableException *) initWithEnvironment:(id)environment
-                                          variableName:(id)symbol;
-
--(void) dealloc;
-@end
diff --git a/MLKUndefinedVariableException.m b/MLKUndefinedVariableException.m
deleted file mode 100644
index 6e43262..0000000
--- a/MLKUndefinedVariableException.m
+++ /dev/null
@@ -1,39 +0,0 @@
-/* -*- mode: objc; coding: utf-8 -*- */
-/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
- * Copyright (C) 2008  Matthias Andreas Benkard.
- *
- * This program is free software: you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation, either version 3 of the License, or (at
- * your option) any later version.
- *
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program.  If not, see <http://www.gnu.org/licenses/>.
- */
-
-#import "MLKUndefinedVariableException.h"
-#import "runtime-compatibility.h"
-
-
-@implementation MLKUndefinedVariableException
--(MLKUndefinedVariableException *) initWithEnvironment:(id)anEnvironment
-                                          variableName:(id)aSymbol
-{
-  self = [super init];
-  variableName = aSymbol;
-  environment = anEnvironment;
-  return self;
-}
-
--(void) dealloc
-{
-  RELEASE (variableName);
-  RELEASE (environment);
-  [super dealloc];
-}
-@end