diff options
| -rw-r--r-- | MLKDynamicContext.h | 8 | ||||
| -rw-r--r-- | MLKDynamicContext.m | 20 | ||||
| -rw-r--r-- | MLKInterpreter.m | 38 |
3 files changed, 42 insertions, 24 deletions
diff --git a/MLKDynamicContext.h b/MLKDynamicContext.h index 97f24a5..57931e3 100644 --- a/MLKDynamicContext.h +++ b/MLKDynamicContext.h @@ -22,6 +22,7 @@ #import <Foundation/NSObject.h> #import <Foundation/NSDictionary.h> +#import <Foundation/NSSet.h> #import <Foundation/NSString.h> @@ -29,7 +30,7 @@ { MLKEnvironment *_conditionHandlers; MLKEnvironment *_restarts; - MLKEnvironment *_catchTags; + NSSet *_catchTags; MLKEnvironment *_environment; MLKEnvironment *_activeHandlerEnvironment; // needed for the Condition Firewall MLKDynamicContext *_parent; @@ -41,7 +42,7 @@ variables:(NSDictionary *)vars handlers:(NSDictionary *)handlers restarts:(NSDictionary *)restarts - catchTags:(NSDictionary *)catchTags + catchTags:(NSSet *)catchTags activeHandlerEnvironment:(MLKEnvironment *)handlerEnv; +(MLKDynamicContext *) globalContext; @@ -55,7 +56,8 @@ -(id) findRestart:(MLKSymbol *)symbol; -(id) findHandler:(MLKSymbol *)symbol; --(id) findCatchTag:(MLKSymbol *)symbol; + +-(BOOL) catchTagIsEstablished:(id)tag; -(id) valueForSymbol:(MLKSymbol *)symbol; -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol; diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m index 55d6c4e..593f4a7 100644 --- a/MLKDynamicContext.m +++ b/MLKDynamicContext.m @@ -257,7 +257,7 @@ static MLKDynamicContext *global_context; variables:(NSDictionary *)vars handlers:(NSDictionary *)handlers restarts:(NSDictionary *)restarts - catchTags:(NSDictionary *)catchTags + catchTags:(NSSet *)catchTags activeHandlerEnvironment:(MLKEnvironment *)handlerEnv; { self = [super init]; @@ -267,7 +267,7 @@ static MLKDynamicContext *global_context; _parent, _parent->_conditionHandlers); _restarts = MAKE_ENVIRONMENT(restarts, _parent, _parent->_restarts); - _catchTags = MAKE_ENVIRONMENT(catchTags, _parent, _parent->_catchTags); + _catchTags = [[NSSet alloc] initWithSet:catchTags]; ASSIGN (_activeHandlerEnvironment, handlerEnv ? (id) handlerEnv @@ -347,20 +347,10 @@ static MLKDynamicContext *global_context; return nil; } --(id) findCatchTag:(MLKSymbol *)symbol +-(BOOL) catchTagIsEstablished:(id)tag { - NS_DURING - { - NS_VALUERETURN ([_catchTags valueForSymbol:symbol], id); - } - NS_HANDLER - { - if (![[localException name] isEqualToString: @"MLKUnboundVariableError"]) - [localException raise]; - } - NS_ENDHANDLER; - - return nil; + return ([_catchTags containsObject:tag] || + (_parent && [_parent catchTagIsEstablished:tag])); } -(id) valueForSymbol:(MLKSymbol *)symbol diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 0a70f2b..c2d7ba4 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -168,6 +168,7 @@ static MLKSymbol *_LAMBDA; { id catchTag; NSArray *values; + MLKDynamicContext *newctx; NS_DURING { @@ -176,14 +177,29 @@ static MLKSymbol *_LAMBDA; withEnvironment:lexenv] objectAtIndex:0]; + newctx = [[MLKDynamicContext alloc] + initWithParent:dynamicContext + variables:nil + handlers:nil + restarts:nil + catchTags:[NSSet setWithObject:catchTag] + activeHandlerEnvironment:nil]; + [newctx pushContext]; + values = [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]] inLexicalContext:context withEnvironment:lexenv]; + [MLKDynamicContext popContext]; + RELEASE (newctx); + NS_VALUERETURN (values, NSArray *); } NS_HANDLER { + [MLKDynamicContext popContext]; + RELEASE (newctx); + if ([[localException name] isEqualToString:@"MLKThrow"]) { id thrownTag = [[localException userInfo] @@ -502,12 +518,22 @@ static MLKSymbol *_LAMBDA; catchTag, @"THROWN TAG", values, @"THROWN OBJECTS", nil]; - [[NSException exceptionWithName:@"MLKThrow" - reason:[NSString stringWithFormat: - @"THROW without a corresponding CATCH: tag %@, values %@.", - [catchTag descriptionForLisp], - [values descriptionForLisp]] - userInfo:userInfo] raise]; + if ([dynamicContext catchTagIsEstablished:denullify (catchTag)]) + [[NSException exceptionWithName:@"MLKThrow" + reason:[NSString stringWithFormat: + @"THROW: tag %@, values %@.", + [catchTag descriptionForLisp], + [values descriptionForLisp]] + userInfo:userInfo] raise]; + else + // FIXME: This should really be a condition rather than + // an exception. See CLHS THROW. + [[NSException exceptionWithName:@"MLKControlError" + reason:[NSString stringWithFormat: + @"THROW without a corresponding CATCH: tag %@, values %@.", + [catchTag descriptionForLisp], + [values descriptionForLisp]] + userInfo:userInfo] raise]; return nil; } |