MLKForm class cluster: Implement declaration and docstring handling.

7 files changed, 189 insertions, 41 deletions

diff --git a/MLKForm.h b/MLKForm.h
index 4dd9580..4fcccf9 100644
--- a/MLKForm.h
+++ b/MLKForm.h
@@ -90,6 +90,10 @@
   id _body;
   NSArray *_bodyForms;
 }
+
+-(void) splitDeclarationsAndBody:(id)object;
+-(void) processBody:(id)object inContext:(MLKLexicalContext *)context;
+-(void) processBody:(id)object;
 @end
 
 
@@ -98,6 +102,9 @@
   id _declarations;
   NSArray *_declarationForms;
 }
+
+-(void) splitDeclarationsAndBody:(id)object;
+-(id) declarationsWithForms:(id)object;
 @end
 
 
@@ -105,6 +112,8 @@
 {
   NSString *_documentation;
 }
+
+-(void) splitDeclarationsAndBody:(id)object;
 @end
 
 
@@ -215,7 +224,7 @@
 
 @interface MLKLetForm : MLKDeclaringForm
 {
-  NSArray *_bindingForms;
+  NSArray *_variableBindingForms;
 }
 @end
 
@@ -224,7 +233,7 @@
 @end
 
 
-@interface MLKSimpleLoopForm : MLKCompoundForm
+@interface MLKSimpleLoopForm : MLKBodyForm
 @end
 
 
@@ -307,7 +316,25 @@
   MLKSymbol *_lambdaListName;
 }
 
-+(id) formWithObject:(id)object
-           inContext:(MLKLexicalContext *)context
-         forCompiler:(id)compiler;
++(Class) dispatchClassForObject:(id)object;
+@end
+
+
+@interface MLKVariableBindingForm : MLKForm
+{
+  id _name;
+  MLKForm *_valueForm;
+}
+
++(Class) dispatchClassForObject:(id)object;
+@end
+
+
+@interface MLKDeclarationForm : MLKCompoundForm
+{
+  id _type;
+  NSArray *_arguments;
+}
+
++(Class) dispatchClassForObject:(id)object;
 @end
diff --git a/MLKForm.m b/MLKForm.m
index 0ced0ec..c453ada 100644
--- a/MLKForm.m
+++ b/MLKForm.m
@@ -219,23 +219,59 @@
 
 
 @implementation MLKBodyForm
+-(void) splitDeclarationsAndBody:(id)object
+{
+  _body = object;
+}
+
+-(void) processBody:(id)object inContext:(MLKLexicalContext *)context
+{
+  id rest;
+  NSMutableArray *bodyForms;
+
+  [self splitDeclarationsAndBody:object];
+  rest = _body;
+  while (rest)
+    {
+      [bodyForms addObject:[MLKForm formWithObject:[rest car]
+                                         inContext:context
+                                       forCompiler:_compiler]];
+      rest = [rest cdr];
+    }
+
+  LASSIGN (_bodyForms, bodyForms);
+}
+
+-(void) processBody:(id)object
+{
+  [self processBody:object inContext:_context];
+}
 @end
 
 
 @implementation MLKDeclaringForm
+-(void) splitDeclarationsAndBody:(id)object
+{
+  MLKSplitDeclarationsDocAndForms(&_declarations, nil, &_body, object, NO);
+}
+
+-(id) declarationsWithForms:(id)object
+{
+  [self splitDeclarationsAndBody:object];
+  return _declarations;
+}
 @end
 
 
 @implementation MLKDocstringForm
+-(void) splitDeclarationsAndBody:(id)object
+{
+  MLKSplitDeclarationsDocAndForms(&_declarations, &_documentation, &_body, object, YES);
+}
 @end
 
 
 @implementation MLKFunctionCallForm
-// -(id <MLKFuncallable>) functionInfo
-// {
-//   return [_context functionInfoForSymbol:_head];
-// }
-
 -(id) complete
 {
   self = [super complete];
@@ -272,7 +308,7 @@
                                              macros:nil
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[[_tail cdr] cdr]]];
+                                       declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
 
   [self processBody:[[_tail cdr] cdr]
           inContext:newContext];
@@ -297,7 +333,7 @@
       rest = [rest cdr];
     }
 
-  [self procesRawBody:[_tail cdr]];
+  [self processBody:[_tail cdr]];
   return self;
 }
 @end
@@ -414,7 +450,7 @@
                                              macros:nil
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[_tail cdr]]];
+                                       declarations:[self declarationsWithForms:[_tail cdr]]];
   
   [self processBody:[_tail cdr]
           inContext:newContext];
@@ -453,14 +489,14 @@
                                              macros:macros
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[_tail cdr]]];
-  [self processDeclarationsAndBody:[_tail cdr]];
+                                       declarations:[self declarationsWithForms:[_tail cdr]]];
+
   newForm = [MLKForm formWithObject:[MLKCons cons:LET
                                              with:[MLKCons cons:nil
                                                            with:[_tail cdr]]]
                           inContext:newContext
                         forCompiler:_compiler];
-  LDEALLOC (self);
+  LRELEASE (self);  //?FIXME
   return newForm;
 }
 @end
@@ -496,7 +532,7 @@
                                              macros:nil
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[[_tail cdr] cdr]]];
+                                       declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
 
   LASSIGN (_functionBindingForms, bindingForms);
   [self processBody:[_tail cdr]
@@ -509,10 +545,36 @@
 @implementation MLKLetForm
 -(id) complete
 {
+  NSMutableArray *bindingForms;
+  MLKCons *bindings;
+  NSMutableSet *variables;
   MLKLexicalContext *newContext;
-
+  
   self = [super complete];
-  // FIXME
+  
+  bindingForms = [NSMutableArray array];
+  variables = [NSMutableSet set];
+  bindings = [_tail car];
+  
+  while (bindings)
+    {
+      [bindingForms addObject:[MLKVariableBindingForm formWithObject:[bindings car]
+                                                           inContext:_context
+                                                         forCompiler:_compiler]];
+      [variables addObject:[[bindings car] car]];
+      bindings = [bindings cdr];
+    }
+  
+  newContext = [MLKLexicalContext contextWithParent:_context
+                                          variables:variables
+                                          functions:nil
+                                             goTags:nil
+                                             macros:nil
+                                     compilerMacros:nil
+                                       symbolMacros:nil
+                                       declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
+  
+  LASSIGN (_variableBindingForms, bindingForms);
   [self processBody:[_tail cdr]
           inContext:newContext];
   return self;
@@ -533,9 +595,9 @@
                                              macros:nil
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[[_tail cdr] cdr]]];
+                                       declarations:[self declarationsWithForms:[[_tail cdr] cdr]]];
   
-  [self processRawBody:[_tail cdr]];
+  [self processBody:[_tail cdr]];
   return self;
 }
 @end
@@ -545,7 +607,7 @@
 -(id) complete
 {
   self = [super complete];
-  [self processRawBody:_tail];
+  [self processBody:_tail];
   return self;
 }
 @end
@@ -556,7 +618,7 @@
 {
   self = [super complete];
   LASSIGN (_functionForm, [_tail car]);
-  [self processRawBody:[_tail cdr]];
+  [self processBody:[_tail cdr]];
   return self;
 }
 @end
@@ -566,7 +628,7 @@
 -(id) complete
 {
   self = [super complete];
-  [self processRawBody:_tail];
+  [self processBody:_tail];
   return self;
 }
 @end
@@ -578,7 +640,7 @@
   self = [super complete];
   LASSIGN (_variableListForm, MAKE_FORM ([_tail car]));
   LASSIGN (_valueListForm, MAKE_FORM ([[_tail cdr] car]));
-  [self processRawBody:[[_tail cdr] cdr]];
+  [self processBody:[[_tail cdr] cdr]];
   return self;
 }
 @end
@@ -680,20 +742,16 @@
 {
   self = [super complete];
   LASSIGN (_protectedForm, MAKE_FORM ([_tail car]));
-  [self processRawBody:[_tail cdr]];
+  [self processBody:[_tail cdr]];
   return self;
 }
 @end
 
 
 @implementation MLKSimpleFunctionBindingForm
-+(id) formWithObject:(id)object
-           inContext:(MLKLexicalContext *)context
-         forCompiler:(id)compiler
++(Class) dispatchClassForObject:(id)object
 {
-  return [[self alloc] initWithObject:(id)object
-                            inContext:(MLKLexicalContext *)context
-                          forCompiler:(id)compiler];
+  return self;
 }
 
 -(id) complete
@@ -712,10 +770,56 @@
                                              macros:nil
                                      compilerMacros:nil
                                        symbolMacros:nil
-                                       declarations:[self processDeclarations:[_tail cdr]]];
+                                       declarations:[self declarationsWithForms:[_tail cdr]]];
 
   [self processBody:[_tail cdr]
           inContext:newContext];
   return self;
 }
 @end
+
+
+@implementation MLKVariableBindingForm
++(Class) dispatchClassForObject:(id)object
+{
+  return self;
+}
+
+-(id) complete
+{
+  MLKLexicalContext *newContext;
+
+  self = [super complete];
+
+  if ([_form isKindOfClass:[MLKCons class]])
+    {
+      LASSIGN (_name, [_form car]);
+      LASSIGN (_valueForm, MAKE_FORM ([[_form cdr] car]));
+    }
+  else
+    {
+      LASSIGN (_name, _form);
+      LASSIGN (_valueForm, MAKE_FORM (nil));
+    }
+
+  return self;
+}
+@end
+
+
+@implementation MLKDeclarationForm : MLKCompoundForm
++(Class) dispatchClassForObject:(id)object
+{
+  return self;
+}
+
+-(id) complete
+{
+  self = [super complete];
+
+  LASSIGN (_type, [_form car]);
+  LASSIGN (_arguments, [_form cdr] ? [[_form cdr] array] : [NSArray array]);
+
+  return self;
+}
+@end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index d3d6161..42d22ed 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -554,7 +554,7 @@
               MLKLexicalContext *ctx;
 
               MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr]);
+                                               [[program cdr] cdr], NO);
               ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
                                    initWithParent:context
                                    variables:nil
@@ -616,7 +616,7 @@
               MLKLexicalEnvironment *env;
 
               MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr]);
+                                               [[program cdr] cdr], NO);
 
               ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
                                    initWithParent:context
@@ -693,7 +693,7 @@
               MLKDynamicContext *dynctx;
 
               MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body,
-                                               [[program cdr] cdr]);
+                                               [[program cdr] cdr], NO);
 
               ctx = LAUTORELEASE ([[MLKLexicalContext alloc]
                                    initWithParent:context
diff --git a/MLKPackage.m b/MLKPackage.m
index 8c90951..a05f822 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -153,6 +153,7 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"SYMBOL-NAME"]];
   [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:@"OBJC-CLASS-OF"]];
   [sys export:[sys intern:@"OBJC-SUBCLASSP"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index f295c77..940181c 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -677,7 +677,7 @@ as provided by method %@ of object %@",
   id decls, doc, forms;
   id bodyAndDecls = denullify ([args objectAtIndex:0]);
 
-  MLKSplitDeclarationsDocAndForms (&decls, &doc, &forms, bodyAndDecls);
+  MLKSplitDeclarationsDocAndForms (&decls, &doc, &forms, bodyAndDecls, YES);
 
   RETURN_VALUE ([MLKCons
                   cons:decls
@@ -687,4 +687,19 @@ as provided by method %@ of object %@",
                                 cons:forms
                                 with:nil]]]);
 }
+
+
++(NSArray *) declarations_and_forms:(NSArray *)args
+{
+  id decls, doc, forms;
+  id bodyAndDecls = denullify ([args objectAtIndex:0]);
+  
+  MLKSplitDeclarationsDocAndForms (&decls, &doc, &forms, bodyAndDecls, NO);
+  
+  RETURN_VALUE ([MLKCons
+                  cons:decls
+                  with:[MLKCons
+                         cons:forms
+                         with:nil]]);
+}
 @end
diff --git a/functions.h b/functions.h
index f322d7a..84085a9 100644
--- a/functions.h
+++ b/functions.h
@@ -46,7 +46,7 @@ id MLKSubtractFixnums (id x, id y);
 id MLKIDivideFixnums (id x, id y);
 id MLKMultiplyFixnums (id x, id y);
 
-void MLKSplitDeclarationsDocAndForms (id *decls, id *doc, id *forms, id body);
+void MLKSplitDeclarationsDocAndForms (id *decls, id *doc, id *forms, id body, BOOL docp);
 
 typedef enum MLKForeignType
 {
diff --git a/functions.m b/functions.m
index 8383e06..7caea41 100644
--- a/functions.m
+++ b/functions.m
@@ -184,18 +184,19 @@ static void init_symbols ()
 }
 
 
-void MLKSplitDeclarationsDocAndForms (id *decls, id *doc, id *forms, id body)
+void MLKSplitDeclarationsDocAndForms (id *decls, id *doc, id *forms, id body, BOOL docp)
 {
   id declarations;
 
   init_symbols ();
 
-  *doc = nil;
+  if (docp)
+    *doc = nil;
 
   declarations = nil;
   while (([[body car] isKindOfClass:[MLKCons class]]
           && [[body car] car] == DECLARE)
-         || [[body car] isKindOfClass:[NSString class]])
+         || (docp && [[body car] isKindOfClass:[NSString class]]))
     {
       id thing = [body car];