From 05fc2a9fd9326bd059681b7684a74e1ad1de1ec6 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Fri, 27 Jun 2008 23:53:25 +0200
Subject: MLKInterpreter: Fix macro support.

---
 MLKDynamicContext.m     |  4 +++-
 MLKInterpreter.m        |  9 ++++++---
 MLKLexicalContext.h     | 10 ++++++----
 MLKLexicalContext.m     | 25 +++++++++++++++++--------
 MLKLexicalEnvironment.m |  4 +++-
 5 files changed, 35 insertions(+), 17 deletions(-)

diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index efc8da4..7b102e6 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -43,7 +43,9 @@
                             ? (id) parent_member                        \
                             : nil)                                      \
                     values:variable]                                    \
-   : (id) (parent ? (id) RETAIN (parent_member) : nil));
+   : (id) (parent                                                       \
+           ? (id) RETAIN (parent_member)                                \
+           : [[MLKEnvironment alloc] init]));
 
 
 static MLKDynamicContext *global_context;
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 35ea2ad..f56e750 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -368,9 +368,12 @@ static MLKSymbol *_LAMBDA;
               else if ([context symbolNamesMacro:car])
                 {
                   id macrofun = [context macroForSymbol:car];
-                  id expansion = [macrofun applyToArray:
-                                             [NSArray arrayWithObjects:
-                                                        program, context, nil]];
+                  id expansion = denullify([[macrofun
+                                              applyToArray:
+                                                [NSArray arrayWithObjects:
+                                                           program, context, nil]]
+                                             objectAtIndex:0]);
+;
                   return [self eval:expansion
                                inLexicalContext:context
                                withEnvironment:lexenv];
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index 552e77d..d7335e6 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -19,6 +19,7 @@
 #import "MLKFuncallable.h"
 #import "MLKLispValue.h"
 
+#import <Foundation/NSArray.h>
 #import <Foundation/NSSet.h>
 
 @class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSLinkedList, NSSet,
@@ -27,8 +28,8 @@
 
 @interface MLKLexicalContext : MLKLispValue
 {
-  NSArray *_knownMacros;
-  NSArray *_knownSymbolMacros;
+  NSMutableSet *_knownMacros;
+  NSMutableSet *_knownSymbolMacros;
   MLKEnvironment *_macros;
   MLKEnvironment *_symbolMacros;
   MLKEnvironment *_goTags;
@@ -62,12 +63,13 @@
 -(BOOL) symbolNamesMacro:(MLKSymbol *)symbol;
 -(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol;
 
--(id) macroForSymbol:(MLKSymbol *)symbol;
+-(id <MLKFuncallable>) macroForSymbol:(MLKSymbol *)symbol;
 -(void) setMacro:(id <MLKFuncallable>)function forSymbol:(MLKSymbol *)symbol;
 -(void) addMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol;
 
--(id) symbolMacroForSymbol:(MLKSymbol *)symbol;
+-(id <MLKFuncallable>) symbolMacroForSymbol:(MLKSymbol *)symbol;
 -(void) setSymbolMacro:(id <MLKFuncallable>)function forSymbol:(MLKSymbol *)symbol;
+-(void) addSymbolMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol;
 
 -(id) goTagForSymbol:(MLKSymbol *)symbol;
 
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index 32c1bf2..7f7e395 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -44,7 +44,9 @@
                             ? (id) parent_member                        \
                             : nil)                                      \
                     values:variable]                                    \
-   : (id) (parent ? (id) RETAIN (parent_member) : nil));
+   : (id) (parent                                                       \
+           ? (id) RETAIN (parent_member)                                \
+           : [[MLKEnvironment alloc] init]));
 
 
 static MLKLexicalContext *global_context;
@@ -92,10 +94,10 @@ static MLKSymbol *LEXICAL;
 
   _goTags = MAKE_ENVIRONMENT (goTags, _parent, _parent->_goTags);
   _macros = MAKE_ENVIRONMENT (macros, _parent, _parent->_macros);
-  _symbolMacros = MAKE_ENVIRONMENT (macros, _parent, _parent->_symbolMacros);
+  _symbolMacros = MAKE_ENVIRONMENT (symbolMacros, _parent, _parent->_symbolMacros);
 
-  ASSIGN (_knownMacros, [macros allKeys]);
-  ASSIGN (_knownSymbolMacros, [symbolMacros allKeys]);
+  ASSIGN (_knownMacros, [NSMutableSet setWithArray:[macros allKeys]]);
+  ASSIGN (_knownSymbolMacros, [NSMutableSet setWithArray:[symbolMacros allKeys]]);
 
   ASSIGN (_declarations, declarations);
   return self;  
@@ -124,26 +126,33 @@ static MLKSymbol *LEXICAL;
   return global_context;
 }
 
--(id) macroForSymbol:(MLKSymbol *)symbol
+-(id <MLKFuncallable>) macroForSymbol:(MLKSymbol *)symbol
 {
   return [_macros valueForSymbol:symbol];
 }
 
 -(void) addMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
-  [_symbolMacros addValue:value forSymbol:symbol];
+  [_knownMacros addObject:symbol];
+  [_macros addValue:value forSymbol:symbol];
 }
 
 -(void) setMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
-  [_symbolMacros setValue:value forSymbol:symbol];
+  [_macros setValue:value forSymbol:symbol];
 }
 
--(id) symbolMacroForSymbol:(MLKSymbol *)symbol
+-(id <MLKFuncallable>) symbolMacroForSymbol:(MLKSymbol *)symbol
 {
   return [_symbolMacros valueForSymbol:symbol];
 }
 
+-(void) addSymbolMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
+{
+  [_knownSymbolMacros addObject:symbol];
+  [_symbolMacros addValue:value forSymbol:symbol];
+}
+
 -(void) setSymbolMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol
 {
   [_symbolMacros setValue:value forSymbol:symbol];
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index 61f09c2..1f7d920 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -43,7 +43,9 @@
                             ? (id) parent_member                        \
                             : nil)                                      \
                     values:variable]                                    \
-   : (id) (parent ? (id) RETAIN (parent_member) : nil));
+   : (id) (parent                                                       \
+           ? (id) RETAIN (parent_member)                                \
+           : [[MLKEnvironment alloc] init]));
 
 
 static MLKLexicalEnvironment *global_environment;
-- 
cgit v1.2.3