diff options
| -rw-r--r-- | MLKDynamicContext.h | 5 | ||||
| -rw-r--r-- | MLKDynamicContext.m | 5 | ||||
| -rw-r--r-- | MLKInterpreter.h | 4 | ||||
| -rw-r--r-- | MLKInterpreter.m | 42 | ||||
| -rw-r--r-- | 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"]]; |