From 065ea00d5c861411b5aaa41f29bd69a9f30e3ef3 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Mon, 11 Aug 2008 01:00:09 +0200 Subject: Implement most of the MLKForm class cluster. --- MLKForm.m | 387 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 387 insertions(+) (limited to 'MLKForm.m') 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 +#import #import +#include + +#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 -- cgit v1.2.3