diff options
author | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-07 20:16:53 +0200 |
---|---|---|
committer | Matthias Andreas Benkard <matthias@benkard.de> | 2008-07-07 20:16:53 +0200 |
commit | f47f28ae81b71049496fa96e6f27b3e2794fc9cb (patch) | |
tree | bd21b52cb841b1ef65d71e0add5b0e9c812fe722 /MLKInterpreter.m | |
parent | ffba1c0c3bb96239a7d8b4463d5b78d0455adc40 (diff) |
Interpreter: Establish catch tags in the dynamic context.
Diffstat (limited to 'MLKInterpreter.m')
-rw-r--r-- | MLKInterpreter.m | 38 |
1 files changed, 32 insertions, 6 deletions
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; } |