Merge branch 'master' of http://matthias.benkard.de/code/mulklisp

18 files changed, 535 insertions, 296 deletions

diff --git a/MLKCons.m b/MLKCons.m
index bee917f..9e49d45 100644
--- a/MLKCons.m
+++ b/MLKCons.m
@@ -146,7 +146,7 @@
   if (!_cdr)
     return [NSString stringWithFormat:@"%@",
                      MLKPrintToString(_car)];
-  else if ([_cdr isKindOfClass:[MLKCons class]])
+  else if (MLKInstanceP (_cdr) && [_cdr isKindOfClass:[MLKCons class]])
     return [NSString stringWithFormat:@"%@ %@",
                      MLKPrintToString(_car),
                      [_cdr bareDescriptionForLisp]];
@@ -158,7 +158,7 @@
 
 -(NSString *)descriptionForLisp
 {
-  if ([_cdr isKindOfClass:[MLKCons class]])
+  if (MLKInstanceP (_cdr) && [_cdr isKindOfClass:[MLKCons class]])
     {
       if (_car == [[MLKPackage findPackage:@"COMMON-LISP"] intern:@"QUOTE"])
         return [NSString stringWithFormat:@"'%@", [_cdr bareDescriptionForLisp]];
diff --git a/MLKForm.h b/MLKForm.h
index 29483ef..5263dbd 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -91,6 +91,7 @@
 {
   id _body;
   NSArray *_bodyForms;
+  id _bodyContext;
 }
 
 -(void) splitDeclarationsAndBody:(id)object;
@@ -133,14 +134,6 @@
 @end
 
 
-@interface MLKSimpleDefmacroForm : MLKDeclaringForm
-{
-  MLKSymbol *_lambdaListName;
-  MLKSymbol *_name;
-}
-@end
-
-
 @interface MLKEvalWhenForm : MLKBodyForm
 {
   BOOL _compileToplevel;
@@ -281,22 +274,6 @@
 @end
 
 
-@interface MLKSetForm : MLKCompoundForm
-{
-  MLKForm *_variableForm;
-  MLKForm *_valueForm;
-}
-@end
-
-
-@interface MLKFSetForm : MLKCompoundForm
-{
-  MLKForm *_functionNameForm;
-  MLKForm *_valueForm;
-}
-@end
-
-
 @interface MLKThrowForm : MLKCompoundForm
 {
   MLKForm *_tagForm;
@@ -319,6 +296,10 @@
 }
 
 +(Class) dispatchClassForObject:(id)object;
+
+-(id) name;
+-(id) lambdaListName;
+-(id) bodyForms;
 @end
 
 
@@ -329,6 +310,9 @@
 }
 
 +(Class) dispatchClassForObject:(id)object;
+
+-(id) name;
+-(id) valueForm;
 @end
 
 
diff --git a/MLKForm.m b/MLKForm.m
index a5bebe5..c8a5416 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -43,9 +43,10 @@
            inContext:(MLKLexicalContext *)context
          forCompiler:(id)compiler
 {
-  _form = object;
-  _context = context;
-  _compiler = compiler;
+  self = [super init];
+  LASSIGN (_form, object);
+  LASSIGN (_context, context);
+  LASSIGN (_compiler, compiler);
   return [self complete];
 }
 
@@ -56,7 +57,7 @@
 
 +(Class) dispatchClassForObject:(id)object
 {
-  if ([object isKindOfClass:[MLKCons class]])
+  if (MLKInstanceP (object) && [object isKindOfClass:[MLKCons class]])
     return [MLKCompoundForm class];
   else
     return [MLKAtomicForm class];
@@ -89,7 +90,7 @@
 @implementation MLKAtomicForm
 +(Class) dispatchClassForObject:(id)object
 {
-  if ([object isKindOfClass:[MLKSymbol class]])
+  if (MLKInstanceP (object) && [object isKindOfClass:[MLKSymbol class]])
     return [MLKSymbolForm class];
   else
     return [MLKSelfEvaluatingForm class];
@@ -128,9 +129,7 @@
 {
   id car = [object car];
 
-  if (car == APPLY) return [MLKFunctionCallForm class];
-  else if (car == CATCH) return [MLKCatchForm class];
-  else if (car == _DEFMACRO) return [MLKSimpleDefmacroForm class];
+  if (car == CATCH) return [MLKCatchForm class];
   else if (car == EVAL) return [MLKFunctionCallForm class];
   else if (car == EVAL_WHEN) return [MLKEvalWhenForm class];
   else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class];
@@ -148,8 +147,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];
@@ -173,24 +170,24 @@
   else if ([_head isKindOfClass:[MLKCons class]])
     {
       LRELEASE (self);
-      return [MLKForm formWithObject:[MLKCons cons:FUNCALL
-                                              with:object]
-                      inContext:context
-                      forCompiler:compiler];
+      return LRETAIN ([MLKForm formWithObject:[MLKCons cons:FUNCALL
+                                                       with:object]
+                               inContext:context
+                               forCompiler:compiler]);
     }
   else if ([context symbolNamesMacro:_head])
     {
       LRELEASE (self);
-      return [MLKMacroCallForm formWithObject:object
-                               inContext:context
-                               forCompiler:compiler];
+      return LRETAIN ([MLKMacroCallForm formWithObject:object
+                                        inContext:context
+                                        forCompiler:compiler]);
     }
   else
     {
       LRELEASE (self);
-      return [MLKFunctionCallForm formWithObject:object
-                                  inContext:context
-                                  forCompiler:compiler];
+      return LRETAIN ([MLKFunctionCallForm formWithObject:object
+                                           inContext:context
+                                           forCompiler:compiler]);
     }
 }
 
@@ -212,15 +209,16 @@
                 forCompiler:compiler];
 
   id <MLKFuncallable> macrofun = [context macroForSymbol:_head];
+  //NSLog (@"Expanding: %@", MLKPrintToString (_form));
   id expansion = denullify ([[macrofun
                                applyToArray:
                                  [NSArray arrayWithObjects:
                                             _form, context, nil]]
                               objectAtIndex:0]);
 
-  return [MLKForm formWithObject:expansion
-                  inContext:context
-                  forCompiler:compiler];
+  return LRETAIN ([MLKForm formWithObject:expansion
+                           inContext:context
+                           forCompiler:compiler]);
 }
 @end
 
@@ -228,7 +226,7 @@
 @implementation MLKBodyForm
 -(void) splitDeclarationsAndBody:(id)object
 {
-  _body = object;
+  LASSIGN (_body, object);
 }
 
 -(void) processBody:(id)object inContext:(MLKLexicalContext *)context
@@ -246,6 +244,7 @@
       rest = [rest cdr];
     }
 
+  LASSIGN (_bodyContext, context);
   LASSIGN (_bodyForms, bodyForms);
 }
 
@@ -333,31 +332,6 @@
 @end
 
 
-@implementation MLKSimpleDefmacroForm
--(id) complete
-{
-  MLKLexicalContext *newContext;
-
-  self = [super complete];
-
-  LASSIGN (_name, [_tail car]);
-  LASSIGN (_lambdaListName, [[_tail cdr] car]);
-  newContext = [MLKLexicalContext contextWithParent:_context
-                                          variables:[NSSet setWithObject:_lambdaListName]
-                                          functions:nil
-                                             goTags:nil
-                                             macros:nil
-                                     compilerMacros:nil
-                                       symbolMacros:nil
-                                       declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
-
-  [self processBody:[[_tail cdr] cdr]
-          inContext:newContext];
-  return self;
-}
-@end
-
-
 @implementation MLKEvalWhenForm
 -(id) complete
 {
@@ -550,7 +524,7 @@
                           inContext:newContext
                         forCompiler:_compiler];
   LRELEASE (self);  //?FIXME
-  return newForm;
+  return LRETAIN (newForm);
 }
 @end
 
@@ -733,16 +707,17 @@
 @implementation MLKSetQForm
 -(id) complete
 {
-  id rest = _tail;
+  id rest;
   NSMutableArray *variables, *valueForms;
 
   self = [super complete];
 
+  rest = _tail;
   variables = [NSMutableArray array];
   valueForms = [NSMutableArray array];
   while (rest)
     {
-      [variables addObject:[rest car]];
+      [variables addObject:nullify([rest car])];
       [valueForms addObject:MAKE_FORM([[rest cdr] car])];
       rest = [[rest cdr] cdr];
     }
@@ -762,16 +737,17 @@
 @implementation MLKFSetQForm
 -(id) complete
 {
-  id rest = _tail;
+  id rest;
   NSMutableArray *functionNames, *valueForms;
   
   self = [super complete];
   
+  rest = _tail;
   functionNames = [NSMutableArray array];
   valueForms = [NSMutableArray array];
   while (rest)
     {
-      [functionNames addObject:[rest car]];
+      [functionNames addObject:nullify([rest car])];
       [valueForms addObject:MAKE_FORM([[rest cdr] car])];
       rest = [[rest cdr] cdr];
     }
@@ -788,40 +764,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
 {
@@ -883,6 +825,21 @@
           inContext:newContext];
   return self;
 }
+
+-(id) name
+{
+  return _name;
+}
+
+-(id) lambdaListName
+{
+  return _lambdaListName;
+}
+
+-(id) bodyForms
+{
+  return _bodyForms;
+}
 @end
 
 
@@ -914,6 +871,16 @@
 {
   return [[super subforms] arrayByAddingObject:_valueForm];
 }
+
+-(id) name
+{
+  return _name;
+}
+
+-(id) valueForm
+{
+  return _valueForm;
+}
 @end
 
 
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 693c742..0cdf904 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -29,6 +29,7 @@
 #import "MLKInterpreter.h"
 #import "MLKLexicalContext.h"
 #import "MLKLexicalEnvironment.h"
+#import "MLKLLVMCompiler.h"
 #import "MLKPackage.h"
 #import "MLKReader.h"
 #import "MLKRoot.h"
@@ -192,34 +193,7 @@
                 }
             }
 
-          if (car == APPLY)
-            {
-              MLKCons *rest = denullify([[self eval:[[[program cdr] cdr] car]
-                                               inLexicalContext:context
-                                               withEnvironment:lexenv
-                                               expandOnly:expandOnly]
-                                          objectAtIndex:0]);
-
-              id function = denullify([[self eval:[[program cdr] car]
-                                             inLexicalContext:context
-                                             withEnvironment:lexenv
-                                             expandOnly:expandOnly]
-                                        objectAtIndex:0]);
-
-              if (expandOnly)
-                RETURN_VALUE ([MLKCons cons:APPLY
-                                       with:[MLKCons cons:function
-                                                     with:[MLKCons cons:rest
-                                                                   with:nil]]]);
-
-              if ([function isKindOfClass:[MLKSymbol class]])
-                function = [lexenv functionForSymbol:function];
-
-              return [function applyToArray:(rest
-                                             ? (id)[rest array]
-                                             : (id)[NSArray array])];
-            }
-          else if (car == CATCH)
+          if (car == CATCH)
             {
               id catchTag;
               NSArray *values;
@@ -289,46 +263,6 @@
 
               return nil;
             }
-          else if (car == _DEFMACRO)
-            {
-              // No real lambda lists here.  This SYS::%DEFMACRO is
-              // really as low-level as it gets.
-              id name = [[program cdr] car];
-              id lambdaListAndBody = [[program cdr] cdr];
-
-              id <MLKFuncallable> function;
-
-              if (expandOnly)
-                {
-                  id lambdaList = [lambdaListAndBody car];
-                  id body = [lambdaListAndBody cdr];
-                  id body_expansion =
-                    denullify([[self eval:[MLKCons cons:PROGN with:body]
-                                     inLexicalContext:context
-                                     withEnvironment:lexenv
-                                     expandOnly:expandOnly]
-                                objectAtIndex:0]);
-                  RETURN_VALUE ([MLKCons
-                                  cons:_DEFMACRO
-                                  with:[MLKCons
-                                         cons:name
-                                         with:[MLKCons
-                                                cons:lambdaList
-                                                with:[MLKCons
-                                                       cons:body_expansion
-                                                       with:nil]]]]);
-                }
-
-              function = denullify([[self eval:[MLKCons cons:_LAMBDA with:lambdaListAndBody]
-                                          inLexicalContext:context
-                                          withEnvironment:lexenv
-                                          expandOnly:expandOnly]
-                                     objectAtIndex:0]);
-
-              [context addMacro:function forSymbol:name];
-
-              RETURN_VALUE (name);
-            }
           else if (car == EVAL)
             {
               NSArray *evaluand = denullify([[self eval:[[program cdr] car]
@@ -1059,59 +993,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;
@@ -1335,7 +1216,8 @@
       if (code == eofValue)
         break;
 
-      if ([code isKindOfClass:[MLKCons class]] && [code cdr])
+      if (MLKInstanceP(code)
+          && [code isKindOfClass:[MLKCons class]] && [code cdr])
         formdesc = [NSString stringWithFormat:@"(%@ %@ ...)",
                                MLKPrintToString([code car]),
                                MLKPrintToString([[code cdr] car])];
@@ -1347,6 +1229,11 @@
       for (i = 0; i < level; i++)
         fprintf (stderr, "| ");
       fprintf (stderr, "LOAD: %s\n", [formdesc UTF8String]);
+
+#ifdef USE_LLVM
+      expansion = code;
+      result = [MLKLLVMCompiler eval:code];
+#else // !USE_LLVM
       expansion = denullify([[MLKInterpreter
                                eval:code
                                inLexicalContext:[MLKLexicalContext
@@ -1370,6 +1257,7 @@
                  withEnvironment:[MLKLexicalEnvironment globalEnvironment]
                  expandOnly:NO];
       //NSLog (@"; LOAD: Top-level form evaluated.");
+#endif  //!USE_LLVM
 
       LRELEASE (pool);
 
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 379d791..cf2823b 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -37,6 +37,8 @@ using namespace llvm;
 +(id) compile:(id)object
     inContext:(MLKLexicalContext *)context;
 
++(id) eval:(id)object;
+
 +(void) processTopLevelForm:(id)object;
 +(void) processTopLevelForm:(id)object
                      inMode:(enum MLKProcessingMode)mode;
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 4313ac9..aa0ab79 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -16,10 +16,14 @@
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#import "MLKDynamicContext.h"
 #import "MLKLLVMCompiler.h"
+#import "MLKPackage.h"
 #import "globals.h"
+#import "util.h"
 
 #import <Foundation/NSArray.h>
+#import <Foundation/NSAutoreleasePool.h>
 #import <Foundation/NSEnumerator.h>
 #import <Foundation/NSString.h>
 
@@ -100,6 +104,9 @@ static Constant
 +(id) compile:(id)object
     inContext:(MLKLexicalContext *)context
 {
+  NSAutoreleasePool *pool;
+  pool = [[NSAutoreleasePool alloc] init];
+
   Value *v = NULL;
   BasicBlock *block;
   std::vector<const Type*> noargs (0, Type::VoidTy);
@@ -112,27 +119,33 @@ static Constant
                                          module);
   id lambdaForm;
   id (*fn)();
+  MLKForm *form = [MLKForm formWithObject:object
+                           inContext:context
+                           forCompiler:self];
 
   block = BasicBlock::Create ("entry", function);
   builder.SetInsertPoint (block);
 
-  v = [self processForm:[MLKForm formWithObject:object
-                                 inContext:context
-                                 forCompiler:self]];
+  v = [self processForm:form];
 
   builder.CreateRet (v);
   verifyFunction (*function);
   fpm->run (*function);
 
+  //function->dump();
+
   // JIT-compile.
   fn = (id (*)()) execution_engine->getPointerToFunction (function);
-  module->dump();
-  NSLog (@"%p", fn);
+  //module->dump();
+  //NSLog (@"%p", fn);
+
+  [pool release];
+  //NSLog (@"Code compiled.");
 
   // Execute.
   lambdaForm = fn();
 
-  NSLog (@"Closure built.");
+  //NSLog (@"Closure built.");
 
   return lambdaForm;
 }
@@ -150,7 +163,12 @@ static Constant
   //FIXME
   // If PROGN, do this...  If EVAL-WHEN, do that...
 
-  
+}
+
++(id) eval:(id)object
+{
+  return [self compile:object
+               inContext:[MLKLexicalContext globalContext]];
 }
 
 +(Value *) processForm:(MLKForm *)form
@@ -314,10 +332,7 @@ static Constant
 {
   NSEnumerator *e = [_bodyForms objectEnumerator];
   MLKForm *form;
-  Value *value = NULL;
-
-  if ([_bodyForms count] == 0)
-    value = ConstantPointerNull::get (PointerTy);
+  Value *value = ConstantPointerNull::get (PointerTy);
 
   while ((form = [e nextObject]))
     {
@@ -364,9 +379,31 @@ static Constant
 {
   Value *value;
 
-  if ([_context variableHeapAllocationForSymbol:_form])
+  //NSLog (@"Symbol: %@", MLKPrintToString (_form));
+  //[_compiler insertTrace:[NSString stringWithFormat:@"Symbol: %@", _form]];
+
+  if (![_context variableIsLexical:_form])
     {
-      Value *binding = builder.CreateLoad ([_context bindingValueForSymbol:_form]);
+      //[_compiler insertTrace:@"Dynamic."];
+      Value *mlkdynamiccontext = [_compiler insertClassLookup:@"MLKCons"];
+      Value *dynctx = [_compiler insertMethodCall:@"currentContext"
+                                 onObject:mlkdynamiccontext];
+
+      LRETAIN (_form);  // FIXME: release
+      Value *symbolV = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                                (uint64_t)_form,
+                                                                false),
+                                               PointerTy);
+
+      std::vector<Value *> args (1, symbolV);
+      value = [_compiler insertMethodCall:@"valueForSymbol:"
+                         onObject:dynctx
+                         withArgumentVector:&args];
+    }
+  else if ([_context variableHeapAllocationForSymbol:_form])
+    {
+      //[_compiler insertTrace:@"Global."];
+      Value *binding = builder.CreateLoad (builder.Insert ([_context bindingCellValueForSymbol:_form]));
       value = [_compiler insertMethodCall:@"value" onObject:binding];
     }
   else
@@ -383,28 +420,67 @@ static Constant
 @implementation MLKFunctionCallForm (MLKLLVMCompilation)
 -(Value *) processForLLVM
 {
+  static MLKPackage *sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+  BOOL special_dispatch = NO;
+  Value *functionCell;
+  Value *functionPtr;
+  Value *closureDataCell;
+  Value *closureDataPtr;
+  std::vector<Value *> args;
+
   if (![_context symbolNamesFunction:_head])
     {
-      NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
-      // XXX Issue a style warning.
+      if (_head && [_head homePackage] == sys)
+        {
+          special_dispatch = YES;
+        }
+      else
+        {
+          NSLog (@"Compiler: Don't know function %@", MLKPrintToString(_head));
+          // XXX Issue a style warning.
+        }
     }
 
-  Value *functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
-  Value *functionPtr = builder.CreateLoad (functionCell);
-  Value *closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
-  Value *closureDataPtr = builder.CreateLoad (closureDataCell);
+  if (!special_dispatch)
+    {
+      functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
+      functionPtr = builder.CreateLoad (functionCell);
+      closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
+      closureDataPtr = builder.CreateLoad (closureDataCell);
+
+      args.push_back (closureDataPtr);
+    }
+  else
+    {
+      std::vector<const Type *> argtypes (1, PointerTy);
+      functionPtr = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                             (uint64_t)MLKDispatchRootFunction,
+                                                             false),
+                                            PointerType::get (FunctionType::get (PointerTy,
+                                                                                 argtypes,
+                                                                                 true),
+                                                              0));
+      LRETAIN (_head); // FIXME: release sometime?  On the other hand,
+                       // these symbols will probably never be
+                       // deallocated anyway.
+      args.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                               (uint64_t)_head,
+                                                               false),
+                                              PointerTy));
+    }
 
   NSEnumerator *e = [_argumentForms objectEnumerator];
   MLKForm *form;
 
-  std::vector<Value *> args;
-  args.push_back (closureDataPtr);
-
   while ((form = [e nextObject]))
     {
       args.push_back ([form processForLLVM]);
     }
 
+  //GlobalVariable *endmarker = module->getGlobalVariable ("MLKEndOfArgumentsMarker", false);
+  //endmarker->setConstant (true);
+  //GlobalVariable *endmarker = new GlobalVariable (PointerTy, true, GlobalValue::ExternalWeakLinkage);
   Value *endmarker = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
                                                               (uint64_t)MLKEndOfArgumentsMarker,
                                                               false),
@@ -534,7 +610,7 @@ static Constant
 
   builder.CreateRet (value);
 
-  function->dump();
+  //function->dump();
   //NSLog (@"Verify...");
   verifyFunction (*function);
   //NSLog (@"Optimise...");
@@ -544,7 +620,7 @@ static Constant
   // the function.
   execution_engine->getPointerToFunction (function);
   //NSLog (@"Done.");
-  function->dump();
+  //function->dump();
   //NSLog (@"Function built.");
 
   builder.SetInsertPoint (outerBlock);
@@ -569,3 +645,165 @@ static Constant
   return closure;
 }
 @end
+
+
+@implementation MLKLetForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  NSEnumerator *e = [_variableBindingForms objectEnumerator];
+  Value *value = ConstantPointerNull::get (PointerTy);
+  MLKForm *form;
+  MLKVariableBindingForm *binding_form;
+
+  while ((binding_form = [e nextObject]))
+    {
+      // FIXME: Handle heap allocation.
+      Value *binding_value = [[binding_form valueForm] processForLLVM];
+      Value *binding_variable = builder.CreateAlloca (PointerTy,
+                                                      NULL,
+                                                      [(MLKPrintToString([binding_form name]))
+                                                        UTF8String]);
+      builder.CreateStore (binding_value, binding_variable);
+      [_bodyContext setValueValue:binding_variable
+                    forSymbol:[binding_form name]];
+    }
+
+  e = [_bodyForms objectEnumerator];
+  while ((form = [e nextObject]))
+    {
+      value = [form processForLLVM];
+    }
+
+  return value;
+}
+@end
+
+
+@implementation MLKQuoteForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  // FIXME: When to release _quotedData?  At the same time the code is
+  // released, probably...
+  LRETAIN (_quotedData);
+  return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                  (uint64_t)_quotedData,
+                                                  false),
+                                 PointerTy);
+}
+@end
+
+
+@implementation MLKSelfEvaluatingForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  // FIXME: When to release _form?  At the same time the code is
+  // released, probably...
+  LRETAIN (_form);
+  return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                  (uint64_t)_form,
+                                                  false),
+                                 PointerTy);
+}
+@end
+
+
+@implementation MLKIfForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  Function *function = builder.GetInsertBlock()->getParent();
+  BasicBlock *thenBlock = BasicBlock::Create ("if_then", function);
+  BasicBlock *elseBlock = BasicBlock::Create ("if_else");
+  BasicBlock *joinBlock = BasicBlock::Create ("if_join");
+
+  Value *test = builder.CreateICmpNE ([_conditionForm processForLLVM],
+                                      ConstantPointerNull::get (PointerTy));
+  Value *value = builder.CreateAlloca (PointerTy, NULL, "if_result");
+  builder.CreateCondBr (test, thenBlock, elseBlock);
+
+  builder.SetInsertPoint (thenBlock);
+  builder.CreateStore ([_consequentForm processForLLVM], value);
+  builder.CreateBr (joinBlock);
+
+  builder.SetInsertPoint (elseBlock);
+  function->getBasicBlockList().push_back (elseBlock);
+  builder.CreateStore ([_alternativeForm processForLLVM], value);
+  builder.CreateBr (joinBlock);
+
+  builder.SetInsertPoint (joinBlock);
+  function->getBasicBlockList().push_back (joinBlock);
+
+  return builder.CreateLoad (value);
+}
+@end
+
+
+@implementation MLKSetQForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  NSEnumerator *var_e, *value_e;
+  MLKForm *valueForm;
+  Value *value = ConstantPointerNull::get (PointerTy);
+  id variable;
+
+  var_e = [_variables objectEnumerator];
+  value_e = [_valueForms objectEnumerator];
+  while ((valueForm = [value_e nextObject]))
+    {
+      variable = [var_e nextObject];
+      value = [valueForm processForLLVM];
+      if (![_context variableIsLexical:variable])
+        {
+          Value *mlkdynamiccontext = [_compiler insertClassLookup:@"MLKCons"];
+          Value *dynctx = [_compiler insertMethodCall:@"currentContext"
+                                     onObject:mlkdynamiccontext];
+
+          LRETAIN (variable);  // FIXME: release
+          Value *symbolV = builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                                    (uint64_t)variable,
+                                                                    false),
+                                                   PointerTy);
+
+          std::vector<Value *> args;
+          args.push_back (value);
+          args.push_back (symbolV);
+          [_compiler insertMethodCall:@"setValue:forSymbol:"
+                     onObject:dynctx
+                     withArgumentVector:&args];          
+        }
+      else if ([_context variableHeapAllocationForSymbol:variable])
+        {
+          Value *binding = builder.CreateLoad (builder.Insert ([_context
+                                                                 bindingCellValueForSymbol:variable]));
+          std::vector<Value *> args (1, value);
+
+          [_compiler insertVoidMethodCall:@"setValue:"
+                     onObject:binding
+                     withArgumentVector:&args];
+        }
+      else
+        {
+          builder.CreateStore (value, [_context valueValueForSymbol:variable]);
+        }
+    }
+
+  return value;
+}
+@end
+
+
+@implementation MLKInPackageForm (MLKLLVMCompilation)
+-(Value *) processForLLVM
+{
+  id package = [MLKPackage findPackage:stringify(_packageDesignator)];
+
+  [[MLKDynamicContext currentContext]
+    setValue:package
+    forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"]
+                intern:@"*PACKAGE*"]];
+
+  return builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                  (uint64_t)package,
+                                                  false),
+                                 PointerTy);
+}
+@end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
index d42140e..d791765 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.h
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -37,7 +37,7 @@ using namespace llvm;
 -(BOOL) variableHeapAllocationForSymbol:(id)name;
 -(Instruction *) functionCellValueForSymbol:(id)name;
 -(Instruction *) closureDataPointerValueForSymbol:(id)name;
--(Value *) bindingValueForSymbol:(id)name;
+-(Instruction *) bindingCellValueForSymbol:(id)name;
 -(Value *) valueValueForSymbol:(id)name;
 //-(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name;
 //-(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name;
diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm
index 744351a..22d211d 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.mm
+++ b/MLKLexicalContext-MLKLLVMCompilation.mm
@@ -45,7 +45,11 @@ using namespace std;
   id flag = [self deepPropertyForVariable:name
                   key:@"LLVM.heap-flag"];
 
-  return (flag && [flag boolValue]);
+  if (flag)
+    return [flag boolValue];
+  else
+    return (![self contextForVariable:name]
+            || [self contextForVariable:name] == [MLKLexicalContext globalContext]);
 }
 
 -(Instruction *) functionCellValueForSymbol:(id)name
@@ -70,12 +74,12 @@ using namespace std;
                             PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
 }
 
--(Value *) bindingValueForSymbol:(id)name
+-(Instruction *) bindingCellValueForSymbol:(id)name
 {
   return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
-                                             (uint64_t)[self bindingForSymbol:name],
+                                             (uint64_t)[self bindingCellForSymbol:name],
                                              false),
-                            PointerType::get(Type::Int8Ty, 0)));
+                            PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
 }
 
 -(Value *) valueValueForSymbol:(id)name
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index fc2abc3..e350b63 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -86,9 +86,8 @@
 -(id) declarations;
 -(void) addDeclaration:(id)declaration;
 
-// FIXME?
-//-(MLKLexicalEnvironment *) instantiateWithVariables:(NSDictionary *)variables
-//                                          functions:(NSDictionary *)functions;
+-(id) contextForVariable:(MLKSymbol *)symbol;
+-(id) contextForFunction:(MLKSymbol *)symbol;
 
 -(void) addVariable:(MLKSymbol *)symbol;
 -(void) addFunction:(MLKSymbol *)symbol;
@@ -107,7 +106,7 @@
 
 -(void *) functionCellForSymbol:(id)name;
 -(void *) closureDataPointerForSymbol:(id)name;
--(id) bindingForSymbol:(id)name;
+-(id *) bindingCellForSymbol:(id)name;
 
 -(void) dealloc;
 @end
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index 1eaa51c..3f820a8 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -37,6 +37,8 @@
 #import "runtime-compatibility.h"
 #import "util.h"
 
+#include <stdlib.h>
+
 
 #define MAKE_ENVIRONMENT(variable, parent, parent_member)               \
   [[MLKEnvironment alloc]                                               \
@@ -196,9 +198,29 @@ static MLKSymbol *LEXICAL;
                    with:_declarations]);
 }
 
+-(id) contextForVariable:(MLKSymbol *)symbol
+{
+  if ([_variables containsObject:nullify(symbol)])
+    return self;
+  else if (_parent)
+    return [_parent contextForVariable:symbol];
+  else
+    return nil;
+}
+
+-(id) contextForFunction:(MLKSymbol *)symbol
+{
+  if ([_functions containsObject:nullify(symbol)])
+    return self;
+  else if (_parent)
+    return [_parent contextForFunction:symbol];
+  else
+    return nil;
+}
+
 -(BOOL) symbolNamesFunction:(MLKSymbol *)symbol
 {
-  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  symbol = nullify (symbol);
   if ([_functions containsObject:symbol])
     return YES;
   else if ([_knownMacros containsObject:symbol])
@@ -209,7 +231,7 @@ static MLKSymbol *LEXICAL;
 
 -(BOOL) symbolNamesMacro:(MLKSymbol *)symbol
 {
-  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  symbol = nullify (symbol);
   if ([_functions containsObject:symbol])
     return NO;
   else if ([_knownMacros containsObject:symbol])
@@ -220,7 +242,7 @@ static MLKSymbol *LEXICAL;
 
 -(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol
 {
-  symbol = symbol ? (id)symbol : (id)[NSNull null];
+  symbol = nullify (symbol);
   if ([_variables containsObject:symbol])
     return NO;
   else if ([_knownSymbolMacros containsObject:symbol])
@@ -399,20 +421,25 @@ static MLKSymbol *LEXICAL;
     }
 }
 
--(id) bindingForSymbol:(id)name
+-(id *) bindingCellForSymbol:(id)name
 {
   id prop = [self deepPropertyForVariable:name
                   key:@"LEXCTX.variable-binding"];
 
   if (!prop)
     {
-      prop = [MLKBinding binding];
+      id *cell = malloc (sizeof(id));
+      *cell = [[MLKBinding alloc] init];
+      prop = [NSValue valueWithPointer:cell];
       [self setDeepProperty:prop
             forVariable:name
             key:@"LEXCTX.variable-binding"];
+      return cell;
+    }
+  else
+    {
+      return [prop pointerValue];
     }
-
-  return prop;
 }
 
 -(void) dealloc
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index ca6b4a9..723c955 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -107,17 +107,43 @@ static MLKLexicalEnvironment *global_environment;
 
 -(id) valueForSymbol:(MLKSymbol *)symbol
 {
-  return [_variables valueForSymbol:symbol];
+  if (![_variables environmentForSymbol:symbol]
+      || [_variables environmentForSymbol:symbol] == global_environment->_variables)
+    {
+      id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+      return [*cell value];
+    }
+  else
+    {
+      return [_variables valueForSymbol:symbol];
+    }
 }
 
 -(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol
 {
-  [_variables setValue:value forSymbol:symbol];
+  if (![_variables environmentForSymbol:symbol]
+      || [_variables environmentForSymbol:symbol] == global_environment->_variables)
+    {
+      id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+      [*cell setValue:value forSymbol:symbol];
+    }
+  else
+    {
+      [_variables setValue:value forSymbol:symbol];
+    }
 }
 
 -(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
 {
-  [_variables addValue:value forSymbol:symbol];
+  if (self == global_environment)
+    {
+      id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol];
+      [*cell setValue:value forSymbol:symbol];
+    }
+  else
+    {
+      [_variables addValue:value forSymbol:symbol];
+    }
 }
 
 -(void) addBindingForSymbol:(MLKSymbol *)symbol
diff --git a/MLKPackage.m b/MLKPackage.m
index acaf6db..6d97652 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -92,7 +92,6 @@ static NSMutableDictionary *packages = nil;
   [cl export:[cl intern:@"FUNCALL"]];
   [cl export:[cl intern:@"FUNCTION"]];
   [cl export:[cl intern:@"PROGN"]];
-  [cl export:[cl intern:@"APPLY"]];
   [cl export:[cl intern:@"PROGV"]];
   [cl export:[cl intern:@"SETQ"]];
   [cl export:[cl intern:@"SETF"]];
@@ -101,15 +100,14 @@ 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"]];
 
-  [sys export:[sys intern:@"%DEFMACRO"]];
   [sys export:[sys intern:@"%LAMBDA"]];
   [sys export:[sys intern:@"%FSET"]];
   [sys export:[sys intern:@"%FSETQ"]];
+  [sys export:[sys intern:@"%MACROSET"]];
   [sys export:[sys intern:@"%LOOP"]];
   [sys export:[sys intern:@"%FLET"]];
   [sys export:[sys intern:@"%MACROLET"]];
@@ -155,6 +153,8 @@ 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:@"APPLY"]];
 
   [sys export:[sys intern:@"OBJC-CLASS-OF"]];
   [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m
index 2ddc5d7..fc0d8ef 100644
--- a/MLKReadEvalPrintLoop.m
+++ b/MLKReadEvalPrintLoop.m
@@ -31,7 +31,12 @@
 #import <Foundation/NSNull.h>
 #import <Foundation/NSString.h>
 
-#import <histedit.h>
+#ifdef GNUSTEP
+#import <Foundation/NSDebug.h>
+#endif
+
+#include <histedit.h>
+#include <string.h>
 
 
 static int _argc;
@@ -132,7 +137,13 @@ static const char *prompt (EditLine *e) {
           if (strcmp (line, ":q\n") == 0 || strncmp (line, ":q ", 3) == 0)
             break;
 
+#if 1
           NS_DURING
+#else
+          GSDebugAllocationActive (YES);
+          [NSObject enableDoubleReleaseCheck:YES];
+          NSZombieEnabled = YES;
+#endif
             {
               int i;
 
@@ -150,6 +161,7 @@ static const char *prompt (EditLine *e) {
                   printf ("%s\n", [MLKPrintToString (denullify (result)) UTF8String]);
                 }
             }
+#if 1
           NS_HANDLER
             {
               printf ("Caught an unhandled exception.\nName: %s\nReason: %s\n",
@@ -157,6 +169,7 @@ static const char *prompt (EditLine *e) {
                       [[localException reason] UTF8String]);
             }
           NS_ENDHANDLER;
+#endif
 
           LRELEASE (pool);
         }
diff --git a/MLKRoot.m b/MLKRoot.m
index b051dd3..0db7483 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);
@@ -707,12 +711,66 @@ as provided by method %@ of object %@",
 #ifdef USE_LLVM
 +(NSArray *) compile:(NSArray *)args
 {
-  NSLog (@"Compiling lambda form.");
+  //NSLog (@"Compiling lambda form.");
   id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0])
                               inContext:[MLKLexicalContext globalContext]];
-  NSLog (@"Compilation done.");
-  NSLog (@"Compiled: %@", thing);
+  //NSLog (@"Compilation done.");
+  //NSLog (@"Compiled: %@", thing);
   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);
+}
+
++(NSArray *) macroset:(NSArray *)args
+{
+  id symbol = denullify ([args objectAtIndex:0]);
+  id value = denullify ([args objectAtIndex:1]);
+
+  [[MLKLexicalContext globalContext] addMacro:value
+                                     forSymbol:symbol];
+
+  RETURN_VALUE (value);
+}
+
++(NSArray *) apply:(NSArray *)args
+{
+  id function = denullify ([args objectAtIndex:0]);
+  id arglist = denullify ([args objectAtIndex:1]);
+
+  if (!function || [function isKindOfClass:[MLKSymbol class]])
+    {
+      function = [[MLKLexicalEnvironment globalEnvironment]
+                   functionForSymbol:function];
+    }
+
+  return [function applyToArray:(arglist
+                                 ? (id)[arglist array]
+                                 : (id)[NSArray array])];
+}
 @end
diff --git a/functions.h b/functions.h
index 8f3e70e..4ea8261 100644
--- a/functions.h
+++ b/functions.h
@@ -17,6 +17,7 @@
  */
 
 #import "MLKInteger.h"
+#import "MLKSymbol.h"
 
 #import <Foundation/NSString.h>
 #include <stdint.h>
@@ -82,7 +83,7 @@ void MLKSetForeignValueWithLispValue (void *destination, id value, MLKForeignTyp
 id MLKLispValueWithForeignValue (void *source, MLKForeignType type);
 
 id MLKInterpretedFunctionTrampoline (void *target, ...);
-  
+id MLKDispatchRootFunction (MLKSymbol *name, ...);  
 
 #ifdef __cplusplus
 }
diff --git a/functions.m b/functions.m
index 7caea41..20cde07 100644
--- a/functions.m
+++ b/functions.m
@@ -25,7 +25,9 @@
 #import "MLKInterpretedClosure.h"
 #import "MLKPackage.h"
 #import "MLKSymbol.h"
+#import "MLKRoot.h"
 
+#import <Foundation/NSArray.h>
 #import <Foundation/NSException.h>
 #import <Foundation/NSString.h>
 
@@ -405,7 +407,31 @@ id MLKInterpretedFunctionTrampoline (void *target, ...)
   values = [closure applyToArray:arguments];
 
   if ([values count] > 0)
-    return [values objectAtIndex:0];
+    return denullify ([values objectAtIndex:0]);
+  else
+    return nil;
+}
+
+id MLKDispatchRootFunction (MLKSymbol *name, ...)
+{
+  NSArray *values;
+  NSMutableArray *arguments;
+  id arg;
+  va_list ap;
+
+  arguments = [NSMutableArray array];
+
+  va_start (ap, name);
+  while ((arg = va_arg (ap, id)) != MLKEndOfArgumentsMarker)
+    {
+      [arguments addObject:nullify(arg)];
+    }
+  va_end (ap);
+
+  values = [MLKRoot dispatch:name withArguments:arguments];
+
+  if ([values count] > 0)
+    return denullify ([values objectAtIndex:0]);
   else
     return nil;
 }
diff --git a/special-symbols.h b/special-symbols.h
index fa68ba7..d7e7351 100644
--- a/special-symbols.h
+++ b/special-symbols.h
@@ -36,7 +36,6 @@ static MLKSymbol *_MACROLET;
 static MLKSymbol *LAMBDA;
 static MLKSymbol *LET;
 static MLKSymbol *LOCALLY;
-static MLKSymbol *APPLY;
 static MLKSymbol *FUNCALL;
 static MLKSymbol *FUNCTION;
 static MLKSymbol *EVAL;
@@ -44,14 +43,11 @@ 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;
 static MLKSymbol *VALUES;
-static MLKSymbol *_DEFMACRO;
 static MLKSymbol *_FOREIGN_LAMBDA;
 static MLKSymbol *_LAMBDA;
 static MLKSymbol *_LOOP;
@@ -87,7 +83,6 @@ ensure_symbols ()
   _FLET = [sys intern:@"%FLET"];
   _MACROLET = [sys intern:@"%MACROLET"];
   _LOOP = [sys intern:@"%LOOP"];
-  APPLY = [cl intern:@"APPLY"];
   EVAL = [cl intern:@"EVAL"];
   EVAL_WHEN = [cl intern:@"EVAL-WHEN"];
   FUNCALL = [cl intern:@"FUNCALL"];
@@ -95,14 +90,11 @@ 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"];
   UNWIND_PROTECT = [cl intern:@"UNWIND-PROTECT"];
-  _DEFMACRO = [sys intern:@"%DEFMACRO"];
   _FOREIGN_LAMBDA = [sys intern:@"%FOREIGN-LAMBDA"];
   _LAMBDA = [sys intern:@"%LAMBDA"];
   V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
diff --git a/util.lisp b/util.lisp
index 412b23d..b9601e4 100644
--- a/util.lisp
+++ b/util.lisp
@@ -22,6 +22,20 @@
           otherwise unless when eq boundp))
 
 
+(setq t 't)
+(setq nil ())
+
+(%macroset '%defmacro
+           (%lambda args
+             (let ((form (car args)))
+               (let ((name (car (cdr form)))
+                     (lambda-list-name (car (cdr (cdr form))))
+                     (body (cdr (cdr (cdr form)))))
+                 (list '%macroset
+                       (list 'quote name)
+                       (cons '%lambda
+                             (cons lambda-list-name body)))))))
+
 (%defmacro %defun args
   (list '%fset
         (list 'quote (car (cdr (car args))))