Implement most of the MLKForm class cluster.

5 files changed, 419 insertions, 5 deletions

diff --git a/MLKCons.h b/MLKCons.h
index f2fee99..eb6b2bd 100644
--- a/MLKCons.h
+++ b/MLKCons.h
@@ -42,6 +42,7 @@
 -(void) appendObject:(id)object;
 -(MLKCons *) listByAppendingObject:(id)object;
 -(MLKCons *) copyList;
+-(int) length;
 
 -(NSString *) bareDescriptionForLisp;  // description without
                                        // parentheses, for internal use
diff --git a/MLKCons.m b/MLKCons.m
index 67aba08..bee917f 100644
--- a/MLKCons.m
+++ b/MLKCons.m
@@ -133,6 +133,14 @@
   return [self listByAppendingObject:nil];
 }
 
+-(int) length
+{
+  if (_cdr)
+    return 1 + [_cdr length];
+  else
+    return 1;
+}
+
 -(NSString *) bareDescriptionForLisp
 {
   if (!_cdr)
diff --git a/MLKForm.h b/MLKForm.h
index b918703..4dd9580 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -124,6 +124,7 @@
 
 @interface MLKSimpleDefmacroForm : MLKDeclaringForm
 {
+  MLKSymbol *_lambdaListName;
   MLKSymbol *_name;
 }
 @end
@@ -219,14 +220,17 @@
 @end
 
 
+@interface MLKLocallyForm : MLKDeclaringForm
+@end
+
+
 @interface MLKSimpleLoopForm : MLKCompoundForm
 @end
 
 
-@interface MLKMultipleValueCallForm : MLKCompoundForm
+@interface MLKMultipleValueCallForm : MLKBodyForm
 {
   id _functionForm;
-  NSArray *_subforms;
 }
 @end
 
@@ -245,14 +249,14 @@
 
 @interface MLKQuoteForm : MLKCompoundForm
 {
-  MLKForm *_quotedForm;
+  id _quotedData;
 }
 @end
 
 
 @interface MLKSetQForm : MLKCompoundForm
 {
-  NSArray *_variableForms;
+  NSArray *_variables;
   NSArray *_valueForms;
 }
 @end
@@ -260,7 +264,7 @@
 
 @interface MLKFSetQForm : MLKCompoundForm
 {
-  NSArray *_functionNameForms;
+  NSArray *_functionNames;
   NSArray *_valueForms;
 }
 @end
@@ -295,3 +299,15 @@
   MLKForm *_protectedForm;
 }
 @end
+
+
+@interface MLKSimpleFunctionBindingForm : MLKDocstringForm
+{
+  id _name;
+  MLKSymbol *_lambdaListName;
+}
+
++(id) formWithObject:(id)object
+           inContext:(MLKLexicalContext *)context
+         forCompiler:(id)compiler;
+@end
diff --git a/MLKForm.m b/MLKForm.m
index 9e72681..0ced0ec 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -18,11 +18,20 @@
 
 #import "MLKCons.h"
 #import "MLKForm.h"
+#import "MLKLLVMCompiler.h"
 #import "util.h"
 #import "special-symbols.h"
 
+#import <Foundation/NSArray.h>
+#import <Foundation/NSSet.h>
 #import <Foundation/NSString.h>
 
+#include <stdlib.h>
+
+#define MAKE_FORM(OBJECT)            \
+  [MLKForm formWithObject:OBJECT     \
+                inContext:_context   \
+              forCompiler:_compiler]
 
 @implementation MLKForm
 -(void) initialize
@@ -226,22 +235,112 @@
 // {
 //   return [_context functionInfoForSymbol:_head];
 // }
+
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_argumentForms, [_tail array]);
+  return self;
+}
 @end
 
 
 @implementation MLKCatchForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_tagForm, [_tail car]);
+  LASSIGN (_bodyForms, [[_tail cdr] array]);
+  return self;
+}
 @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 processDeclarations:[[_tail cdr] cdr]]];
+
+  [self processBody:[[_tail cdr] cdr]
+          inContext:newContext];
+  return self;
+}
 @end
 
 
 @implementation MLKEvalWhenForm
+-(id) complete
+{
+  id rest;
+
+  self = [super complete];
+
+  rest = [_tail car];
+  while (rest)
+    {
+      _compileToplevel |= ([rest car] == COMPILE_TOPLEVEL);
+      _loadToplevel |= ([rest car] == LOAD_TOPLEVEL);
+      _execute |= ([rest car] == EXECUTE);
+      rest = [rest cdr];
+    }
+
+  [self procesRawBody:[_tail cdr]];
+  return self;
+}
 @end
 
 
 @implementation MLKForeignLambdaForm
+-(id) complete
+{
+  id argtypes;
+  int i;
+
+  self = [super complete];
+  LASSIGN (_foreignName, [[_tail cdr] car]);
+  LASSIGN (_name, [_tail car]);
+  _returnType = MLKForeignTypeWithTypeDesignator ([[[_tail cdr] cdr] car]);
+
+  argtypes = [[[_tail cdr] cdr] cdr];
+
+  _argc = [argtypes length];
+  _argumentTypes = malloc (_argc * sizeof (MLKForeignType));
+  while (argtypes)
+    {
+      _argumentTypes[i] = MLKForeignTypeWithTypeDesignator ([argtypes car]);
+      argtypes = [argtypes cdr];
+    }
+
+  return self;
+}
+@end
+
+
+@implementation MLKLambdaForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_lambdaList, [_tail car]);
+
+  // FIXME
+  [NSException raise:@"MLKNotImplementedError"
+              format:@"LAMBDA not yet implemented in the compiler"];
+  
+  return self;
+}
 @end
 
 
@@ -259,76 +358,364 @@
 
 
 @implementation MLKLambdaFunctionForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_lambdaForm, MAKE_FORM ([_tail car]));
+  return self;
+}
 @end
 
 
 @implementation MLKSimpleFunctionForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_functionName, [_tail car]);
+  return self;
+}
 @end
 
 
 @implementation MLKIfForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_conditionForm, MAKE_FORM ([_tail car]));
+  LASSIGN (_consequentForm, MAKE_FORM ([[_tail cdr] car]));
+  LASSIGN (_alternativeForm, MAKE_FORM ([[[_tail cdr] cdr] car]));
+  return self;
+}
 @end
 
 
 @implementation MLKInPackageForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_packageDesignator, [_tail car]);
+  return self;
+}
 @end
 
 
 @implementation MLKSimpleLambdaForm
+-(id) complete
+{
+  MLKLexicalContext *newContext;
+  
+  self = [super complete];
+  
+  LASSIGN (_lambdaListName, [_tail car]);
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:[NSSet setWithObject:_lambdaListName]
+                                          functions:nil
+                                             goTags:nil
+                                             macros:nil
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self processDeclarations:[_tail cdr]]];
+  
+  [self processBody:[_tail cdr]
+          inContext:newContext];
+  return self;
+}
 @end
 
 
 @implementation MLKSimpleMacroletForm
+-(id) initWithObject:(id)object
+           inContext:(MLKLexicalContext *)context
+         forCompiler:(id)compiler
+{
+  MLKLexicalContext *newContext;
+  MLKForm *newForm;
+  NSMutableDictionary *macros;
+  id bindings;
+
+  macros = [NSMutableDictionary dictionary];
+  bindings = [_tail car];
+  while (bindings)
+    {
+      id macro;
+      macro = [_compiler compile:[MLKCons cons:_LAMBDA
+                                          with:[[bindings car] cdr]]
+                         inContext:_context];
+      [macros setObject:macro
+                 forKey:nullify ([[bindings car] car])];
+      bindings = [bindings cdr];
+    }
+
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:nil
+                                          functions:nil
+                                             goTags:nil
+                                             macros:macros
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self processDeclarations:[_tail cdr]]];
+  [self processDeclarationsAndBody:[_tail cdr]];
+  newForm = [MLKForm formWithObject:[MLKCons cons:LET
+                                             with:[MLKCons cons:nil
+                                                           with:[_tail cdr]]]
+                          inContext:newContext
+                        forCompiler:_compiler];
+  LDEALLOC (self);
+  return newForm;
+}
 @end
 
 
 @implementation MLKSimpleFletForm
+-(id) complete
+{
+  NSMutableArray *bindingForms;
+  MLKCons *bindings;
+  NSMutableSet *functions;
+  MLKLexicalContext *newContext;
+
+  self = [super complete];
+
+  bindingForms = [NSMutableArray array];
+  functions = [NSMutableSet set];
+  bindings = [_tail car];
+
+  while (bindings)
+    {
+      [bindingForms addObject:[MLKSimpleFunctionBindingForm formWithObject:[bindings car]
+                                                                 inContext:_context
+                                                               forCompiler:_compiler]];
+      [functions addObject:[[bindings car] car]];
+      bindings = [bindings cdr];
+    }
+
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:nil
+                                          functions:functions
+                                             goTags:nil
+                                             macros:nil
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self processDeclarations:[[_tail cdr] cdr]]];
+
+  LASSIGN (_functionBindingForms, bindingForms);
+  [self processBody:[_tail cdr]
+          inContext:newContext];
+  return self;
+}
 @end
 
 
 @implementation MLKLetForm
+-(id) complete
+{
+  MLKLexicalContext *newContext;
+
+  self = [super complete];
+  // FIXME
+  [self processBody:[_tail cdr]
+          inContext:newContext];
+  return self;
+}
+@end
+
+
+@implementation MLKLocallyForm
+-(id) complete
+{
+  MLKLexicalContext *newContext;
+
+  self = [super complete];
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:nil
+                                          functions:nil
+                                             goTags:nil
+                                             macros:nil
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self processDeclarations:[[_tail cdr] cdr]]];
+  
+  [self processRawBody:[_tail cdr]];
+  return self;
+}
 @end
 
 
 @implementation MLKSimpleLoopForm
+-(id) complete
+{
+  self = [super complete];
+  [self processRawBody:_tail];
+  return self;
+}
 @end
 
 
 @implementation MLKMultipleValueCallForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_functionForm, [_tail car]);
+  [self processRawBody:[_tail cdr]];
+  return self;
+}
 @end
 
 
 @implementation MLKProgNForm
+-(id) complete
+{
+  self = [super complete];
+  [self processRawBody:_tail];
+  return self;
+}
 @end
 
 
 @implementation MLKProgVForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_variableListForm, MAKE_FORM ([_tail car]));
+  LASSIGN (_valueListForm, MAKE_FORM ([[_tail cdr] car]));
+  [self processRawBody:[[_tail cdr] cdr]];
+  return self;
+}
 @end
 
 
 @implementation MLKQuoteForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_quotedData, [_tail car]);
+  return self;
+}
 @end
 
 
 @implementation MLKSetQForm
+-(id) complete
+{
+  id rest = _tail;
+  NSMutableArray *variables, *valueForms;
+
+  self = [super complete];
+
+  variables = [NSMutableArray array];
+  valueForms = [NSMutableArray array];
+  while (rest)
+    {
+      [variables addObject:[rest car]];
+      [valueForms addObject:MAKE_FORM([[rest cdr] car])];
+      rest = [[rest cdr] cdr];
+    }
+
+  LASSIGN (_variables, variables);
+  LASSIGN (_valueForms, valueForms);
+  return self;
+}
 @end
 
 
 @implementation MLKFSetQForm
+-(id) complete
+{
+  id rest = _tail;
+  NSMutableArray *functionNames, *valueForms;
+  
+  self = [super complete];
+  
+  functionNames = [NSMutableArray array];
+  valueForms = [NSMutableArray array];
+  while (rest)
+    {
+      [functionNames addObject:[rest car]];
+      [valueForms addObject:MAKE_FORM([[rest cdr] car])];
+      rest = [[rest cdr] cdr];
+    }
+  
+  LASSIGN (_functionNames, functionNames);
+  LASSIGN (_valueForms, valueForms);
+  return self;
+}
 @end
 
 
 @implementation MLKSetForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_variableForm, MAKE_FORM ([_tail car]));
+  LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
+  return self;
+}
 @end
 
 
 @implementation MLKFSetForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_functionNameForm, MAKE_FORM ([_tail car]));
+  LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
+  return self;
+}
 @end
 
 
 @implementation MLKThrowForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_tagForm, MAKE_FORM ([_tail car]));
+  LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car]));
+  return self;
+}
 @end
 
 
 @implementation MLKUnwindProtectForm
+-(id) complete
+{
+  self = [super complete];
+  LASSIGN (_protectedForm, MAKE_FORM ([_tail car]));
+  [self processRawBody:[_tail cdr]];
+  return self;
+}
+@end
+
+
+@implementation MLKSimpleFunctionBindingForm
++(id) formWithObject:(id)object
+           inContext:(MLKLexicalContext *)context
+         forCompiler:(id)compiler
+{
+  return [[self alloc] initWithObject:(id)object
+                            inContext:(MLKLexicalContext *)context
+                          forCompiler:(id)compiler];
+}
+
+-(id) complete
+{
+  MLKLexicalContext *newContext;
+
+  self = [super complete];
+
+  LASSIGN (_name, _head);
+  LASSIGN (_lambdaListName, [_tail car]);
+
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:[NSSet setWithObject:_lambdaListName]
+                                          functions:nil
+                                             goTags:nil
+                                             macros:nil
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self processDeclarations:[_tail cdr]]];
+
+  [self processBody:[_tail cdr]
+          inContext:newContext];
+  return self;
+}
 @end
diff --git a/MLKLLVMCompiler.h b/MLKLLVMCompiler.h
index 1e9bbf2..507c652 100644
--- a/MLKLLVMCompiler.h
+++ b/MLKLLVMCompiler.h
@@ -43,6 +43,8 @@ using namespace llvm;
 @end
 
 
+#ifdef __cplusplus
 @interface MLKForm (MLKLLVMCompilation)
 -(Value *) processForLLVMInBlock:(BasicBlock **)block;
 @end
+#endif