From 96870ab2cd94ba6e36585837b69048c544e6d6b6 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 22:04:27 +0200 Subject: Promote special operators SET and %FSET to intrinsics. --- MLKForm.h | 16 ---------------- MLKForm.m | 36 ------------------------------------ MLKInterpreter.m | 53 ----------------------------------------------------- MLKPackage.m | 2 +- MLKRoot.m | 31 +++++++++++++++++++++++++++++++ special-symbols.h | 4 ---- 6 files changed, 32 insertions(+), 110 deletions(-) diff --git a/MLKForm.h b/MLKForm.h index ac08241..bf7c41b 100644 --- a/MLKForm.h +++ b/MLKForm.h @@ -282,22 +282,6 @@ @end -@interface MLKSetForm : MLKCompoundForm -{ - MLKForm *_variableForm; - MLKForm *_valueForm; -} -@end - - -@interface MLKFSetForm : MLKCompoundForm -{ - MLKForm *_functionNameForm; - MLKForm *_valueForm; -} -@end - - @interface MLKThrowForm : MLKCompoundForm { MLKForm *_tagForm; diff --git a/MLKForm.m b/MLKForm.m index 955aa63..19e04ac 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -148,8 +148,6 @@ else if (car == QUOTE) return [MLKQuoteForm class]; else if (car == SETQ) return [MLKSetQForm class]; else if (car == _FSETQ) return [MLKFSetQForm class]; - else if (car == SET) return [MLKSetForm class]; - else if (car == _FSET) return [MLKFSetForm class]; else if (car == THROW) return [MLKThrowForm class]; else if (car == UNWIND_PROTECT) return [MLKUnwindProtectForm class]; else return [MLKSimpleCompoundForm class]; @@ -791,40 +789,6 @@ @end -@implementation MLKSetForm --(id) complete -{ - self = [super complete]; - LASSIGN (_variableForm, MAKE_FORM ([_tail car])); - LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car])); - return self; -} - --(NSArray *) subforms -{ - return [[[super subforms] arrayByAddingObject:_variableForm] - arrayByAddingObject:_valueForm]; -} -@end - - -@implementation MLKFSetForm --(id) complete -{ - self = [super complete]; - LASSIGN (_functionNameForm, MAKE_FORM ([_tail car])); - LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car])); - return self; -} - --(NSArray *) subforms -{ - return [[[super subforms] arrayByAddingObject:_functionNameForm] - arrayByAddingObject:_valueForm]; -} -@end - - @implementation MLKThrowForm -(id) complete { diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 693c742..21adaea 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -1059,59 +1059,6 @@ else RETURN_VALUE (value); } - else if (car == SET) - { - id symbol = [[self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - id value = [[self eval:[[[program cdr] cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - - if (expandOnly) - RETURN_VALUE ([MLKCons cons:SET - with:[MLKCons cons:symbol - with:[MLKCons cons:value - with:nil]]]); - - if ([dynamicContext bindingForSymbol:symbol]) - [dynamicContext 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 - expandOnly:expandOnly] - objectAtIndex:0]; - id value = [[self eval:[[[program cdr] cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - - if (expandOnly) - RETURN_VALUE ([MLKCons cons:_FSET - with:[MLKCons cons:symbol - with:[MLKCons cons:value - with:nil]]]); - - [[MLKLexicalContext globalContext] addFunction:symbol]; - [[MLKLexicalEnvironment globalEnvironment] addFunction:value - forSymbol:symbol]; - - return [NSArray arrayWithObject:symbol]; - } else if (car == THROW) { id catchTag; diff --git a/MLKPackage.m b/MLKPackage.m index acaf6db..9bae8fe 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -101,7 +101,6 @@ static NSMutableDictionary *packages = nil; [cl export:[cl intern:@"VALUES"]]; [cl export:[cl intern:@"EVAL"]]; [cl export:[cl intern:@"SPECIAL"]]; - [cl export:[cl intern:@"SET"]]; [cl export:[cl intern:@"UNWIND-PROTECT"]]; [cl export:[cl intern:@"MULTIPLE-VALUE-CALL"]]; [cl export:[cl intern:@"EVAL-WHEN"]]; @@ -155,6 +154,7 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"DECLARATIONS-AND-DOC-AND-FORMS"]]; [sys export:[sys intern:@"DECLARATIONS-AND-FORMS"]]; [sys export:[sys intern:@"COMPILE"]]; + [sys export:[sys intern:@"SET"]]; [sys export:[sys intern:@"OBJC-CLASS-OF"]]; [sys export:[sys intern:@"OBJC-SUBCLASSP"]]; diff --git a/MLKRoot.m b/MLKRoot.m index b051dd3..0c59c23 100644 --- a/MLKRoot.m +++ b/MLKRoot.m @@ -99,6 +99,10 @@ static id truify (BOOL value) withString:@"_" options:NSLiteralSearch range:NSMakeRange(0, [methodName length])]; + [methodName replaceOccurrencesOfString:@"%" + withString:@"" + options:NSLiteralSearch + range:NSMakeRange(0, [methodName length])]; [methodName appendString:@":"]; selector = NSSelectorFromString (methodName); @@ -715,4 +719,31 @@ as provided by method %@ of object %@", RETURN_VALUE (thing); } #endif + ++(NSArray *) fset:(NSArray *)args +{ + id symbol = denullify ([args objectAtIndex:0]); + id value = denullify ([args objectAtIndex:1]); + + [[MLKLexicalContext globalContext] addFunction:symbol]; + [[MLKLexicalEnvironment globalEnvironment] addFunction:value + forSymbol:symbol]; + + RETURN_VALUE (value); +} + ++(NSArray *) set:(NSArray *)args +{ + id symbol = denullify ([args objectAtIndex:0]); + id value = denullify ([args objectAtIndex:1]); + MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext]; + + if ([dynamicContext bindingForSymbol:symbol]) + [dynamicContext setValue:value forSymbol:symbol]; + else + [[MLKDynamicContext globalContext] addValue:value + forSymbol:symbol]; + + RETURN_VALUE (value); +} @end diff --git a/special-symbols.h b/special-symbols.h index fa68ba7..c455025 100644 --- a/special-symbols.h +++ b/special-symbols.h @@ -44,9 +44,7 @@ static MLKSymbol *EVAL_WHEN; static MLKSymbol *QUOTE; static MLKSymbol *SETQ; static MLKSymbol *SETF; -static MLKSymbol *SET; static MLKSymbol *_FSETQ; -static MLKSymbol *_FSET; static MLKSymbol *SYMBOL_MACROLET; static MLKSymbol *PROGV; static MLKSymbol *UNWIND_PROTECT; @@ -95,9 +93,7 @@ ensure_symbols () QUOTE = [cl intern:@"QUOTE"]; SETQ = [cl intern:@"SETQ"]; SETF = [cl intern:@"SETF"]; - SET = [cl intern:@"SET"]; _FSETQ = [sys intern:@"%FSETQ"]; - _FSET = [sys intern:@"%FSET"]; SYMBOL_MACROLET = [cl intern:@"SYMBOL-MACROLET"]; PROGV = [cl intern:@"PROGV"]; VALUES = [cl intern:@"VALUES"]; -- cgit v1.2.3