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

16 files changed, 366 insertions, 100 deletions

diff --git a/GNUmakefile b/GNUmakefile
index 9bd1c2f..7fb8754 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -56,7 +56,6 @@ ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m			\
                        MLKForeignProcedure.m MLKForm.m MLKInteger.m	\
                        MLKInterpretedClosure.m MLKInterpreter.m		\
                        MLKLexicalContext.m				\
-                       MLKLexicalContext-MLKLLVMCompilation.m		\
                        MLKLexicalEnvironment.m MLKNumber.m MLKPackage.m	\
                        MLKParenReader.m MLKQuoteReader.m MLKRatio.m	\
                        MLKReader.m MLKReadtable.m MLKReaderError.m	\
@@ -74,9 +73,11 @@ ToiletKit_LDFLAGS = -lgmp -lffi -ldl
 USE_LLVM := YES
 ifeq ($(USE_LLVM),YES)
 ADDITIONAL_OBJCCFLAGS = $(ADDITIONAL_OBJCFLAGS)
+ToiletKit_OBJC_FILES += MLKLexicalContext-MLKLLVMCompilation.m
 ToiletKit_OBJCC_FILES = MLKLLVMCompiler.mm
-ToiletKit_OBJCCFLAGS = `llvm-config --cxxflags` $(ToiletKit_OBJCFLAGS)
-ToiletKit_LDFLAGS += `llvm-config --ldflags` `llvm-config --libs backend engine linker codegen transformutils scalaropts analysis`
+ToiletKit_OBJCFLAGS = -DUSE_LLVM
+ToiletKit_OBJCCFLAGS = -DUSE_LLVM `llvm-config --cxxflags` $(ToiletKit_OBJCFLAGS)
+ToiletKit_LDFLAGS += `llvm-config --ldflags` `llvm-config --libs backend engine linker codegen transformutils scalaropts analysis ipo`
 endif
 
 #TOOL_NAME = etoilet
@@ -93,7 +94,7 @@ etshell_OBJCFLAGS = -w
 
 toilet_OBJC_FILES = MLKReadEvalPrintLoop.m
 toilet_OBJC_LIBS += -ledit -lncurses -lToiletKit -LToiletKit.framework \
-                    -LToiletKit.framework/Versions/Current
+                    -LToiletKit.framework/Versions/Current `llvm-config --ldflags` `llvm-config --libs scalaropts analysis ipo`
 toilet_OBJCFLAGS = -Wall
 
 Test_OBJC_FILES = MLKLowLevelTests.m
diff --git a/MLKArray.h b/MLKArray.h
index 5fedf1c..1205b69 100644
--- a/MLKArray.h
+++ b/MLKArray.h
@@ -31,6 +31,7 @@
   NSArray *_displacement;
 }
 
++(id) array;
 -(id) initWithDimensions:(NSArray *)dimensions;
 
 -(NSArray *) dimensions;
diff --git a/MLKArray.m b/MLKArray.m
index 5890953..11c7889 100644
--- a/MLKArray.m
+++ b/MLKArray.m
@@ -30,6 +30,14 @@
 
 
 @implementation MLKArray
++(id) array
+{
+  return LAUTORELEASE ([[self alloc]
+                         initWithDimensions:
+                           [NSArray arrayWithObject:
+                                      [MLKInteger integerWithInt:0]]]);
+}
+
 -(id) initWithDimensions:(NSArray *)dimensions
 {
   NSEnumerator *e;
diff --git a/MLKCompiledClosure.h b/MLKCompiledClosure.h
index 589c0de..772f29c 100644
--- a/MLKCompiledClosure.h
+++ b/MLKCompiledClosure.h
@@ -27,9 +27,8 @@
 @interface MLKCompiledClosure : NSObject <MLKFuncallable>
 {
   int _dataLength;
-  id (**_code)();
+  id (*_code)();
   id *_data;
-  BOOL _ownPointer;  // do we own the _code pointer cell?
 }
 
 // Why intptr_t?  Because it makes it easier to call this method from
@@ -47,5 +46,8 @@
 -(NSString *) description;
 -(NSString *) descriptionForLisp;
 
+-(id (*)()) code;
+-(void *) closureData;
+
 -(void) dealloc;
 @end
diff --git a/MLKCompiledClosure.m b/MLKCompiledClosure.m
index 5dbf6dd..73f308b 100644
--- a/MLKCompiledClosure.m
+++ b/MLKCompiledClosure.m
@@ -38,10 +38,7 @@
 
   _data = data;
   _dataLength = dataLength;
-  _ownPointer = YES;
-
-  _code = malloc (sizeof (id (*)()));
-  *_code = code;
+  _code = code;
 
   for (i = 0; i < _dataLength; i++)
     {
@@ -75,7 +72,7 @@
   for (i = 1; i < argc - 1; i++)
     {
       arg_types[i] = &ffi_type_pointer;
-      argpointers[i-1] = denullify([arguments objectAtIndex:i]);
+      argpointers[i-1] = denullify([arguments objectAtIndex:(i-1)]);
       argv[i] = &argpointers[i-1];
     }
 
@@ -89,9 +86,15 @@
                    format:@"FFI type is invalid (this is probably a bug)."];
     }
 
-  ffi_call (&cif, FFI_FN (*_code), &return_value, (void**)argv);
+//   NSLog (@"Calling %p (argc = %d)", _code, argc);
+//   for (i = 0; i < argc; i++)
+//     {
+//       NSLog (@"Argument %d: %p", i, *((void**)argv[i]));
+//     }
+
+  ffi_call (&cif, FFI_FN (_code), &return_value, (void**)argv);
 
-  // FIXME
+  // FIXME: multiple values
   return [NSArray arrayWithObject:nullify(return_value)];
 }
 
@@ -105,22 +108,27 @@
   return [NSString stringWithFormat:@"<Compiled closure @%p>", self];
 }
 
+-(id (*)()) code
+{
+  return _code;
+}
+
+-(void *) closureData
+{
+  return _data;
+}
+
 -(void) dealloc
 {
   int i;
 
   [super dealloc];
 
-  // FIXME: Decrease refcount of *_code.  Note: When releasing *_code,
-  // also release _code regardless of whether we own it.
-
+  // FIXME: Decrease refcount of _code.
   for (i = 0; i < _dataLength; i++)
     {
       LRELEASE (_data[i]);
     }
   free (_data);
-
-  if (_ownPointer)
-    free (_code);
 }
 @end
diff --git a/MLKForm.m b/MLKForm.m
index e78a790..a5bebe5 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -292,7 +292,20 @@
 -(id) complete
 {
   self = [super complete];
-  LASSIGN (_argumentForms, [_tail array]);
+
+  id rest;
+  NSMutableArray *argumentForms = [NSMutableArray array];
+
+  rest = [_form cdr];
+  while (rest)
+    {
+      [argumentForms addObject:[MLKForm formWithObject:[rest car]
+                                        inContext:_context
+                                        forCompiler:_compiler]];
+      rest = [rest cdr];
+    }
+
+  LASSIGN (_argumentForms, argumentForms);
   return self;
 }
 
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 42d22ed..693c742 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -1320,7 +1320,6 @@
       NSString *formdesc;
       NSAutoreleasePool *pool;
 
-      //NSLog (@"%@", code);
       //NSLog (@"%@", MLKPrintToString(code));
       //NSLog (@"%@", stream);
       //NSLog (@"...");
@@ -1328,9 +1327,9 @@
       pool = [[NSAutoreleasePool alloc] init];
 
       code = [MLKReader readFromStream:stream
-                           eofError:NO
-                           eofValue:eofValue
-                           recursive:NO
+                        eofError:NO
+                        eofValue:eofValue
+                        recursive:NO
                         preserveWhitespace:NO];
 
       if (code == eofValue)
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 7a38679..379d791 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -53,6 +53,14 @@ using namespace llvm;
                    onObject:(Value *)object
          withArgumentVector:(std::vector<Value*> *)argv
                        name:(NSString *)name;
++(Value *) insertMethodCall:(NSString *)messageName
+                   onObject:(Value *)object
+         withArgumentVector:(std::vector<Value*> *)argv
+                       name:(NSString *)name
+                 returnType:(const Type *)returnType;
++(Value *) insertVoidMethodCall:(NSString *)messageName
+                       onObject:(Value *)object
+             withArgumentVector:(std::vector<Value*> *)argv;
 
 +(Value *) insertMethodCall:(NSString *)messageName
                    onObject:(Value *)object;
@@ -61,6 +69,8 @@ using namespace llvm;
                    withName:(NSString *)name;
 
 +(Value *) insertClassLookup:(NSString *)className;
+
++(void) insertTrace:(NSString *)message;
 #endif
 @end
 
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 3ad0c10..4313ac9 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -35,6 +35,8 @@
 #include <llvm/Support/IRBuilder.h>
 #include <llvm/Target/TargetData.h>
 #include <llvm/Transforms/Scalar.h>
+#include <llvm/Transforms/IPO.h>
+#include <llvm/Transforms/Utils/UnifyFunctionExitNodes.h>
 #include <llvm/Value.h>
 
 #include <deque>
@@ -45,7 +47,7 @@ using namespace llvm;
 
 static ExecutionEngine *execution_engine;
 static llvm::Module *module;
-static IRBuilder builder;
+static IRBuilder<true, ConstantFolder> builder;
 static FunctionPassManager *fpm;
 static PointerType *PointerTy;
 static ModuleProvider *module_provider;
@@ -78,10 +80,21 @@ static Constant
   module_provider = new ExistingModuleProvider (module);
   fpm = new FunctionPassManager (module_provider);
   fpm->add (new TargetData (*execution_engine->getTargetData()));
+  //fpm->add (new TargetData (module));
   fpm->add (createInstructionCombiningPass());
   fpm->add (createReassociatePass());
   fpm->add (createGVNPass());
+  //  fpm->add (createVerifierPass());
+  //fpm->add (createLowerSetJmpPass());
+  //fpm->add (createRaiseAllocationsPass());
   fpm->add (createCFGSimplificationPass());
+  fpm->add (createPromoteMemoryToRegisterPass());
+  //fpm->add (createGlobalOptimizerPass());
+  //fpm->add (createGlobalDCEPass());
+  //fpm->add (createFunctionInliningPass());
+
+  // Utilities.
+  //  fpm->add (createUnifyFunctionExitNodesPass());
 }
 
 +(id) compile:(id)object
@@ -108,16 +121,19 @@ static Constant
                                  forCompiler:self]];
 
   builder.CreateRet (v);
-  function->dump();
   verifyFunction (*function);
   fpm->run (*function);
 
   // JIT-compile.
   fn = (id (*)()) execution_engine->getPointerToFunction (function);
+  module->dump();
+  NSLog (@"%p", fn);
 
   // Execute.
   lambdaForm = fn();
 
+  NSLog (@"Closure built.");
+
   return lambdaForm;
 }
 
@@ -169,23 +185,53 @@ static Constant
                name:@""];
 }
 
++(Value *) insertVoidMethodCall:(NSString *)messageName
+                       onObject:(Value *)object
+             withArgumentVector:(std::vector<Value*> *)argv
+{
+  return [self insertMethodCall:messageName
+               onObject:object
+               withArgumentVector:argv
+               name:@""
+               returnType:(Type::VoidTy)];
+}
+
++(Value *) insertMethodCall:(NSString *)messageName
+                   onObject:(Value *)object
+         withArgumentVector:(std::vector<Value*> *)argv
+                       name:(NSString *)name
+{
+  return [self insertMethodCall:messageName
+               onObject:object
+               withArgumentVector:argv
+               name:@""
+               returnType:PointerTy];
+}
+
 +(Value *) insertMethodCall:(NSString *)messageName
                    onObject:(Value *)object
          withArgumentVector:(std::vector<Value*> *)argv
-                       name:(NSString *)name;
+                       name:(NSString *)name
+                 returnType:(const Type *)returnType
 {
   std::vector <const Type *> argtypes (2, PointerTy);
-  FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true);
-  Constant *function = 
-    module->getOrInsertFunction (
+  FunctionType *ftype = FunctionType::get (returnType, argtypes, true);
+
+  Value *sel = [self insertSelectorLookup:messageName];
+
 #ifdef __NEXT_RUNTIME__
-                                 "objc_msgSend",
+  Constant *function = 
+    module->getOrInsertFunction ("objc_msgSend", ftype);
 #else
-                                 "objc_msg_send",
+  std::vector <const Type *> lookup_argtypes (2, PointerTy);
+  FunctionType *lookup_ftype = FunctionType::get (PointerType::get (ftype, 0),
+                                                  lookup_argtypes,
+                                                  false);
+  Constant *lookup_function = 
+    module->getOrInsertFunction ("objc_msg_lookup", lookup_ftype);
+  Value *function =
+    builder.CreateCall2 (lookup_function, object, sel, "method_impl");
 #endif
-                                 ftype);
-
-  Value *sel = [self insertSelectorLookup:messageName];
 
   // XXX The following doesn't work.  Why?
   //  std::deque <Value *> argd (*argv);
@@ -240,6 +286,17 @@ static Constant
   Constant *nameptr = createGlobalStringPtr (cname);
   return builder.CreateCall (function, nameptr, cname);
 }
+
++(void) insertTrace:(NSString *)message
+{
+  Constant *function =
+    module->getOrInsertFunction ("puts",
+                                 Type::Int32Ty,
+                                 PointerTy,
+                                 NULL);
+  
+  builder.CreateCall (function, createGlobalStringPtr ([message UTF8String]));
+}
 @end
 
 
@@ -309,12 +366,12 @@ static Constant
 
   if ([_context variableHeapAllocationForSymbol:_form])
     {
-      Value *binding = builder.CreateLoad ([_context bindingForSymbol:_form]);
+      Value *binding = builder.CreateLoad ([_context bindingValueForSymbol:_form]);
       value = [_compiler insertMethodCall:@"value" onObject:binding];
     }
   else
     {
-      value = builder.CreateLoad ([_context valueForSymbol:_form],
+      value = builder.CreateLoad ([_context valueValueForSymbol:_form],
                                   [MLKPrintToString(_form) UTF8String]);
     }
 
@@ -332,15 +389,16 @@ static Constant
       // XXX Issue a style warning.
     }
 
-  Value *functionCell = builder.CreateLoad ([_context functionCellForSymbol:_head]);
+  Value *functionCell = builder.Insert ([_context functionCellValueForSymbol:_head]);
   Value *functionPtr = builder.CreateLoad (functionCell);
-  Value *closureDataPointer = builder.CreateLoad ([_context closureDataPointerForSymbol:_head]);
+  Value *closureDataCell = builder.Insert ([_context closureDataPointerValueForSymbol:_head]);
+  Value *closureDataPtr = builder.CreateLoad (closureDataCell);
 
   NSEnumerator *e = [_argumentForms objectEnumerator];
   MLKForm *form;
 
   std::vector<Value *> args;
-  args.push_back (closureDataPointer);
+  args.push_back (closureDataPtr);
 
   while ((form = [e nextObject]))
     {
@@ -382,6 +440,8 @@ static Constant
   BasicBlock *loopBlock = BasicBlock::Create ("load_args");
   BasicBlock *loopInitBlock = BasicBlock::Create ("load_args_prelude");
   BasicBlock *joinBlock = BasicBlock::Create ("function_body");
+  BasicBlock *lambdaListNewBlock = BasicBlock::Create ("lambda_list_new");
+  BasicBlock *lambdaListUpdateBlock = BasicBlock::Create ("lambda_list_update");
 
   builder.SetInsertPoint (initBlock);
 
@@ -398,13 +458,14 @@ static Constant
                                                    NULL),
                       ap);
 
-  Value *nsmutablearray = [_compiler insertClassLookup:@"NSMutableArray"];
   Value *mlkcons = [_compiler insertClassLookup:@"MLKCons"];
+
+  // FIXME: Heap-allocate if appropriate.
   Value *lambdaList = builder.CreateAlloca (PointerTy, NULL, "lambda_list");
+  Value *lambdaListTail = builder.CreateAlloca (PointerTy, NULL, "lambda_list_tail");
 
-  builder.CreateStore ([_compiler insertMethodCall:@"array"
-                                  onObject:nsmutablearray],
-                       lambdaList);
+  builder.CreateStore (ConstantPointerNull::get (PointerTy), lambdaList);
+  builder.CreateStore (ConstantPointerNull::get (PointerTy), lambdaListTail);
 
   builder.CreateBr (loopInitBlock);
   builder.SetInsertPoint (loopInitBlock);
@@ -416,13 +477,35 @@ static Constant
   builder.SetInsertPoint (loopBlock);
   function->getBasicBlockList().push_back (loopBlock);
 
+  builder.CreateCondBr (builder.CreateICmpEQ (builder.CreateLoad (lambdaList),
+                                              ConstantPointerNull::get (PointerTy)),
+                        lambdaListNewBlock,
+                        lambdaListUpdateBlock);
+
+  builder.SetInsertPoint (lambdaListNewBlock);
+  function->getBasicBlockList().push_back (lambdaListNewBlock);
   std::vector <Value *> argv (1, arg);
-  builder.CreateStore ([_compiler insertMethodCall:@"addObject:"
-                                  onObject:builder.CreateLoad(lambdaList)
-                                  withArgumentVector:&argv],
-                       lambdaList);
+  argv.push_back (ConstantPointerNull::get (PointerTy));
+  Value *newLambdaList = [_compiler insertMethodCall:@"cons:with:"
+                                    onObject:mlkcons
+                                    withArgumentVector:&argv];
+  builder.CreateStore (newLambdaList, lambdaList);
+  builder.CreateStore (newLambdaList, lambdaListTail);
+  builder.CreateBr (loopInitBlock);
 
+  builder.SetInsertPoint (lambdaListUpdateBlock);
+  function->getBasicBlockList().push_back (lambdaListUpdateBlock);
+
+  Value *newCons = [_compiler insertMethodCall:@"cons:with:"
+                              onObject:mlkcons
+                              withArgumentVector:&argv];
+  std::vector <Value *> setcdr_argv (1, newCons);
+  [_compiler insertVoidMethodCall:@"setCdr:"
+             onObject:builder.CreateLoad(lambdaListTail)
+             withArgumentVector:&setcdr_argv];
+  builder.CreateStore (newCons, lambdaListTail);
   builder.CreateBr (loopInitBlock);
+
   builder.SetInsertPoint (joinBlock);
   function->getBasicBlockList().push_back (joinBlock);
 
@@ -432,12 +515,6 @@ static Constant
                                                    NULL),
                       ap);
 
-  argv[0] = builder.CreateLoad(lambdaList);
-  builder.CreateStore ([_compiler insertMethodCall:@"listWithArray:"
-                                  onObject:mlkcons
-                                  withArgumentVector:&argv],
-                       lambdaList);
-
   NSEnumerator *e = [_bodyForms objectEnumerator];
   MLKForm *form;
   Value *value = NULL;
@@ -451,26 +528,31 @@ static Constant
   while ((form = [e nextObject]))
     {
       //NSLog (@"%LAMBDA: Processing subform.");
+      [form->_context setValueValue:lambdaList forSymbol:_lambdaListName];
       value = [form processForLLVM];
     }
 
   builder.CreateRet (value);
 
   function->dump();
-  NSLog (@"Verify...");
+  //NSLog (@"Verify...");
   verifyFunction (*function);
-  NSLog (@"Optimise...");
+  //NSLog (@"Optimise...");
   fpm->run (*function);
-  NSLog (@"Done.");
+  //NSLog (@"Assemble...");
+  // Explicit assembly is needed in order to allow libffi to call
+  // the function.
+  execution_engine->getPointerToFunction (function);
+  //NSLog (@"Done.");
   function->dump();
-  NSLog (@"Function built.");
+  //NSLog (@"Function built.");
 
   builder.SetInsertPoint (outerBlock);
 
   Value *closure_data = ConstantPointerNull::get (PointerTy);
 
   argv[0] = function;
-  argv.push_back (closure_data);
+  argv[1] = closure_data;
   argv.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
                                                            0,
                                                            false),
@@ -482,6 +564,8 @@ static Constant
                onObject:mlkcompiledclosure
                withArgumentVector:&argv];
 
+  //function->viewCFG();
+
   return closure;
 }
 @end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
index 0e9056b..d42140e 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.h
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -26,6 +26,7 @@
 #include <vector>
 #include <llvm/Value.h>
 #include <llvm/BasicBlock.h>
+#include <llvm/Instructions.h>
 using namespace llvm;
 #endif
 
@@ -34,13 +35,13 @@ using namespace llvm;
 #ifdef __cplusplus
 -(void) setVariableHeapAllocation:(BOOL)heapp forSymbol:(id)name;
 -(BOOL) variableHeapAllocationForSymbol:(id)name;
--(Value *) functionCellForSymbol:(id)name;
--(Value *) closureDataPointerForSymbol:(id)name;
--(Value *) bindingForSymbol:(id)name;
--(Value *) valueForSymbol:(id)name;
--(void) setFunctionCell:(Value *)cellPtr forSymbol:(id)name;
--(void) setClosureDataPointer:(Value *)pointer forSymbol:(id)name;
--(void) setBinding:(Value *)binding forSymbol:(id)name;
--(void) setValue:(Value *)value forSymbol:(id)name;
+-(Instruction *) functionCellValueForSymbol:(id)name;
+-(Instruction *) closureDataPointerValueForSymbol:(id)name;
+-(Value *) bindingValueForSymbol:(id)name;
+-(Value *) valueValueForSymbol:(id)name;
+//-(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name;
+//-(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name;
+//-(void) setBindingValue:(Value *)binding forSymbol:(id)name;
+-(void) setValueValue:(Value *)value forSymbol:(id)name;
 #endif
 @end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm
index 8be1f24..744351a 100644
--- a/MLKLexicalContext-MLKLLVMCompilation.mm
+++ b/MLKLexicalContext-MLKLLVMCompilation.mm
@@ -22,8 +22,11 @@
 #import <Foundation/NSValue.h>
 
 #include <vector>
-#include <llvm/Value.h>
 #include <llvm/BasicBlock.h>
+#include <llvm/Constants.h>
+#include <llvm/DerivedTypes.h>
+#include <llvm/Instructions.h>
+#include <llvm/Value.h>
 using namespace llvm;
 using namespace std;
 
@@ -45,56 +48,65 @@ using namespace std;
   return (flag && [flag boolValue]);
 }
 
--(Value *) functionCellForSymbol:(id)name
+-(Instruction *) functionCellValueForSymbol:(id)name
 {
-  return (Value *) [[self deepPropertyForFunction:name
-                          key:@"LLVM.function-cell"]
-                     pointerValue];
+  std::vector<const Type *> types (1, PointerType::get(Type::Int8Ty, 0));
+  return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+                                             (uint64_t)[self functionCellForSymbol:name],
+                                             false),
+                            PointerType::get(PointerType::get(FunctionType::get(PointerType::get(Type::Int8Ty,
+                                                                                                 0),
+                                                                                types,
+                                                                                true),
+                                                              0),
+                                             0)));
 }
 
--(Value *) closureDataPointerForSymbol:(id)name
+-(Instruction *) closureDataPointerValueForSymbol:(id)name
 {
-  return (Value *) [[self deepPropertyForFunction:name
-                          key:@"LLVM.closure-data-pointer"]
-                     pointerValue];
+  return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+                                             (uint64_t)[self closureDataPointerForSymbol:name],
+                                             false),
+                            PointerType::get(PointerType::get(Type::Int8Ty, 0), 0)));
 }
 
--(Value *) bindingForSymbol:(id)name
+-(Value *) bindingValueForSymbol:(id)name
 {
-  return (Value *) [[self deepPropertyForVariable:name
-                          key:@"LLVM.variable-binding"]
-                     pointerValue];
+  return (new IntToPtrInst (ConstantInt::get(Type::Int64Ty,
+                                             (uint64_t)[self bindingForSymbol:name],
+                                             false),
+                            PointerType::get(Type::Int8Ty, 0)));
 }
 
--(Value *) valueForSymbol:(id)name
+-(Value *) valueValueForSymbol:(id)name
 {
   return (Value *) [[self deepPropertyForVariable:name
                           key:@"LLVM.variable-value"]
                      pointerValue];
 }
 
--(void) setFunctionCell:(Value *)cellPtr forSymbol:(id)name
-{
-  [self setDeepProperty:[NSValue valueWithPointer:cellPtr]
-        forFunction:name
-        key:@"LLVM.function-cell"];
-}
+// -(void) setFunctionCellValue:(Value *)cellPtr forSymbol:(id)name
+// {
+//   [self setDeepProperty:[NSValue valueWithPointer:cellPtr]
+//         forFunction:name
+//         key:@"LLVM.function-cell"];
+// }
 
--(void) setClosureDataPointer:(Value *)pointer forSymbol:(id)name
-{
-  [self setDeepProperty:[NSValue valueWithPointer:pointer]
-        forFunction:name
-        key:@"LLVM.closure-data"];
-}
+// -(void) setClosureDataPointerValue:(Value *)pointer forSymbol:(id)name
+// {
+//   [self setDeepProperty:[NSValue valueWithPointer:pointer]
+//         forFunction:name
+//         key:@"LLVM.closure-data"];
+// }
 
--(void) setBinding:(Value *)binding forSymbol:(id)name
-{
-  [self setDeepProperty:[NSValue valueWithPointer:binding]
-        forVariable:name
-        key:@"LLVM.variable-binding"];
-}
+// -(void) setBindingValue:(Value *)binding forSymbol:(id)name
+// {
+//   [self setDeepProperty:[NSValue valueWithPointer:binding]
+//         forVariable:name
+//         key:@"LLVM.variable-binding"];
+// }
 
--(void) setValue:(Value *)value forSymbol:(id)name
+-(void) setValueValue:(Value *)value forSymbol:(id)name
 {
   [self setDeepProperty:[NSValue valueWithPointer:value]
         forVariable:name
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index de6bfd7..fc2abc3 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -105,5 +105,9 @@
             forFunction:(id)name
                     key:(id)key;
 
+-(void *) functionCellForSymbol:(id)name;
+-(void *) closureDataPointerForSymbol:(id)name;
+-(id) bindingForSymbol:(id)name;
+
 -(void) dealloc;
 @end
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index d051b2a..1eaa51c 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -22,6 +22,7 @@
 #import <Foundation/NSNull.h>
 #import <Foundation/NSSet.h>
 #import <Foundation/NSString.h>
+#import <Foundation/NSValue.h>
 
 #import "MLKCons.h"
 #import "MLKDynamicContext.h"
@@ -358,6 +359,62 @@ static MLKSymbol *LEXICAL;
     }
 }
 
+-(void *) functionCellForSymbol:(id)name
+{
+  id prop = [self deepPropertyForFunction:name
+                  key:@"LEXCTX.function-cell"];
+
+  if (!prop)
+    {
+      void *cell = malloc (sizeof(id (*)()));
+      prop = [NSValue valueWithPointer:cell];
+      [self setDeepProperty:prop
+            forFunction:name
+            key:@"LEXCTX.function-cell"];
+      return cell;
+    }
+  else
+    {
+      return [prop pointerValue];
+    }
+}
+
+-(void *) closureDataPointerForSymbol:(id)name
+{
+  id prop = [self deepPropertyForFunction:name
+                  key:@"LEXCTX.closure-data"];
+
+  if (!prop)
+    {
+      void *cell = malloc (sizeof(id (*)()));
+      prop = [NSValue valueWithPointer:cell];
+      [self setDeepProperty:prop
+            forFunction:name
+            key:@"LEXCTX.closure-data"];
+      return cell;
+    }
+  else
+    {
+      return [prop pointerValue];
+    }
+}
+
+-(id) bindingForSymbol:(id)name
+{
+  id prop = [self deepPropertyForVariable:name
+                  key:@"LEXCTX.variable-binding"];
+
+  if (!prop)
+    {
+      prop = [MLKBinding binding];
+      [self setDeepProperty:prop
+            forVariable:name
+            key:@"LEXCTX.variable-binding"];
+    }
+
+  return prop;
+}
+
 -(void) dealloc
 {
   LRELEASE (_macros);
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
index fbeb9aa..ca6b4a9 100644
--- a/MLKLexicalEnvironment.m
+++ b/MLKLexicalEnvironment.m
@@ -24,8 +24,10 @@
 #import <Foundation/NSString.h>
 #import <Foundation/NSThread.h>
 
+#import "MLKCompiledClosure.h"
 #import "MLKCons.h"
 #import "MLKEnvironment.h"
+#import "MLKLexicalContext.h"
 #import "MLKLexicalEnvironment.h"
 #import "MLKPackage.h"
 #import "MLKParenReader.h"
@@ -141,11 +143,61 @@ static MLKLexicalEnvironment *global_environment;
 -(void) setFunction:(id)value forSymbol:(MLKSymbol *)symbol
 {
   [_functions setValue:value forSymbol:symbol];
+
+  if ([_functions environmentForSymbol:symbol] == global_environment->_functions)
+    {
+      // If we're changing the global environment, we need to
+      // interoperate with compiled code.  In this case, be sure to set
+      // the global function cell.
+      //
+      // Note that this reserves memory for the function cell that is
+      // never freed, which is why we do it for global function bindings
+      // only!
+      id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
+                                   functionCellForSymbol:symbol];
+      void **closure_data_cell = [[MLKLexicalContext globalContext]
+                                   closureDataPointerForSymbol:symbol];
+      if ([value isKindOfClass:[MLKCompiledClosure class]])
+        {
+          *cell = (id (*)(void *, ...))[value code];
+          *closure_data_cell = [value closureData];
+        }
+      else
+        {
+          *cell = MLKInterpretedFunctionTrampoline;
+          *closure_data_cell = value;
+        }
+    }
 }
 
 -(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol
 {
   [_functions addValue:value forSymbol:symbol];
+
+  if (self == global_environment)
+    {
+      // If we're changing the global environment, we need to
+      // interoperate with compiled code.  In this case, be sure to set
+      // the global function cell.
+      //
+      // Note that this reserves memory for the function cell that is
+      // never freed, which is why we do it for global function bindings
+      // only!
+      id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
+                                   functionCellForSymbol:symbol];
+      void **closure_data_cell = [[MLKLexicalContext globalContext]
+                                   closureDataPointerForSymbol:symbol];
+      if ([value isKindOfClass:[MLKCompiledClosure class]])
+        {
+          *cell = (id (*)(void *, ...))[value code];
+          *closure_data_cell = [value closureData];
+        }
+      else
+        {
+          *cell = MLKInterpretedFunctionTrampoline;
+          *closure_data_cell = value;
+        }
+    }
 }
 
 -(BOOL) fboundp:(MLKSymbol *)symbol
diff --git a/MLKPackage.m b/MLKPackage.m
index a05f822..acaf6db 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -154,6 +154,7 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"FIXNUM-EQ"]];
   [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:@"OBJC-CLASS-OF"]];
   [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index 940181c..b051dd3 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -22,6 +22,7 @@
 #import "MLKDynamicContext.h"
 #import "MLKInterpretedClosure.h"
 #import "MLKInterpreter.h"
+#import "MLKLLVMCompiler.h"
 #import "MLKNumber.h"
 #import "MLKPackage.h"
 #import "MLKRoot.h"
@@ -702,4 +703,16 @@ as provided by method %@ of object %@",
                          cons:forms
                          with:nil]]);
 }
+
+#ifdef USE_LLVM
++(NSArray *) compile:(NSArray *)args
+{
+  NSLog (@"Compiling lambda form.");
+  id thing = [MLKLLVMCompiler compile:denullify([args objectAtIndex:0])
+                              inContext:[MLKLexicalContext globalContext]];
+  NSLog (@"Compilation done.");
+  NSLog (@"Compiled: %@", thing);
+  RETURN_VALUE (thing);
+}
+#endif
 @end