MLKLexicalContext: Add management of user-defined function and variable properties.

7 files changed, 235 insertions, 32 deletions

diff --git a/GNUmakefile b/GNUmakefile
index bb43d64..4b7ba22 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -47,23 +47,25 @@ else
   endif
 endif
 
-ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m				\
-                       MLKBackquoteReader.m MLKBinding.m MLKCharacter.m		\
-                       MLKCommaReader.m MLKCompiledClosure.m MLKCons.m		\
-                       MLKDoubleFloat.m						\
-                       MLKDispatchingMacroCharacterReader.m			\
-                       MLKDynamicContext.m MLKEnvironment.m MLKFloat.m		\
-                       MLKForeignProcedure.m MLKForm.m MLKInteger.m		\
-                       MLKInterpretedClosure.m MLKInterpreter.m			\
-                       MLKLexicalContext.m MLKLexicalEnvironment.m		\
-                       MLKNumber.m MLKPackage.m MLKParenReader.m		\
-                       MLKQuoteReader.m MLKRatio.m MLKReader.m			\
-                       MLKReadtable.m MLKReaderError.m MLKRoot.m		\
-                       MLKSemicolonReader.m MLKSharpsignColonReader.m		\
-                       MLKSingleFloat.m MLKStream.m				\
-                       MLKStringInputStream.m MLKStringOutputStream.m		\
-                       MLKStringReader.m MLKSymbol.m MLKThrowException.m	\
-                       MLKValuesFunction.m NSObject-MLKPrinting.m		\
+ToiletKit_OBJC_FILES = functions.m globals.m MLKArray.m			\
+                       MLKBackquoteReader.m MLKBinding.m MLKCharacter.m	\
+                       MLKCommaReader.m MLKCompiledClosure.m MLKCons.m	\
+                       MLKDoubleFloat.m					\
+                       MLKDispatchingMacroCharacterReader.m		\
+                       MLKDynamicContext.m MLKEnvironment.m MLKFloat.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	\
+                       MLKRoot.m MLKSemicolonReader.m			\
+                       MLKSharpsignColonReader.m MLKSingleFloat.m	\
+                       MLKStream.m MLKStringInputStream.m		\
+                       MLKStringOutputStream.m MLKStringReader.m	\
+                       MLKSymbol.m MLKThrowException.m			\
+                       MLKValuesFunction.m NSObject-MLKPrinting.m	\
                        NSString-MLKPrinting.m
 ToiletKit_OBJCFLAGS = -Wall
 ToiletKit_LDFLAGS = -lgmp -lffi -ldl
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 4f167bb..7a38679 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -19,6 +19,7 @@
 #import "MLKForm.h"
 #import "MLKInterpreter.h"
 #import "MLKLexicalContext.h"
+#import "MLKLexicalContext-MLKLLVMCompilation.h"
 
 #import <Foundation/NSObject.h>
 #import <Foundation/NSString.h>
@@ -68,13 +69,4 @@ using namespace llvm;
 @interface MLKForm (MLKLLVMCompilation)
 -(Value *) processForLLVM;
 @end
-
-
-@interface MLKLexicalContext (MLKLLVMCompilation)
--(BOOL) isHeapVariable:(id)name;
--(Value *) functionCellForSymbol:(id)name;
--(Value *) closureDataPointerForSymbol:(id)name;
--(Value *) bindingForSymbol:(id)name;
--(Value *) valueForSymbol:(id)name;
-@end
 #endif
diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm
index 3c37eca..f09e03f 100644
--- a/MLKLLVMCompiler.mm
+++ b/MLKLLVMCompiler.mm
@@ -100,7 +100,7 @@ static Constant
   builder.CreateRet (v);
   function->dump();
   verifyFunction (*function);
-  fpm->run (*function);
+  //fpm->run (*function);
 
   // JIT-compile.
   fn = (id (*)()) execution_engine->getPointerToFunction (function);
@@ -297,7 +297,7 @@ static Constant
 {
   Value *value;
 
-  if ([_context isHeapVariable:self])
+  if ([_context variableHeapAllocationForSymbol:_form])
     {
       Value *binding = builder.CreateLoad ([_context bindingForSymbol:_form]);
       value = [_compiler insertMethodCall:@"value" onObject:binding];
@@ -449,8 +449,9 @@ static Constant
   function->dump();
   NSLog (@"Verify...");
   verifyFunction (*function);
-  NSLog (@"FPM...");
-  fpm->run (*function);
+  //  NSLog (@"FPM...");
+  //  fpm->run (*function);
+  NSLog (@"Done.");
 
   builder.SetInsertPoint (outerBlock);
 
@@ -458,13 +459,16 @@ static Constant
 
   argv[0] = function;
   argv.push_back (closure_data);
+  argv.push_back (builder.CreateIntToPtr (ConstantInt::get(Type::Int64Ty,
+                                                           0,
+                                                           false),
+                                          PointerTy));
   Value *mlkcompiledclosure = [_compiler
                                 insertClassLookup:@"MLKCompiledClosure"];
   Value *closure =
-    [_compiler insertMethodCall:@"closureWithCode:data:"
+    [_compiler insertMethodCall:@"closureWithCode:data:length:"
                onObject:mlkcompiledclosure
                withArgumentVector:&argv];
-  outerBlock->dump();
 
   return closure;
 }
diff --git a/MLKLexicalContext-MLKLLVMCompilation.h b/MLKLexicalContext-MLKLLVMCompilation.h
new file mode 100644
index 0000000..37e80dc
--- /dev/null
+++ b/MLKLexicalContext-MLKLLVMCompilation.h
@@ -0,0 +1,42 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKForm.h"
+#import "MLKLexicalContext.h"
+
+#import <Foundation/NSObject.h>
+#import <Foundation/NSString.h>
+
+#ifdef __cplusplus
+#include <vector>
+#include <llvm/Value.h>
+#include <llvm/BasicBlock.h>
+using namespace llvm;
+#endif
+
+
+@interface MLKLexicalContext (MLKLLVMCompilation)
+#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;
+#endif
+@end
diff --git a/MLKLexicalContext-MLKLLVMCompilation.mm b/MLKLexicalContext-MLKLLVMCompilation.mm
new file mode 100644
index 0000000..7e81ccb
--- /dev/null
+++ b/MLKLexicalContext-MLKLLVMCompilation.mm
@@ -0,0 +1,75 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKLexicalContext-MLKLLVMCompilation.h"
+
+#import <Foundation/NSString.h>
+#import <Foundation/NSValue.h>
+
+#include <vector>
+#include <llvm/Value.h>
+#include <llvm/BasicBlock.h>
+using namespace llvm;
+using namespace std;
+
+
+@implementation MLKLexicalContext (MLKLLVMCompilation)
+-(void) setVariableHeapAllocation:(BOOL)heapp
+                        forSymbol:(id)name
+{
+  [self setDeepProperty:[NSNumber numberWithBool:heapp]
+        forVariable:name
+        key:@"LLVM.heap-flag"];
+}
+
+-(BOOL) variableHeapAllocationForSymbol:(id)name;
+{
+  id flag = [self deepPropertyForVariable:name
+                  key:@"LLVM.heap-flag"];
+
+  return (flag && [flag boolValue]);
+}
+
+-(Value *) functionCellForSymbol:(id)name
+{
+  return (Value *) [[self deepPropertyForFunction:name
+                          key:@"LLVM.function-cell"]
+                     pointerValue];
+}
+
+-(Value *) closureDataPointerForSymbol:(id)name
+{
+  return (Value *) [[self deepPropertyForFunction:name
+                          key:@"LLVM.closure-data-pointer"]
+                     pointerValue];
+}
+
+-(Value *) bindingForSymbol:(id)name
+{
+  return (Value *) [[self deepPropertyForVariable:name
+                          key:@"LLVM.variable-binding"]
+                     pointerValue];
+}
+
+-(Value *) valueForSymbol:(id)name
+{
+  return (Value *) [[self deepPropertyForVariable:name
+                          key:@"LLVM.variable-value"]
+                     pointerValue];
+}
+@end
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index 0a37a35..de6bfd7 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -19,6 +19,7 @@
 #import "MLKFuncallable.h"
 
 #import <Foundation/NSArray.h>
+#import <Foundation/NSDictionary.h>
 #import <Foundation/NSSet.h>
 
 @class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSSet,
@@ -36,6 +37,8 @@
   MLKEnvironment *_goTags;
   NSMutableSet *_functions;
   NSMutableSet *_variables;
+  NSMutableDictionary *_functionInfo;
+  NSMutableDictionary *_variableInfo;
   id _declarations;
   MLKLexicalContext *_parent;
 }
@@ -92,5 +95,15 @@
 
 -(BOOL) variableIsLexical:(MLKSymbol *)symbol;
 
+-(id) deepPropertyForVariable:(id)name key:(id)key;
+-(void) setDeepProperty:(id)object
+            forVariable:(id)name
+                    key:(id)key;
+
+-(id) deepPropertyForFunction:(id)name key:(id)key;
+-(void) setDeepProperty:(id)object
+            forFunction:(id)name
+                    key:(id)key;
+
 -(void) dealloc;
 @end
diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m
index 001cd5c..d051b2a 100644
--- a/MLKLexicalContext.m
+++ b/MLKLexicalContext.m
@@ -99,6 +99,9 @@ static MLKSymbol *LEXICAL;
   LASSIGN (_knownSymbolMacros, [NSMutableSet setWithArray:[symbolMacros allKeys]]);
 
   LASSIGN (_declarations, declarations);
+
+  _functionInfo = [[NSMutableDictionary alloc] init];
+  _variableInfo = [[NSMutableDictionary alloc] init];
   return self;  
 }
 
@@ -285,6 +288,76 @@ static MLKSymbol *LEXICAL;
   [_functions addObject:symbol];
 }
 
+-(id) deepPropertyForVariable:(id)name key:(id)key
+{
+  NSDictionary *props = [_variableInfo objectForKey:name];
+  id property;
+
+  if (props && (property = [props objectForKey:key]))
+    return property;
+  else if (!_parent || [_variables containsObject:name])
+    return nil;
+  else
+    return [_parent deepPropertyForVariable:name key:key];
+}
+
+-(void) setDeepProperty:(id)object
+            forVariable:(id)name
+                    key:(id)key
+{
+  // Changes propagate up to the origin of the binding.  If there is no
+  // lexically apparent binding, the property is set in the global
+  // context.  This does not make it pervasive, however.
+
+  if (!_parent || [_variables containsObject:name])
+    {
+      NSMutableDictionary *props = [_variableInfo objectForKey:name];
+      if (!props)
+        {
+          props = [NSMutableDictionary dictionary];
+          [_variableInfo setObject:props forKey:name];
+        }
+      [props setObject:object forKey:key];
+    }
+  else
+    {
+      [_parent setDeepProperty:object forVariable:name key:key];
+    }
+}
+
+-(id) deepPropertyForFunction:(id)name key:(id)key
+{
+  NSDictionary *props = [_functionInfo objectForKey:name];
+  id property;
+
+  if (props && (property = [props objectForKey:key]))
+    return property;
+  else if (!_parent || [_functions containsObject:name])
+    return nil;
+  else
+    return [_parent deepPropertyForFunction:name key:key];
+}
+
+-(void) setDeepProperty:(id)object
+            forFunction:(id)name
+                    key:(id)key
+{
+  if (!_parent || [_functions containsObject:name])
+    {
+      NSMutableDictionary *props = [_functionInfo objectForKey:name];
+      if (!props)
+        {
+          props = [NSMutableDictionary dictionary];
+          [_functionInfo setObject:props forKey:name];
+        }
+      [props setObject:object forKey:key];
+    }
+  else
+    {
+      [_parent setDeepProperty:object forFunction:name key:key];
+    }
+}
+
 -(void) dealloc
 {
   LRELEASE (_macros);
@@ -298,6 +371,8 @@ static MLKSymbol *LEXICAL;
   LRELEASE (_variables);
   LRELEASE (_declarations);
   LRELEASE (_parent);
+  LRELEASE (_variableInfo);
+  LRELEASE (_functionInfo);
   [super dealloc];
 }
 @end