From 6b498f0726a38efc7802dad29a47633ad5aed6e7 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Wed, 2 Jul 2008 14:49:02 +0200
Subject: Interpreter: Implement SET and %FSET.

---
 MLKDynamicContext.h |  5 ++++-
 MLKDynamicContext.m |  5 +++++
 MLKInterpreter.h    |  4 ++--
 MLKInterpreter.m    | 42 ++++++++++++++++++++++++++++++++++++++++++
 MLKPackage.m        |  2 ++
 5 files changed, 55 insertions(+), 3 deletions(-)

diff --git a/MLKDynamicContext.h b/MLKDynamicContext.h
index 067dc74..b88e87b 100644
--- a/MLKDynamicContext.h
+++ b/MLKDynamicContext.h
@@ -16,7 +16,9 @@
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-#include <Foundation/NSObject.h>
+#import <Foundation/NSObject.h>
+
+#import "MLKBinding.h"
 
 @class MLKEnvironment, MLKSymbol, NSLinkedList,
        NSMutableDictionary, NSString;
@@ -58,6 +60,7 @@
 -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol;
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol;
 -(void) addBindingForSymbol:(MLKSymbol *)symbol;
+-(MLKBinding *) bindingForSymbol:(MLKSymbol *)symbol;
 
 -(BOOL) boundp:(MLKSymbol *)symbol;
 -(void) makunbound:(MLKSymbol *)symbol;
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index f0d25b9..4261da3 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -381,6 +381,11 @@ static MLKDynamicContext *global_context;
   [[self environment] addBindingForSymbol:symbol];
 }
 
+-(MLKBinding *) bindingForSymbol:(MLKSymbol *)symbol
+{
+  return [[self environment] bindingForSymbol:symbol];
+}
+
 -(BOOL) boundp:(MLKSymbol *)symbol
 {
   return [[self environment] boundp:symbol];
diff --git a/MLKInterpreter.h b/MLKInterpreter.h
index b96722f..788dfe1 100644
--- a/MLKInterpreter.h
+++ b/MLKInterpreter.h
@@ -17,12 +17,12 @@
  */
 
 #import "MLKStream.h"
+#import "MLKLexicalContext.h"
+#import "MLKLexicalEnvironment.h"
 
 #import <Foundation/NSArray.h>
 #import <Foundation/NSObject.h>
 
-@class MLKLexicalContext, MLKLexicalEnvironment;
-
 
 @interface MLKInterpreter : NSObject
 +(void) initialize;
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 95381d0..5dd6cc7 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -69,6 +69,8 @@ static MLKSymbol *FUNCALL;
 static MLKSymbol *EVAL;
 static MLKSymbol *QUOTE;
 static MLKSymbol *SETQ;
+static MLKSymbol *SET;
+static MLKSymbol *_FSET;
 static MLKSymbol *PROGV;
 static MLKSymbol *VALUES;
 static MLKSymbol *_DEFMACRO;
@@ -94,6 +96,8 @@ static MLKSymbol *_LAMBDA;
   EVAL = [cl intern:@"EVAL"];
   QUOTE = [cl intern:@"QUOTE"];
   SETQ = [cl intern:@"SETQ"];
+  SET = [cl intern:@"SET"];
+  _FSET = [sys intern:@"%FSET"];
   PROGV = [cl intern:@"PROGV"];
   VALUES = [cl intern:@"VALUES"];
   _DEFMACRO = [sys intern:@"%DEFMACRO"];
@@ -350,6 +354,44 @@ static MLKSymbol *_LAMBDA;
               //FIXME: ...
               //FIXME: Don't forget handling symbol macros correctly.
             }
+          else if (car == SET)
+            {
+              MLKDynamicContext *ctx = [MLKDynamicContext currentContext];
+              id symbol = [[self eval:[[program cdr] car]
+                                 inLexicalContext:context
+                                 withEnvironment:lexenv]
+                           objectAtIndex:0];
+              id value = [[self eval:[[[program cdr] cdr] car]
+                                inLexicalContext:context
+                                withEnvironment:lexenv]
+                          objectAtIndex:0];
+
+              if ([ctx bindingForSymbol:symbol])
+                [ctx setValue:value forSymbol:symbol];
+              else
+                [[MLKDynamicContext globalContext]
+                  addValue:value forSymbol:symbol];
+
+              return [NSArray arrayWithObject:symbol];
+            }
+          else if (car == _FSET)
+            {
+              // Like SET, but for the function cell.
+              id symbol = [[self eval:[[program cdr] car]
+                                 inLexicalContext:context
+                                 withEnvironment:lexenv]
+                            objectAtIndex:0];
+              id value = [[self eval:[[[program cdr] cdr] car]
+                                inLexicalContext:context
+                                withEnvironment:lexenv]
+                           objectAtIndex:0];
+
+              [[MLKLexicalContext globalContext] addFunction:symbol];
+              [[MLKLexicalEnvironment globalEnvironment] addFunction:value
+                                                         forSymbol:symbol];
+
+              return [NSArray arrayWithObject:symbol];
+            }
           else if (car == TAGBODY)
             {
               //FIXME: ...
diff --git a/MLKPackage.m b/MLKPackage.m
index 84b53eb..26d62c6 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -74,9 +74,11 @@ static NSMutableDictionary *packages = nil;
   [cl export:[cl intern:@"VALUES"]];
   [cl export:[cl intern:@"EVAL"]];
   [cl export:[cl intern:@"SPECIAL"]];
+  [cl export:[cl intern:@"SET"]];
 
   [sys export:[sys intern:@"%DEFMACRO"]];
   [sys export:[sys intern:@"%LAMBDA"]];
+  [sys export:[sys intern:@"%FSET"]];
   
   [sys export:[sys intern:@"CAR"]];
   [sys export:[sys intern:@"CDR"]];
-- 
cgit v1.2.3