From efa4eaca17fd6c1e19210f069fe9963c185fa200 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Tue, 12 Aug 2008 11:22:58 +0200
Subject: LLVM compiler: Have %LAMBDA forms return closures rather than
 function pointers.

---
 MLKForm.m          |  2 +-
 MLKLLVMCompiler.h  |  3 +++
 MLKLLVMCompiler.mm | 42 +++++++++++++++++++++++++++++++++++++-----
 3 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/MLKForm.m b/MLKForm.m
index 19b8dda..e78a790 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -915,7 +915,7 @@
   self = [super complete];
 
   LASSIGN (_type, [_form car]);
-  LASSIGN (_arguments, [_form cdr] ? [[_form cdr] array] : [NSArray array]);
+  LASSIGN (_arguments, [_form cdr] ? (id)[[_form cdr] array] : (id)[NSArray array]);
 
   return self;
 }
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index c0e9e7c..a57a33f 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -17,6 +17,7 @@
  */
 
 #import "MLKForm.h"
+#import "MLKInterpreter.h"
 #import "MLKLexicalContext.h"
 
 #import <Foundation/NSObject.h>
@@ -35,6 +36,8 @@ using namespace llvm;
     inContext:(MLKLexicalContext *)context;
 
 +(void) processTopLevelForm:(id)object;
++(void) processTopLevelForm:(id)object
+                     inMode:(enum MLKProcessingMode)mode;
 
 #ifdef __cplusplus
 +(Value *) processForm:(MLKForm *)form;
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 3d38677..e31f032 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -45,7 +45,7 @@ static ExecutionEngine *execution_engine;
 static llvm::Module *module;
 static IRBuilder builder;
 static FunctionPassManager *fpm;
-static Type *PointerTy;
+static PointerType *PointerTy;
 
 
 static Constant
@@ -87,6 +87,7 @@ static Constant
                                          Function::ExternalLinkage,
                                          "",
                                          module);
+  id lambdaForm;
   id (*fn)();
 
   block = BasicBlock::Create ("entry", function);
@@ -103,12 +104,27 @@ static Constant
 
   // JIT-compile.
   fn = (id (*)()) execution_engine->getPointerToFunction (function);
-  return fn ();
+
+  // Execute.
+  lambdaForm = fn();
+
+  return lambdaForm;
 }
 
 +(void) processTopLevelForm:(id)object
+{
+  [self processTopLevelForm:object
+        inMode:not_compile_time_mode];
+}
+
+
++(void) processTopLevelForm:(id)object
+                     inMode:(enum MLKProcessingMode)mode
 {
   //FIXME
+  // If PROGN, do this...  If EVAL-WHEN, do that...
+
+  
 }
 
 +(Value *) processForm:(MLKForm *)form
@@ -202,7 +218,7 @@ static Constant
   Value *value = NULL;
 
   if ([_bodyForms count] == 0)
-    value = ConstantPointerNull::get (PointerType::get(Type::Int8Ty, 0));
+    value = ConstantPointerNull::get (PointerTy);
 
   while ((form = [e nextObject]))
     {
@@ -311,10 +327,11 @@ static Constant
   std::vector <const Type *> argtypes (1, PointerTy);
   FunctionType *ftype = FunctionType::get (PointerTy, argtypes, true);
   Function *function = Function::Create (ftype,
-                                         Function::ExternalLinkage,
+                                         Function::InternalLinkage,
                                          "",
                                          module);
 
+  BasicBlock *outerBlock = builder.GetInsertBlock ();
   BasicBlock *initBlock = BasicBlock::Create ("init_function", function);
   BasicBlock *loopBlock = BasicBlock::Create ("load_args");
   BasicBlock *loopInitBlock = BasicBlock::Create ("load_args_init");
@@ -398,6 +415,21 @@ static Constant
   function->dump();
   verifyFunction (*function);
   fpm->run (*function);
-  return function;
+
+  builder.SetInsertPoint (outerBlock);
+
+  Value *closure_data = ConstantPointerNull::get (PointerTy);
+
+  argv[0] = function;
+  argv.push_back (closure_data);
+  Value *mlkcompiledclosure = [_compiler
+                                insertClassLookup:@"MLKCompiledClosure"];
+  Value *closure =
+    builder.CreateStore ([_compiler insertMethodCall:@"closureWithCode:data:"
+                                    onObject:mlkcompiledclosure
+                                    withArgumentVector:&argv],
+                         lambdaList);
+
+  return closure;
 }
 @end
-- 
cgit v1.2.3