Refactor the interpreter so as to build upon the MLKForm class cluster.

The transition is not finished yet, so lots of things are broken right now.

1 files changed, 573 insertions, 1115 deletions

diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 7fd59ad..334b33c 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -65,1126 +65,24 @@
   ensure_symbols ();
 }
 
-
-+(NSArray*) eval:(id)program
-            inLexicalContext:(MLKLexicalContext *)context
-            withEnvironment:(MLKLexicalEnvironment *)lexenv
++(id) compile:(id)object inContext:(MLKLexicalContext *)context
 {
-  return (NSArray *)[self eval:program
-                          inLexicalContext:context
-                          withEnvironment:lexenv
-                          expandOnly:NO];
+  return [[self eval:object
+                inLexicalContext:context
+                withEnvironment:[MLKLexicalEnvironment globalEnvironment]]
+          objectAtIndex:0];
 }
 
-
 +(NSArray*) eval:(id)program
             inLexicalContext:(MLKLexicalContext *)context
             withEnvironment:(MLKLexicalEnvironment *)lexenv
-            expandOnly:(BOOL)expandOnly
 {
-  return [self eval:program
-               inLexicalContext:context
-               withEnvironment:lexenv
-               mode:(expandOnly ? expand_mode : eval_mode)];
-}
-
-
-#define RETURN_VALUE(thing)                     \
-  { return [NSArray arrayWithObject:nullify(thing)]; }
-
-
-+(NSArray*) eval:(id)program
-            inLexicalContext:(MLKLexicalContext *)context
-            withEnvironment:(MLKLexicalEnvironment *)lexenv
-            mode:(enum MLKProcessingMode)mode
-{
-  MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
-  BOOL expandOnly = (mode != eval_mode);
-
-#define TRACE_EVAL 0
-#if TRACE_EVAL
-  BOOL trace = NO;
-
-  if ([dynamicContext valueForSymbol:V_INITP])
-    trace = YES;
-
-  if (trace)
-    NSLog (@"; EVAL: %@", MLKPrintToString(program));
-#endif  // TRACE_EVAL
-
-  if (MLKFixnumP (program))
-    {
-      // Fixnums evaluate to themselves.
-      //
-      // We need to get this case out of the way as early as possible,
-      // as we're going to repeatedly send messages to `program' after
-      // this point.
-      RETURN_VALUE (program);
-    }
-  else if (!program || [program isKindOfClass:[MLKSymbol class]])
-    {
-      if (mode == compile_time_too_mode)
-        {
-          if (![context symbolNamesSymbolMacro:program])
-            {
-              return [self eval:program
-                           inLexicalContext:context
-                           withEnvironment:lexenv
-                           mode:expand_mode];
-            }
-        }
-
-      //NSLog (@"Processing symbol.");
-      if ([context symbolNamesSymbolMacro:program])
-        {
-          id macrofun, expansion;
-
-          macrofun = [context macroForSymbol:program];
-          expansion = [macrofun applyToArray:
-                                  [NSArray arrayWithObjects:
-                                             program, context, nil]];
-
-          return [self eval:expansion
-                       inLexicalContext:context
-                       withEnvironment:lexenv
-                       mode:mode];
-        }
-      else if ([context variableIsLexical:program])
-        {
-          //NSLog (@"Processing lexical variable %@.", MLKPrintToString(program));
-          //NSLog (@"Lexical environment: %@.", lexenv);
-          //NSLog (@"Lexical variable value: %@.", [lexenv valueForSymbol:program]);
-          if (expandOnly)
-            RETURN_VALUE (program);
-
-          RETURN_VALUE ([lexenv valueForSymbol:program]);
-        }
-      else
-        {
-          //NSLog (@"Processing special variable %@.", MLKPrintToString(program));
-          //NSLog (@"Dynamic context: %@.", dynamicContext);
-          //NSLog (@"Special variable value: %@.", [dynamicContext valueForSymbol:program]);
-          if (expandOnly)
-            RETURN_VALUE (program);
-
-          RETURN_VALUE ([dynamicContext valueForSymbol:program]);
-        }
-    }
-  else if (![program isKindOfClass:[MLKCons class]])
-    {
-      // Everything that is not a list or a symbol evaluates to itself.
-      RETURN_VALUE (program);
-    }
-  else
-    {
-      id car = [program car];
-
-      if ([car isKindOfClass:[MLKSymbol class]] || !car)
-        {
-          if (mode == compile_time_too_mode)
-            {
-              if (!([context symbolNamesMacro:program]
-                    || car == _MACROLET || car == LOCALLY
-                    || car == SYMBOL_MACROLET || car == PROGN))
-                {
-                  return [self eval:program
-                               inLexicalContext:context
-                               withEnvironment:lexenv
-                               mode:expand_mode];
-                }
-            }
-
-          if (car == CATCH)
-            {
-              id catchTag;
-              NSArray *values;
-              MLKDynamicContext *newctx;
-
-              catchTag = [[self eval:[[program cdr] car]
-                                inLexicalContext:context
-                                withEnvironment:lexenv
-                                expandOnly:expandOnly]
-                           objectAtIndex:0];
-                  
-              NS_DURING
-                {
-                  if (!expandOnly)
-                    {
-                      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
-                                 expandOnly:expandOnly];
-
-                  if (expandOnly)
-                    NS_VALUERETURN ([NSArray arrayWithObject:
-                                               [MLKCons
-                                                 cons:CATCH
-                                                 with:[MLKCons
-                                                        cons:catchTag
-                                                        with:[[values
-                                                                objectAtIndex:0]
-                                                               cdr]]]],
-                                    NSArray *);
-
-                  [MLKDynamicContext popContext];
-                  LRELEASE (newctx);
-
-                  NS_VALUERETURN (values, NSArray *);
-                }
-              NS_HANDLER
-                {
-                  [MLKDynamicContext popContext];
-                  LRELEASE (newctx);
-
-                  if ([[localException name] isEqualToString:@"MLKThrow"])
-                    {
-                      id thrownTag = [[localException userInfo]
-                                       objectForKey:@"THROWN TAG"];
-
-                      if (thrownTag == catchTag)
-                        return [[localException userInfo]
-                                 objectForKey:@"THROWN OBJECTS"];
-                      else
-                        [localException raise];
-                    }
-                  else
-                    [localException raise];
-                }
-              NS_ENDHANDLER;
-
-              return nil;
-            }
-          else if (car == EVAL)
-            {
-              NSArray *evaluand = denullify([[self eval:[[program cdr] car]
-                                                   inLexicalContext:context
-                                                   withEnvironment:lexenv
-                                                   expandOnly:expandOnly]
-                                              objectAtIndex:0]);
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:EVAL with:[MLKCons cons:evaluand with:nil]]);
-
-              return [self eval:evaluand
-                           inLexicalContext:[MLKLexicalContext globalContext]
-                           withEnvironment:[MLKLexicalEnvironment
-                                             globalEnvironment]];
-            }
-          else if (car == EVAL_WHEN)
-            {
-              id situationList = [[program cdr] car];
-              id body = [[program cdr] cdr];
-              NSArray *situations;
-              BOOL ct, lt, e;
-
-              if (!situationList)
-                RETURN_VALUE (nil);
-
-              situations = [situationList array];
-              ct = ([situations containsObject:COMPILE_TOPLEVEL]
-                    || [situations containsObject:COMPILE]);
-              lt = ([situations containsObject:LOAD_TOPLEVEL]
-                    || [situations containsObject:LOAD]);
-              e = ([situations containsObject:EXECUTE]
-                   || [situations containsObject:EVAL]);
-
-              switch (mode)
-                {
-                case eval_mode:
-                case expand_mode:
-                  if (e)
-                    return [self eval:[MLKCons cons:PROGN with:body]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv
-                                 mode:mode];
-                  else
-                    RETURN_VALUE (nil);
-
-                case compile_time_too_mode:
-                case not_compile_time_mode:
-                  if ((ct && lt)
-                      || (lt && e && (mode == compile_time_too_mode)))
-                    {
-                      return [self eval:[MLKCons cons:PROGN with:body]
-                                   inLexicalContext:context
-                                   withEnvironment:lexenv
-                                   mode:compile_time_too_mode];
-                    }
-                  else if (lt)
-                    {
-                      return [self eval:[MLKCons cons:PROGN with:body]
-                                   inLexicalContext:context
-                                   withEnvironment:lexenv
-                                   mode:not_compile_time_mode];
-                    }
-                  else if (ct || (e && mode == compile_time_too_mode))
-                    {
-                      [self eval:[MLKCons cons:PROGN with:body]
-                            inLexicalContext:context
-                            withEnvironment:lexenv];
-                      RETURN_VALUE (nil);
-                    }
-                  else
-                    {
-                      RETURN_VALUE (nil);
-                    }
-                }
-            }
-          else if (car == _FOREIGN_LAMBDA)
-            {
-              int (*function)();
-              NSString *name = [[program cdr] car];
-              id libraryDesignator = [[[program cdr] cdr] car];
-              id argtypes = [[[[program cdr] cdr] cdr] car];
-              id returnType = [[[[[program cdr] cdr] cdr] cdr] car];
-
-              // FIXME: Support library designators.
-
-#ifdef _WIN32
-              // FIXME
-              //EnumProcessModules (...);
-              //GetProcAddress (..., [name UTF8String]);
-#else
-              function = dlsym (RTLD_DEFAULT, [name UTF8String]);
-#endif
-
-              RETURN_VALUE (LAUTORELEASE ([[MLKForeignProcedure alloc]
-                                            initWithCode:function
-                                            argumentTypes:[argtypes array]
-                                            returnType:returnType]));
-            }
-          else if (car == FUNCTION)
-            {
-              id functionName = [[program cdr] car];
-
-              if ([functionName isKindOfClass:[MLKCons class]]
-                  && ([functionName car] == LAMBDA
-                      || [functionName car] == _LAMBDA))
-                {
-                  return [self eval:functionName
-                               inLexicalContext:context
-                               withEnvironment:lexenv
-                               expandOnly:expandOnly];
-                }
-              else if (expandOnly)
-                {
-                  RETURN_VALUE (program);
-                }
-              else
-                {
-                  // FIXME: Function names need not be symbols.
-                  id <MLKFuncallable> function =
-                    [lexenv functionForSymbol:functionName];
-                  RETURN_VALUE (function);
-                }
-            }
-          else if (car == IF)
-            {
-              id condition = [[program cdr] car];
-              id consequent = [[[program cdr] cdr] car];
-              // Incidentally works for the two-clause case:
-              id alternative = [[[[program cdr] cdr] cdr] car];
-
-              id condition_value = denullify([[self eval:condition
-                                                    inLexicalContext:context
-                                                    withEnvironment:lexenv
-                                                    expandOnly:expandOnly]
-                                               objectAtIndex:0]);
-
-              if (expandOnly)
-                {
-                  id conseq_expansion = denullify([[self eval:consequent
-                                                         inLexicalContext:context
-                                                         withEnvironment:lexenv
-                                                         expandOnly:expandOnly]
-                                                    objectAtIndex:0]);
-                  id alt_expansion = denullify([[self eval:alternative
-                                                      inLexicalContext:context
-                                                      withEnvironment:lexenv
-                                                      expandOnly:expandOnly]
-                                                 objectAtIndex:0]);
-                  RETURN_VALUE ([MLKCons
-                                  cons:IF
-                                  with:[MLKCons
-                                         cons:condition_value
-                                         with:[MLKCons
-                                                cons:conseq_expansion
-                                                with:[MLKCons cons:alt_expansion
-                                                              with:nil]]]]);
-                }
-
-              if (!condition_value)
-                return [self eval:alternative
-                             inLexicalContext:context
-                             withEnvironment:lexenv
-                             expandOnly:expandOnly];
-              else
-                return [self eval:consequent
-                             inLexicalContext:context
-                             withEnvironment:lexenv
-                             expandOnly:expandOnly];                
-            }
-          else if (car == IN_PACKAGE)
-            {
-              if (expandOnly)
-                RETURN_VALUE (program);
-
-              id cadr = [[program cdr] car];
-              id package = [MLKPackage findPackage:stringify(cadr)];
-
-              [[MLKDynamicContext currentContext]
-                setValue:package
-                forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
-                            intern:@"*PACKAGE*"]];
-
-              RETURN_VALUE (package);
-            }
-          else if (car == _LAMBDA)
-            {
-              // A bare-bones LAMBDA without a real lambda list.  What
-              // would be a lambda list in a real LAMBDA form must be a
-              // symbol here.
-              id lambdaList = [[program cdr] car];
-              id body = [[program cdr] cdr];
-              MLKInterpretedClosure *closure;
-
-              if (expandOnly)
-                {
-                  id body_expansion = denullify([[self eval:[MLKCons cons:PROGN
-                                                                     with:body]
-                                                       inLexicalContext:context
-                                                       withEnvironment:lexenv
-                                                       expandOnly:expandOnly]
-                                                  objectAtIndex:0]);
-                  RETURN_VALUE ([MLKCons
-                                  cons:_LAMBDA
-                                  with:[MLKCons cons:lambdaList
-                                                with:[MLKCons cons:body_expansion
-                                                              with:nil]]]);
-                }
-
-              closure = LAUTORELEASE ([[MLKInterpretedClosure alloc]
-                                       initWithBodyForms:body
-                                       lambdaListName:lambdaList
-                                       context:context
-                                       environment:lexenv]);
-              return [NSArray arrayWithObject:nullify(closure)];
-            }
-          else if (car == _MACROLET)
-            {
-              id declarations, doc;
-              id clauses;
-              id body;
-              NSArray *result;
-              MLKLexicalContext *ctx;
-
-              MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr], NO);
-              ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
-                                   initWithParent:context
-                                   variables:nil
-                                   functions:nil
-                                   goTags:nil
-                                   macros:nil
-                                   compilerMacros:nil
-                                   symbolMacros:nil
-                                   declarations:declarations]);
-
-              clauses = [[program cdr] car];
-              while (clauses)
-                {
-                  id clause = [clauses car];
-                  id name, value;
-
-                  name = [clause car];
-                  value = denullify([[self eval:[MLKCons cons:_LAMBDA
-                                                         with:[clause cdr]]
-                                           inLexicalContext:context
-                                           withEnvironment:lexenv
-                                           expandOnly:NO]  //!
-                                      objectAtIndex:0]);
-
-                  [ctx addMacro:value forSymbol:name];
-
-                  clauses = [clauses cdr];
-                }
-
-              result = [self eval:[MLKCons cons:PROGN with:body]
-                             inLexicalContext:ctx
-                             withEnvironment:lexenv
-                             mode:mode];
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons
-                                  cons:LET
-                                  with:[MLKCons
-                                         cons:nil
-                                         with:[MLKCons
-                                                cons:[MLKCons cons:DECLARE
-                                                              with:declarations]
-                                                with:[[result objectAtIndex:0] cdr]]]]);
-                }
-              else
-                {
-                  return result;
-                }
-            }
-          else if (car == _FLET)
-            {
-              id declarations, doc;
-              id clauses;
-              NSMutableArray *new_clauses;
-              id body;
-              NSArray *result;
-              MLKLexicalContext *ctx;
-              MLKLexicalEnvironment *env;
-
-              MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr], NO);
-
-              ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
-                                   initWithParent:context
-                                   variables:nil
-                                   functions:nil
-                                   goTags:nil
-                                   macros:nil
-                                   compilerMacros:nil
-                                   symbolMacros:nil
-                                   declarations:declarations]);
-
-              if (!expandOnly)
-                env = LAUTORELEASE ([[MLKLexicalEnvironment alloc]
-                                     initWithParent:lexenv
-                                     variables:nil
-                                     functions:nil]);
-
-              clauses = [[program cdr] car];
-              new_clauses = [NSMutableArray array];
-              while (clauses)
-                {
-                  id clause = [clauses car];
-                  id name, value;
-
-                  name = [clause car];
-
-                  value = denullify([[self eval:[MLKCons cons:_LAMBDA
-                                                         with:[clause cdr]]
-                                           inLexicalContext:context
-                                           withEnvironment:lexenv
-                                           expandOnly:expandOnly]
-                                      objectAtIndex:0]);
-
-                  [ctx addFunction:name];
-
-                  if (!expandOnly)
-                    [env addFunction:value forSymbol:name];
-                  else
-                    [new_clauses addObject:[MLKCons cons:name with:[value cdr]]];
-
-                  clauses = [clauses cdr];
-                }
-
-              result = [self eval:[MLKCons cons:PROGN with:body]
-                             inLexicalContext:ctx
-                             withEnvironment:(expandOnly ? lexenv : env)
-                             expandOnly:expandOnly];
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons
-                                  cons:_FLET
-                                  with:[MLKCons
-                                         cons:[MLKCons listWithArray:new_clauses]
-                                         with:[MLKCons
-                                                cons:[MLKCons cons:DECLARE
-                                                              with:declarations]
-                                                with:[[result objectAtIndex:0] cdr]]]]);
-                }
-              else
-                {
-                  return result;
-                }
-            }
-          else if (car == LET)
-            {
-              id declarations, doc;
-              id clauses;
-              id body;
-              NSArray *result;
-              NSMutableArray *new_clauses;
-              MLKLexicalContext *ctx;
-              MLKLexicalEnvironment *env;
-              MLKDynamicContext *dynctx;
-
-              MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr], NO);
-
-              ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
-                                   initWithParent:context
-                                   variables:nil
-                                   functions:nil
-                                   goTags:nil
-                                   macros:nil
-                                   compilerMacros:nil
-                                   symbolMacros:nil
-                                   declarations:declarations]);
-
-              if (!expandOnly)
-                {
-                  env = LAUTORELEASE ([[MLKLexicalEnvironment alloc]
-                                       initWithParent:lexenv
-                                       variables:nil
-                                       functions:nil]);
-
-                  dynctx = [[MLKDynamicContext alloc]
-                             initWithParent:dynamicContext
-                             variables:nil
-                             handlers:nil
-                             restarts:nil
-                             catchTags:nil
-                             activeHandlerEnvironment:nil];
-                }
-
-              clauses = [[program cdr] car];
-              new_clauses = [NSMutableArray array];
-              while (clauses)
-                {
-                  id clause = [clauses car];
-                  id variable, value;
-
-                  if (!clause || [clause isKindOfClass:[MLKSymbol class]])
-                    {
-                      variable = clause;
-                      value = nil;
-                    }
-                  else if ([clause cdr] == nil)
-                    {
-                      variable = [clause car];
-                      value = nil;
-                    }
-                  else
-                    {
-                      variable = [clause car];
-                      value = denullify([[self eval:[[clause cdr] car]
-                                               inLexicalContext:context
-                                               withEnvironment:lexenv
-                                               expandOnly:expandOnly]
-                                          objectAtIndex:0]);
-                    }
-
-                  if (expandOnly)
-                    {
-                      [new_clauses addObject:[MLKCons cons:variable
-                                                      with:[MLKCons cons:value
-                                                                    with:nil]]];
-                    }
-                  else
-                    {
-                      [ctx addVariable:variable];
-                      if ([ctx variableIsLexical:variable])
-                        {
-                          [env addValue:value forSymbol:variable];
-                        }
-                      else
-                        {
-                          [dynctx addValue:value forSymbol:variable];
-                        }
-                    }
-
-                  clauses = [clauses cdr];
-                }
-
-              if (expandOnly)
-                {
-                  result = [self eval:[MLKCons cons:PROGN with:body]
-                                 inLexicalContext:ctx
-                                 withEnvironment:lexenv
-                                 expandOnly:YES];
-
-                  RETURN_VALUE ([MLKCons
-                                  cons:LET
-                                  with:[MLKCons
-                                         cons:[MLKCons listWithArray:new_clauses]
-                                         with:[MLKCons
-                                                cons:[MLKCons cons:DECLARE
-                                                              with:declarations]
-                                                with:[[result objectAtIndex:0] cdr]]]]);
-                }
-              else
-                {
-                  [dynctx pushContext];
-
-                  NS_DURING
-                    {
-                      result = [self eval:[MLKCons cons:PROGN with:body]
-                                     inLexicalContext:ctx
-                                     withEnvironment:env
-                                     expandOnly:NO];
-                    }
-                  NS_HANDLER
-                    {
-                      [MLKDynamicContext popContext];
-                      [localException raise];
-                    }
-                  NS_ENDHANDLER;
-
-                  [MLKDynamicContext popContext];
-                  LRELEASE (dynctx);
-
-                  return result;
-                }
-            }
-          else if (car == _LOOP)
-            {
-              id rest;
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons cons:_LOOP
-                                         with:[[[self eval:[MLKCons cons:PROGN
-                                                                    with:[program cdr]]
-                                                      inLexicalContext:context
-                                                      withEnvironment:lexenv
-                                                      expandOnly:YES]
-                                                 objectAtIndex:0]
-                                                cdr]]);
-                }
-
-              while (YES)
-                {
-                  rest = program;
-                  while ((rest = [rest cdr]))
-                    {
-                      [self eval:[rest car]
-                            inLexicalContext:context
-                            withEnvironment:lexenv
-                            expandOnly:expandOnly];
-                    }
-                }
-
-              RETURN_VALUE (nil);  // never reached
-            }
-          else if (car == MULTIPLE_VALUE_CALL)
-            {
-              NSMutableArray *results = [NSMutableArray array];
-              id rest = [program cdr];
-              id function = [[self eval:[rest car]
-                                   inLexicalContext:context
-                                   withEnvironment:lexenv
-                                   mode:mode]
-                              objectAtIndex:0];
-
-              while ((rest = [rest cdr]))
-                {
-                  id values = [self eval:[rest car]
-                                    inLexicalContext:context
-                                    withEnvironment:lexenv
-                                    mode:mode];
-                  [results addObjectsFromArray:values];
-                }
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons
-                                  cons:MULTIPLE_VALUE_CALL
-                                  with:[MLKCons
-                                         cons:function
-                                         with:[MLKCons
-                                                listWithArray:results]]]);
-                }
-              else
-                {
-                  return [function applyToArray:results];
-                }
-            }
-          else if (car == PROGN)
-            {
-              id result = nil;
-              id rest = program;
-              NSMutableArray *results = [NSMutableArray array];
-              while ((rest = [rest cdr]))
-                {
-                  result = [self eval:[rest car]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv
-                                 mode:mode];
-                  if (expandOnly)
-                    [results addObjectsFromArray:result];
-                }
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons cons:PROGN
-                                         with:[MLKCons listWithArray:results]]);
-                }
-              else
-                return result;
-            }
-          else if (car == PROGV)
-            {
-              id variables, values, body, result;
-              MLKDynamicContext *dynctx;
-
-              if (expandOnly)
-                {
-                  RETURN_VALUE ([MLKCons
-                                  cons:PROGV
-                                  with:[denullify([[self eval:[MLKCons
-                                                                cons:PROGN
-                                                                with:[program cdr]]
-                                                         inLexicalContext:context
-                                                         withEnvironment:lexenv
-                                                         mode:mode]
-                                                    objectAtIndex:0]) cdr]]);
-                }
-
-              dynctx = [[MLKDynamicContext alloc]
-                         initWithParent:dynamicContext
-                         variables:nil
-                         handlers:nil
-                         restarts:nil
-                         catchTags:nil
-                         activeHandlerEnvironment:nil];
-
-              body = [[[program cdr] cdr] cdr];
-              variables = denullify ([[self eval:[[program cdr] car]
-                                            inLexicalContext:context
-                                            withEnvironment:lexenv]
-                                       objectAtIndex:0]);
-              values = denullify ([[self eval:[[[program cdr] cdr] car]
-                                         inLexicalContext:context
-                                         withEnvironment:lexenv]
-                                    objectAtIndex:0]);
-
-              for (; variables; (variables = [variables cdr], values = [values cdr]))
-                {
-                  id var = [variables car];
-                  id value = [values car];
-
-                  [dynctx addValue:value forSymbol:var];
-                }
-
-              [dynctx pushContext];
-
-              NS_DURING
-                {
-                  result = [self eval:[MLKCons cons:PROGN with:body]
-                                 inLexicalContext:context
-                                 withEnvironment:lexenv];
-                }
-              NS_HANDLER
-                {
-                  [MLKDynamicContext popContext];
-                  [localException raise];
-                }
-              NS_ENDHANDLER;
-
-              [MLKDynamicContext popContext];
-              LRELEASE (dynctx);
-
-              return result;
-            }
-          else if (car == QUOTE)
-            {
-              if (expandOnly)
-                RETURN_VALUE (program);
-              RETURN_VALUE ([[program cdr] car]);
-            }
-          else if (car == SETQ || car == _FSETQ)
-            {
-              id symbol = [[program cdr] car];
-              id value = [[self eval:[[[program cdr] cdr] car]
-                                inLexicalContext:context
-                                withEnvironment:lexenv
-                                expandOnly:expandOnly]
-                           objectAtIndex:0];
-              id rest = [[[program cdr] cdr] cdr];
-
-              if (![program cdr])
-                RETURN_VALUE (nil);
-
-              if (car == SETQ && [context symbolNamesSymbolMacro:symbol])
-                {
-                  id macrofun = [context symbolMacroForSymbol:symbol];
-                  id expansion = [macrofun applyToArray:
-                                             [NSArray arrayWithObjects:
-                                                        program, context, nil]];
-                  return [self eval:
-                                 [MLKCons cons:SETF
-                                          with:
-                                            [MLKCons cons:expansion
-                                                     with:
-                                                       [[program cdr] cdr]]]
-                               inLexicalContext:context
-                               withEnvironment:lexenv
-                               expandOnly:expandOnly];
-                }
-
-              if (expandOnly)
-                {
-                  id thisSETQ = [MLKCons
-                                  cons:car
-                                  with:[MLKCons
-                                         cons:symbol
-                                         with:[MLKCons
-                                                cons:value
-                                                with:nil]]];
-                  id more = denullify([[self eval:[MLKCons cons:car with:rest]
-                                             inLexicalContext:context
-                                             withEnvironment:lexenv
-                                             expandOnly:expandOnly]
-                                        objectAtIndex:0]);
-
-                  if (!more)
-                    {
-                      RETURN_VALUE (thisSETQ);
-                    }
-                  else
-                    {
-                      RETURN_VALUE ([MLKCons cons:PROGN
-                                             with:[MLKCons
-                                                    cons:thisSETQ
-                                                    with:[MLKCons
-                                                           cons:more
-                                                           with:nil]]]);
-                      
-                    }
-                }
-
-              if (car == _FSETQ)
-                {
-                  if ([context symbolNamesFunction:symbol])
-                    {
-                      [lexenv setFunction:value forSymbol:symbol];
-                    }
-                  else
-                    {
-                      // FIXME: Maybe print a warning.
-                      [[MLKLexicalContext globalContext] addFunction:symbol];
-                      [[MLKLexicalEnvironment globalEnvironment]
-                        addFunction:value
-                        forSymbol:symbol];
-                    }
-                }
-              else if ([context variableIsLexical:symbol])
-                [lexenv setValue:value forSymbol:symbol];
-              else if ([dynamicContext bindingForSymbol:symbol])
-                [dynamicContext setValue:value forSymbol:symbol];
-              else
-                // FIXME: Maybe print a warning.
-                [[MLKDynamicContext globalContext] addValue:value
-                                                   forSymbol:symbol];
-
-
-              if (rest)
-                return [self eval:[MLKCons cons:car with:rest]
-                             inLexicalContext:context
-                             withEnvironment:lexenv];
-              else
-                RETURN_VALUE (value);
-            }
-          else if (car == THROW)
-            {
-              id catchTag;
-              NSArray *values;
-              NSDictionary *userInfo;
-
-              catchTag = [[self eval:[[program cdr] car]
-                                inLexicalContext:context
-                                withEnvironment:lexenv
-                                expandOnly:expandOnly]
-                           objectAtIndex:0];
-
-              values = [self eval:[[[program cdr] cdr] car]
-                             inLexicalContext:context
-                             withEnvironment:lexenv
-                             expandOnly:expandOnly];
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:THROW
-                                       with:[MLKCons cons:denullify(catchTag)
-                                                     with:[MLKCons cons:denullify([values objectAtIndex:0])
-                                                                   with:nil]]]);
-
-              userInfo = [NSDictionary dictionaryWithObjectsAndKeys:
-                                         catchTag, @"THROWN TAG",
-                                         values, @"THROWN OBJECTS", nil];
-
-              if ([dynamicContext catchTagIsEstablished:denullify (catchTag)])
-                [[NSException exceptionWithName:@"MLKThrow"
-                              reason:[NSString stringWithFormat:
-                                                 @"THROW: tag %@, values %@.",
-                                               MLKPrintToString(catchTag),
-                                               MLKPrintToString(values)]
-                              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 %@.",
-                                               MLKPrintToString(catchTag),
-                                               MLKPrintToString(values)]
-                              userInfo:userInfo] raise];
-
-              return nil;
-            }
-          else if (car == UNWIND_PROTECT)
-            {
-              NSArray *results;
-
-              if (expandOnly)
-                {
-                  id protectee = [self eval:[[program cdr] car]
-                                       inLexicalContext:context
-                                       withEnvironment:lexenv
-                                       expandOnly:expandOnly];
-                  id protection = [self eval:[MLKCons cons:PROGN
-                                                      with:[[program cdr] cdr]]
-                                        inLexicalContext:context
-                                        withEnvironment:lexenv
-                                        expandOnly:expandOnly];
-                  RETURN_VALUE ([MLKCons cons:UNWIND_PROTECT
-                                         with:[MLKCons cons:protectee
-                                                       with:[MLKCons cons:protection
-                                                                     with:nil]]]);
-                }
-
-              NS_DURING
-                {
-                  results = [self eval:[[program cdr] car]
-                                  inLexicalContext:context
-                                  withEnvironment:lexenv];
-                }
-              NS_HANDLER
-                {
-                  [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]]
-                        inLexicalContext:context
-                        withEnvironment:lexenv
-                        expandOnly:expandOnly];
-
-                  [localException raise];
-                }
-              NS_ENDHANDLER;
-
-              [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]]
-                    inLexicalContext:context
-                    withEnvironment:lexenv];
-
-              return results;
-            }
-          else
-            {
-              if ([context symbolNamesFunction:car])
-                {
-                  id function;
-                  MLKCons *rest = [program cdr];
-                  NSMutableArray *args = [NSMutableArray array];
-                  
-                  while (rest)
-                    {
-                      id result = [[self eval:[rest car]
-                                         inLexicalContext:context
-                                         withEnvironment:lexenv
-                                         expandOnly:expandOnly]
-                                    objectAtIndex:0];
-                      [args addObject:result];
-                      rest = [rest cdr];
-                    }
-
-                  if (expandOnly)
-                    {
-                      RETURN_VALUE ([MLKCons cons:[program car]
-                                             with:[MLKCons listWithArray:args]]);
-                    }
-                  else
-                    {
-                      function = [lexenv functionForSymbol:car];
-                      return [function applyToArray:args];
-                    }
-                }
-              else if ([context symbolNamesMacro:car])
-                {
-                  id macrofun = [context macroForSymbol:car];
-                  id expansion = denullify([[macrofun
-                                              applyToArray:
-                                                [NSArray arrayWithObjects:
-                                                           program, context, nil]]
-                                             objectAtIndex:0]);
-
-                  return [self eval:expansion
-                               inLexicalContext:context
-                               withEnvironment:lexenv
-                               mode:mode];
-                }
-              else
-                {
-                  NSMutableArray *args = [NSMutableArray array];
-                  MLKCons *rest = [program cdr];
-                  NSArray *results;
-
-                  while (rest)
-                    {
-                      id result = [[self eval:[rest car]
-                                         inLexicalContext:context
-                                         withEnvironment:lexenv
-                                         expandOnly:expandOnly]
-                                    objectAtIndex:0];
-                      [args addObject:result];
-                      rest = [rest cdr];
-                    }
-
-                  if (expandOnly)
-                    {
-                      RETURN_VALUE ([MLKCons cons:[program car]
-                                             with:[MLKCons listWithArray:args]]);
-                    }
-
-                  results = [MLKRoot dispatch:car withArguments:args];
-
-                  if (results)
-                    {
-                      return results;
-                    }
-                  else
-                    {
-                      [NSException raise:@"MLKNoSuchOperatorException"
-                                   format:@"%@ does not name a known operator.",
-                                          MLKPrintToString(car)];
-                      return nil;
-                    }
-                }
-            }
-        }
-      else if ([car isKindOfClass:[MLKCons class]] && [car car] == LAMBDA)
-        {
-          return [self eval:[MLKCons cons:FUNCALL with:program]
-                       inLexicalContext:context
-                       withEnvironment:lexenv
-                       expandOnly:expandOnly];
-        }
-      else
-        {
-          [NSException raise:@"MLKInvalidExpressionException"
-                       format:@"%@ is not a valid operator name.",
-                       MLKPrintToString(car)];
-          return nil;  
-        }
-    }
+  id form = [MLKForm formWithObject:program
+                          inContext:context
+                        forCompiler:self];
+  return [form interpretWithEnvironment:lexenv];
 }
 
-
 +(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print
 {
   id eofValue = [[NSObject alloc] init];
@@ -1243,8 +141,7 @@
                                    inLexicalContext:[MLKLexicalContext
                                                       globalContext]
                                    withEnvironment:[MLKLexicalEnvironment
-                                                     globalEnvironment]
-                                   mode:not_compile_time_mode]
+                                                     globalEnvironment]]
                                   objectAtIndex:0]);
 
           if ([code isKindOfClass:[MLKCons class]] && [code cdr])
@@ -1258,8 +155,7 @@
           result = [MLKInterpreter
                      eval:expansion
                      inLexicalContext:[MLKLexicalContext globalContext]
-                     withEnvironment:[MLKLexicalEnvironment globalEnvironment]
-                     expandOnly:NO];
+                     withEnvironment:[MLKLexicalEnvironment globalEnvironment]];
           //NSLog (@"; LOAD: Top-level form evaluated.");
         }
 
@@ -1276,3 +172,565 @@
   return YES;
 }
 @end
+
+
+#define RETURN_VALUE(thing)                     \
+{ return [NSArray arrayWithObject:nullify(thing)]; }
+
+
+@implementation MLKForm (MLKInterpretation)
+-(NSArray *) interpret
+{
+  return [self interpretWithEnvironment:[MLKLexicalEnvironment globalEnvironment]];
+}
+
+
+-(NSArray *) interpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+#define TRACE_EVAL 0
+#if TRACE_EVAL
+  BOOL trace = NO;
+
+  if ([dynamicContext valueForSymbol:V_INITP])
+    trace = YES;
+
+  if (trace)
+    NSLog (@"; EVAL: %@", MLKPrintToString(program));
+#endif  // TRACE_EVAL
+  
+  return [self reallyInterpretWithEnvironment:env];
+}
+
+
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  NSLog (@"WARNING: Unrecognised form type: %@", self);
+  return [NSArray array];
+}
+@end
+
+
+@implementation MLKSelfEvaluatingForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  RETURN_VALUE (_form);
+}
+@end
+
+
+@implementation MLKSymbolForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  if ([_context symbolNamesSymbolMacro:_form])
+    {
+      id macrofun, expansion;
+    
+      macrofun = [_context macroForSymbol:_form];
+      expansion = [macrofun applyToArray:
+                              [NSArray arrayWithObjects:
+                                         _form, _context, nil]];
+    
+      return [expansion interpretWithEnvironment:env];
+    }
+  else if ([_context variableIsLexical:_form])
+    {
+      RETURN_VALUE ([env valueForSymbol:_form]);
+    }
+  else
+    {
+      RETURN_VALUE ([[MLKDynamicContext currentContext] valueForSymbol:_form]);
+    }
+}
+@end
+
+
+@implementation MLKCatchForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id catchTag;
+  NSArray *values;
+  MLKDynamicContext *newctx;
+
+  catchTag = [[_tagForm interpretWithEnvironment:env] objectAtIndex:0];
+
+  NS_DURING
+    {
+      newctx = [[MLKDynamicContext alloc] initWithParent:[MLKDynamicContext currentContext]
+                                                variables:nil
+                                                 handlers:nil
+                                                 restarts:nil
+                                                catchTags:[NSSet setWithObject:catchTag]
+                                 activeHandlerEnvironment:nil];
+      [newctx pushContext];
+
+      values = [self interpretBodyWithEnvironment:env];
+
+      [MLKDynamicContext popContext];
+      LRELEASE (newctx);
+      
+      NS_VALUERETURN (values, NSArray *);
+    }
+  NS_HANDLER
+    {
+      [MLKDynamicContext popContext];
+      LRELEASE (newctx);
+        
+      if ([[localException name] isEqualToString:@"MLKThrow"])
+        {
+          id thrownTag = [[localException userInfo]
+                                       objectForKey:@"THROWN TAG"];
+          
+          if (thrownTag == catchTag)
+            return [[localException userInfo]
+                                 objectForKey:@"THROWN OBJECTS"];
+          else
+            [localException raise];
+        }
+      else
+        [localException raise];
+    }
+  NS_ENDHANDLER;
+
+  return nil;      
+}
+@end
+
+
+@implementation MLKForeignLambdaForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  // FIXME: Support library designators.
+  
+  int (*function)();
+
+#ifdef _WIN32
+  // FIXME
+  //EnumProcessModules (...);
+  //GetProcAddress (..., [_foreignName UTF8String]);
+#else
+  function = dlsym (RTLD_DEFAULT, [_foreignName UTF8String]);
+#endif
+
+  NSMutableArray *argtypes = [NSMutableArray array];
+  int i;
+  for (i = 0; i++; i < _argc)
+    [argtypes addObject:[NSNumber numberWithInt:_argumentTypes[i]]];
+
+  RETURN_VALUE (LAUTORELEASE ([[MLKForeignProcedure alloc]
+                               initWithCode:function
+                              argumentTypes:argtypes
+                                 returnType:_returnType]));  
+}
+@end
+
+
+@implementation MLKLambdaFunctionForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  return [_lambdaForm interpretWithEnvironment:env];
+}
+@end
+
+
+@implementation MLKSimpleFunctionForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  RETURN_VALUE ([env functionForSymbol:_functionName]);
+}
+@end
+
+
+@implementation MLKIfForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id cndval = [[_conditionForm interpretWithEnvironment:env] objectAtIndex:0];
+  if (cndval)
+    return [_consequentForm interpretWithEnvironment:env];
+  else
+    return [_alternativeForm interpretWithEnvironment:env];
+}
+@end
+
+
+@implementation MLKInPackageForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id package = [MLKPackage findPackage:stringify(_packageDesignator)];
+
+  [[MLKDynamicContext currentContext]
+   setValue:package
+   forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
+                            intern:@"*PACKAGE*"]];
+
+  RETURN_VALUE (package);
+}
+@end
+
+
+@implementation MLKLambdaForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id lambdaList = [_tail car];
+  id body = [_tail cdr];
+  id closure = LAUTORELEASE ([[MLKInterpretedClosure alloc]
+                              initWithBodyForms:_body
+                                 lambdaListName:lambdaList
+                                        context:_context
+                                    environment:env]);
+  RETURN_VALUE (closure);  
+}
+@end
+
+
+@implementation MLKSimpleFletForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  MLKLexicalEnvironment *newenv = [MLKLexicalEnvironment environmentWithParent:env
+                                                                     variables:nil
+                                                                     functions:nil];
+
+  for (i = 0; i < [_functionBindingForms count]; i++)
+    {
+      [[_functionBindingForms objectAtIndex:i] interpretWithEnvironment:newenv];
+    }
+
+  return [self interpretBodyWithEnvironment:newenv];
+}
+@end
+
+
+@implementation MLKSimpleFunctionBindingForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id value = [_compiler compile:[MLKCons cons:_LAMBDA with:_tail]
+                      inContext:_context];
+  [env addFunction:value forSymbol:_name];
+  return nil;
+}
+@end
+
+
+@implementation MLKLetForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  NSArray *values;
+  MLKLexicalEnvironment *newenv;
+  MLKDynamicContext *dynctx;
+
+  newenv = [MLKLexicalEnvironment environmentWithParent:env
+                                              variables:nil
+                                              functions:nil];
+  dynctx = [[MLKDynamicContext alloc] initWithParent:[MLKDynamicContext currentContext]
+                                           variables:nil
+                                            handlers:nil
+                                            restarts:nil
+                                           catchTags:nil
+                            activeHandlerEnvironment:nil];
+  
+  for (i = 0; i < [_variableBindingForms count]; i++)
+    {
+      id variable = [[_variableBindingForms objectAtIndex:i] name];
+      id value = [[[_variableBindingForms objectAtIndex:i] 
+                   interpretWithEnvironment:env]
+                  objectAtIndex:0];
+      if ([_context variableIsLexical:variable])
+        {
+          [newenv addValue:value forSymbol:variable];
+        }
+      else
+        {
+          [dynctx addValue:value forSymbol:variable];
+        }
+    }
+
+  [dynctx pushContext];
+
+  NS_DURING
+    {
+      values = [self interpretBodyWithEnvironment:newenv];
+    }
+  NS_HANDLER
+    {
+      [MLKDynamicContext popContext];
+      LRELEASE (dynctx);
+      [localException raise];
+    }
+  NS_ENDHANDLER;
+
+  [MLKDynamicContext popContext];
+  LRELEASE (dynctx);
+
+  return values;
+}
+@end
+
+
+@implementation MLKSimpleLoopForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  while (YES)
+    {
+      [self interpretBodyWithEnvironment:env];
+    }
+
+  RETURN_VALUE (nil);  // never reached
+}
+@end
+
+
+@implementation MLKMultipleValueCallForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  NSMutableArray *results = [NSMutableArray array];
+  int i;
+  id <MLKFuncallable> function = [[_functionForm interpretWithEnvironment:env] objectAtIndex:0];
+
+  for (i = 0; i < [_bodyForms count]; i++)
+    {
+      NSArray *values = [[_bodyForms objectAtIndex:i] interpretWithEnvironment:env];
+      [results addObjectsFromArray:values];
+    }
+  
+  return [function applyToArray:results];
+}
+@end
+
+
+@implementation MLKProgNForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  return [self interpretBodyWithEnvironment:env];
+}
+@end
+
+
+@implementation MLKBodyForm (MLKInterpretation)
+-(NSArray *) interpretBodyWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  NSArray *values = nil;
+ 
+  for (i = 0; i < [_bodyForms count]; i++)
+    {
+      values = [[_bodyForms objectAtIndex:i] interpretWithEnvironment:env];
+    }
+  
+  return values;  
+}
+@end
+
+
+@implementation MLKProgVForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id variables = [[_variableListForm interpretWithEnvironment:env]
+                  objectAtIndex:0];
+  id values = [[_valueListForm interpretWithEnvironment:env]
+               objectAtIndex:0];
+  MLKDynamicContext *dynctx;
+  id result;
+
+  dynctx = [[MLKDynamicContext alloc]
+              initWithParent:[MLKDynamicContext currentContext]
+                   variables:nil
+                    handlers:nil
+                    restarts:nil
+                   catchTags:nil
+    activeHandlerEnvironment:nil];
+
+  for (; variables; (variables = [variables cdr], values = [values cdr]))
+    {
+      id var = [variables car];
+      id value = [values car];
+
+      [dynctx addValue:value forSymbol:var];
+    }
+
+  [dynctx pushContext];
+
+  NS_DURING
+    {
+      result = [self interpretBodyWithEnvironment:env];
+    }
+  NS_HANDLER
+    {
+      [MLKDynamicContext popContext];
+      LRELEASE (dynctx);
+      [localException raise];
+    }
+  NS_ENDHANDLER;
+
+  [MLKDynamicContext popContext];
+  LRELEASE (dynctx);
+
+  return result;     
+}
+@end
+
+
+@implementation MLKQuoteForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  return _quotedData;
+}
+@end
+
+
+@implementation MLKThrowForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  id catchTag;
+  NSArray *values;
+  NSDictionary *userInfo;
+
+  catchTag = [[_tagForm interpretWithEnvironment:env] objectAtIndex:0];
+  values = [_valueForm interpretWithEnvironment:env];
+
+  userInfo = [NSDictionary dictionaryWithObjectsAndKeys:
+    catchTag, @"THROWN TAG",
+    values, @"THROWN OBJECTS", nil];
+
+  if ([[MLKDynamicContext currentContext] catchTagIsEstablished:denullify (catchTag)])
+    [[NSException exceptionWithName:@"MLKThrow"
+                             reason:[NSString stringWithFormat:
+                                                       @"THROW: tag %@, values %@.",
+                                                       MLKPrintToString(catchTag),
+                                                       MLKPrintToString(values)]
+                           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 %@.",
+                                                MLKPrintToString(catchTag),
+                                                MLKPrintToString(values)]
+                           userInfo:userInfo] raise];
+
+  return nil;
+}
+@end
+
+
+@implementation MLKUnwindProtectForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  NSArray *results;
+
+  NS_DURING
+    {
+      results = [_protectedForm interpretWithEnvironment:env];
+    }
+  NS_HANDLER
+    {
+      [self interpretBodyWithEnvironment:env];
+      [localException raise];
+    }
+  NS_ENDHANDLER;
+
+  [self interpretBodyWithEnvironment:env];
+
+  return results;      
+}
+@end
+
+
+@implementation MLKFunctionCallForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  NSArray *results = nil;
+  NSMutableArray *args = [NSMutableArray array];
+
+  for (i = 0; i < [_argumentForms count]; i++)
+    {
+      id result = [[[_argumentForms objectAtIndex:i]
+                    interpretWithEnvironment:env]
+                   objectAtIndex:0];
+      [args addObject:result];
+    }
+
+  if (![_context symbolNamesFunction:_head])
+    {
+      if (_head && [_head homePackage] == sys)
+        {
+          results = [MLKRoot dispatch:_head withArguments:args];
+        }
+
+      if (results)
+        {
+          return results;
+        }
+      else
+        {
+          [NSException raise:@"MLKNoSuchOperatorException"
+                      format:@"%@ does not name a known operator.",
+            MLKPrintToString(_head)];
+          return nil;
+        }
+    }
+  else
+    {
+      id <MLKFuncallable> function = [env functionForSymbol:_head];
+      return [function applyToArray:args];
+    }
+}
+@end
+
+
+@implementation MLKSetQForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  id value = nil;
+  MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
+
+  for (i = 0; i < [_variables count]; i++)
+    {
+      id symbol = denullify([_variables objectAtIndex:i]);
+      value = [[[_valueForms objectAtIndex:i] interpretWithEnvironment:env] objectAtIndex:0];
+
+      if ([_context variableIsLexical:symbol])
+        [env setValue:value forSymbol:symbol];
+      else if ([dynamicContext bindingForSymbol:symbol])
+        [dynamicContext setValue:value forSymbol:symbol];
+      else
+        // FIXME: Maybe print a warning.
+        [[MLKDynamicContext globalContext] addValue:value
+                                          forSymbol:symbol];
+    }
+
+  RETURN_VALUE (value);
+}
+@end
+
+
+@implementation MLKFSetQForm (MLKInterpretation)
+-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env
+{
+  int i;
+  id value = nil;
+
+  for (i = 0; i < [_functionNames count]; i++)
+    {
+      id symbol = denullify([_functionNames objectAtIndex:i]);
+      value = [[[_valueForms objectAtIndex:i] interpretWithEnvironment:env] objectAtIndex:0];
+
+      if ([_context symbolNamesFunction:symbol])
+        {
+          [env setFunction:value forSymbol:symbol];
+        }
+      else
+        {
+          // FIXME: Maybe print a warning.
+          [[MLKLexicalContext globalContext] addFunction:symbol];
+          [[MLKLexicalEnvironment globalEnvironment] addFunction:value
+                                                       forSymbol:symbol];
+        }
+    }
+
+  RETURN_VALUE (value);
+}
+@end