Add class MLKLexicalContext.

3 files changed, 231 insertions, 11 deletions

diff --git a/GNUmakefile b/GNUmakefile
index c496ccb..7d2eda3 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -29,10 +29,10 @@ ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKDoubleFloat.m	\
                        MLKDynamicContext.m MLKEndOfFileError.m		\
                        MLKEnvironment.m MLKError.m MLKFloat.m		\
                        MLKInteger.m MLKInterpreter.m MLKLinkedList.m	\
-                       MLKLexicalEnvironment.m MLKLispValue.m		\
-                       MLKPackage.m MLKParenReader.m MLKRatio.m		\
-                       MLKReader.m MLKReadtable.m MLKReaderError.m	\
-                       MLKSingleFloat.m MLKStream.m			\
+                       MLKLexicalContext.m MLKLexicalEnvironment.m	\
+                       MLKLispValue.m MLKPackage.m MLKParenReader.m	\
+                       MLKRatio.m MLKReader.m MLKReadtable.m		\
+                       MLKReaderError.m MLKSingleFloat.m MLKStream.m	\
                        MLKStringInputStream.m MLKSymbol.m		\
                        MLKThrowException.m				\
                        MLKUndefinedVariableException.m			\
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index 68acb80..f869d8d 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -18,38 +18,48 @@
 
 #import "MLKLispValue.h"
 
-@class MLKEnvironment, MLKSymbol, NSLinkedList, NSSet,
-       NSMutableDictionary, NSString, MLKCons;
+@class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSLinkedList, NSSet,
+       NSMutableDictionary, NSString, MLKCons, MLKFuncallable;
 
 
 @interface MLKLexicalContext : MLKLispValue
 {
-  MLKEnvironment *_macroBindings;
+  NSArray *_knownMacros;
+  MLKEnvironment *_macros;
+  MLKEnvironment *_symbolMacros;
   MLKEnvironment *_goTags;
+  NSMutableDictionary *_functionLocations;
   NSMutableDictionary *_variableLocations;
-  MLKCons *_declarations;
+  id _declarations;
   MLKLexicalContext *_parent;
 }
 
 -(MLKLexicalContext *) initWithParent:(MLKLexicalContext *)aContext
                             variables:(NSSet *)vars
+                            functions:(NSSet *)functions
                                goTags:(NSDictionary *)goTags
                                macros:(NSDictionary *)macros
                          declarations:(NSDictionary *)declarations;
 
 +(MLKLexicalContext *) globalContext;
-+(MLKLexicalContext *) nullContext;
-
--(MLKEnvironment *) environment;
 
 -(BOOL) symbolNamesFunction:(MLKSymbol *)symbol;
 -(BOOL) symbolNamesMacro:(MLKSymbol *)symbol;
 
 -(id) macroForSymbol:(MLKSymbol *)symbol;
+-(void) setMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol;
+
+-(id) symbolMacroForSymbol:(MLKSymbol *)symbol;
+-(void) setSymbolMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol;
+
 -(id) goTagForSymbol:(MLKSymbol *)symbol;
 -(id) variableLocationForSymbol:(MLKSymbol *)symbol;
 
+-(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables
+                                          functions:(NSDictionary *)functions;
+
 -(void) addVariable:(MLKSymbol *)symbol;
+-(void) addFunction:(MLKSymbol *)symbol;
 
 -(BOOL) variableIsLexical:(MLKSymbol *)symbol;
 
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
new file mode 100644
index 0000000..06d2ebb
--- /dev/null
+++ b/MLKLexicalContext.m
@@ -0,0 +1,210 @@
+/* -*- 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/NSArray.h>
+#import <Foundation/NSDictionary.h>
+#import <Foundation/NSException.h>
+#import <Foundation/NSNull.h>
+#import <Foundation/NSSet.h>
+#import <Foundation/NSString.h>
+
+#import "MLKCons.h"
+#import "MLKLexicalContext.h"
+#import "MLKEnvironment.h"
+#import "MLKLinkedList.h"
+#import "MLKPackage.h"
+#import "MLKParenReader.h"
+#import "MLKReadtable.h"
+#import "MLKSymbol.h"
+#import "MLKInteger.h"
+#import "runtime-compatibility.h"
+
+
+#define MAKE_ENVIRONMENT(variable, parent, parent_member)               \
+  (variable                                                             \
+   ? (id) [[MLKEnvironment alloc]                                       \
+            initWithParent:(parent                                      \
+                            ? (id) parent_member                        \
+                            : nil)                                      \
+                  bindings:variable]                                    \
+   : (id) (parent ? (id) RETAIN (parent_member) : nil));
+
+
+static MLKLexicalContext *global_context;
+
+
+static MLKPackage *cl;
+static MLKPackage *sys;
+static MLKSymbol *SPECIAL;
+static MLKSymbol *LEXICAL;
+
+
+@implementation MLKLexicalContext
++(void) initialize
+{
+  cl = [MLKPackage findPackage:@"COMMON-LISP"];
+  sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+  SPECIAL = [cl intern:@"SPECIAL"];
+  LEXICAL = [sys intern:@"LEXICAL"];
+}
+
+-(MLKLexicalContext *) initWithParent:(MLKLexicalContext *)aContext
+                            variables:(NSSet *)vars
+                            functions:(NSSet *)functions
+                               goTags:(NSDictionary *)goTags
+                               macros:(NSDictionary *)macros
+                         symbolMacros:(NSDictionary *)symbolMacros
+                         declarations:(id)declarations
+{
+  int i;
+  NSArray *e;
+
+  self = [super init];
+  ASSIGN (_parent, (aContext ? aContext : [MLKLexicalContext globalContext]));
+
+  e = [vars allObjects];
+  for (i = 0; i < [e count]; i++)
+    {
+      [self addVariable:[e objectAtIndex:i]];
+    }
+  
+  e = [functions allObjects];
+  for (i = 0; i < [e count]; i++)
+    {
+      [self addVariable:[e objectAtIndex:i]];
+    }
+
+  _goTags = MAKE_ENVIRONMENT (goTags, _parent, _parent->_goTags);
+  _macros = MAKE_ENVIRONMENT (macros, _parent, _parent->_macros);
+  _symbolMacros = MAKE_ENVIRONMENT (macros, _parent, _parent->_symbolMacros);
+
+  _knownMacros = [macros allKeys];
+
+  ASSIGN (_declarations, declarations);
+  return self;  
+}
+
++(MLKLexicalContext *) globalContext
+{
+  return global_context;
+}
+
+-(id) macroForSymbol:(MLKSymbol *)symbol
+{
+  return [_macros valueForBinding:symbol];
+}
+
+-(void) setMacro:(MLKFuncallable *)value forSymbol:(MLKSymbol *)symbol
+{
+  [_symbolMacros setValue:value forBinding:symbol];
+}
+
+-(id) symbolMacroForSymbol:(MLKSymbol *)symbol
+{
+  return [_symbolMacros valueForBinding:symbol];
+}
+
+-(void) setSymbolMacro:(MLKFuncallable *)value forSymbol:(MLKSymbol *)symbol
+{
+  [_symbolMacros setValue:value forBinding:symbol];
+}
+
+-(id) goTagForSymbol:(MLKSymbol *)symbol
+{
+  return [_goTags valueForBinding:symbol];
+}
+
+-(BOOL) symbolNamesFunction:(MLKSymbol *)symbol
+{
+  if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])])
+    return YES;
+  else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])])
+    return NO;
+  else
+    return (_parent && [_parent symbolNamesFunction:symbol]);  
+}
+
+-(BOOL) symbolNamesMacro:(MLKSymbol *)symbol
+{
+  if ([_functionLocations objectForKey:(symbol ? (id)symbol : (id)[NSNull null])])
+    return NO;
+  else if ([_knownMacros containsObject:(symbol ? (id)symbol : (id)[NSNull null])])
+    return YES;
+  else
+    return (_parent && [_parent symbolNamesMacro:symbol]);  
+}
+
+-(BOOL) variableIsLexical:(MLKSymbol *)symbol
+{
+  id rest;
+
+  rest = _declarations;
+  while (rest)
+    {
+      id item = [rest car];
+      if ([[item cdr] car] == symbol)
+        {
+          if ([item car] == LEXICAL)
+            return YES;
+          else if ([item car] == SPECIAL)
+            return NO;
+        }
+      rest = [rest cdr];
+    }
+
+  // Has the variable been globally proclaimed special?
+  rest = [MLKLexicalContext globalContext]->_declarations;
+  while (rest)
+    {
+      id item = [rest car];
+      if ([[item cdr] car] == symbol)
+        {
+          if ([item car] == LEXICAL)
+            return YES;
+          else if ([item car] == SPECIAL)
+            return NO;
+        }
+      rest = [rest cdr];
+    }
+
+  return YES;
+}
+
+
+
+// -(void) addVariable:(MLKSymbol *)symbol
+// {
+// }
+
+// -(void) addFunction:(MLKSymbol *)symbol
+// {
+// }
+
+-(void) dealloc
+{
+  RELEASE (_macros);
+  RELEASE (_knownMacros);
+  RELEASE (_symbolMacros);
+  RELEASE (_goTags);
+  RELEASE (_functionLocations);
+  RELEASE (_declarations);
+  RELEASE (_parent);
+  [super dealloc];
+}
+@end