From f47f28ae81b71049496fa96e6f27b3e2794fc9cb Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Mon, 7 Jul 2008 20:16:53 +0200
Subject: Interpreter: Establish catch tags in the dynamic context.

---
 MLKInterpreter.m | 38 ++++++++++++++++++++++++++++++++------
 1 file changed, 32 insertions(+), 6 deletions(-)

(limited to 'MLKInterpreter.m')

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;
             }
-- 
cgit v1.2.3