summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MLKDynamicContext.h5
-rw-r--r--MLKDynamicContext.m5
-rw-r--r--MLKInterpreter.h4
-rw-r--r--MLKInterpreter.m42
-rw-r--r--MLKPackage.m2
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"]];