diff options
| -rw-r--r-- | MLKForm.h | 37 | ||||
| -rw-r--r-- | MLKForm.m | 160 | ||||
| -rw-r--r-- | MLKInterpreter.m | 6 | ||||
| -rw-r--r-- | MLKPackage.m | 1 | ||||
| -rw-r--r-- | MLKRoot.m | 17 | ||||
| -rw-r--r-- | functions.h | 2 | ||||
| -rw-r--r-- | functions.m | 7 |
7 files changed, 189 insertions, 41 deletions
@@ -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 @@ -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"]]; @@ -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]; |