diff options
| -rw-r--r-- | MLKCons.h | 1 | ||||
| -rw-r--r-- | MLKCons.m | 8 | ||||
| -rw-r--r-- | MLKForm.h | 26 | ||||
| -rw-r--r-- | MLKForm.m | 387 | ||||
| -rw-r--r-- | MLKLLVMCompiler.h | 2 |
5 files changed, 419 insertions, 5 deletions
@@ -42,6 +42,7 @@ -(void) appendObject:(id)object; -(MLKCons *) listByAppendingObject:(id)object; -(MLKCons *) copyList; +-(int) length; -(NSString *) bareDescriptionForLisp; // description without // parentheses, for internal use @@ -133,6 +133,14 @@ return [self listByAppendingObject:nil]; } +-(int) length +{ + if (_cdr) + return 1 + [_cdr length]; + else + return 1; +} + -(NSString *) bareDescriptionForLisp { if (!_cdr) @@ -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 @@ -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 |