summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MLKCons.h1
-rw-r--r--MLKCons.m8
-rw-r--r--MLKForm.h26
-rw-r--r--MLKForm.m387
-rw-r--r--MLKLLVMCompiler.h2
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