From 22dc528bcebd30bd8a274fca0d7d728e917c7ec2 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 11:38:09 +0200 Subject: MLKForm class cluster: Add a couple of accessors to forms that are only processed indirectly. --- MLKForm.m | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index a5bebe5..b7be502 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -246,6 +246,7 @@ rest = [rest cdr]; } + LASSIGN (_bodyContext, context); LASSIGN (_bodyForms, bodyForms); } @@ -883,6 +884,21 @@ inContext:newContext]; return self; } + +-(id) name +{ + return _name; +} + +-(id) lambdaListName +{ + return _lambdaListName; +} + +-(id) bodyForms +{ + return _bodyForms; +} @end @@ -914,6 +930,16 @@ { return [[super subforms] arrayByAddingObject:_valueForm]; } + +-(id) name +{ + return _name; +} + +-(id) valueForm +{ + return _valueForm; +} @end -- cgit v1.2.3 From 99519955fca324cf190116f7fbae5eecbf493077 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 13:08:45 +0200 Subject: MLKForm class cluster: Fix handling of fixnums. --- MLKForm.m | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index b7be502..acf204e 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -56,7 +56,7 @@ +(Class) dispatchClassForObject:(id)object { - if ([object isKindOfClass:[MLKCons class]]) + if (MLKInstanceP (object) && [object isKindOfClass:[MLKCons class]]) return [MLKCompoundForm class]; else return [MLKAtomicForm class]; @@ -89,7 +89,7 @@ @implementation MLKAtomicForm +(Class) dispatchClassForObject:(id)object { - if ([object isKindOfClass:[MLKSymbol class]]) + if (MLKInstanceP (object) && [object isKindOfClass:[MLKSymbol class]]) return [MLKSymbolForm class]; else return [MLKSelfEvaluatingForm class]; -- cgit v1.2.3 From 975487368a75e6762fa4a7a2721595ba253bd420 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 19:52:16 +0200 Subject: MLKForm class cluster: Fix SETQ and FSETQ (statement order in -complete method). --- MLKForm.m | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index acf204e..955aa63 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -734,16 +734,17 @@ @implementation MLKSetQForm -(id) complete { - id rest = _tail; + id rest; NSMutableArray *variables, *valueForms; self = [super complete]; + rest = _tail; variables = [NSMutableArray array]; valueForms = [NSMutableArray array]; while (rest) { - [variables addObject:[rest car]]; + [variables addObject:nullify([rest car])]; [valueForms addObject:MAKE_FORM([[rest cdr] car])]; rest = [[rest cdr] cdr]; } @@ -763,16 +764,17 @@ @implementation MLKFSetQForm -(id) complete { - id rest = _tail; + id rest; NSMutableArray *functionNames, *valueForms; self = [super complete]; + rest = _tail; functionNames = [NSMutableArray array]; valueForms = [NSMutableArray array]; while (rest) { - [functionNames addObject:[rest car]]; + [functionNames addObject:nullify([rest car])]; [valueForms addObject:MAKE_FORM([[rest cdr] car])]; rest = [[rest cdr] cdr]; } -- cgit v1.2.3 From 96870ab2cd94ba6e36585837b69048c544e6d6b6 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 22:04:27 +0200 Subject: Promote special operators SET and %FSET to intrinsics. --- MLKForm.m | 36 ------------------------------------ 1 file changed, 36 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index 955aa63..19e04ac 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -148,8 +148,6 @@ else if (car == QUOTE) return [MLKQuoteForm class]; else if (car == SETQ) return [MLKSetQForm class]; else if (car == _FSETQ) return [MLKFSetQForm class]; - else if (car == SET) return [MLKSetForm class]; - else if (car == _FSET) return [MLKFSetForm class]; else if (car == THROW) return [MLKThrowForm class]; else if (car == UNWIND_PROTECT) return [MLKUnwindProtectForm class]; else return [MLKSimpleCompoundForm class]; @@ -791,40 +789,6 @@ @end -@implementation MLKSetForm --(id) complete -{ - self = [super complete]; - LASSIGN (_variableForm, MAKE_FORM ([_tail car])); - LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car])); - return self; -} - --(NSArray *) subforms -{ - return [[[super subforms] arrayByAddingObject:_variableForm] - arrayByAddingObject:_valueForm]; -} -@end - - -@implementation MLKFSetForm --(id) complete -{ - self = [super complete]; - LASSIGN (_functionNameForm, MAKE_FORM ([_tail car])); - LASSIGN (_valueForm, MAKE_FORM ([[_tail cdr] car])); - return self; -} - --(NSArray *) subforms -{ - return [[[super subforms] arrayByAddingObject:_functionNameForm] - arrayByAddingObject:_valueForm]; -} -@end - - @implementation MLKThrowForm -(id) complete { -- cgit v1.2.3 From d86ccf58d5b462100d1f4ec5d016024543ec7f53 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 17 Aug 2008 22:43:25 +0200 Subject: Replace special operator %DEFMACRO with intrinsic function %MACROSET. --- MLKForm.m | 26 -------------------------- 1 file changed, 26 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index 19e04ac..b255cc9 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -130,7 +130,6 @@ if (car == APPLY) return [MLKFunctionCallForm class]; else if (car == CATCH) return [MLKCatchForm class]; - else if (car == _DEFMACRO) return [MLKSimpleDefmacroForm class]; else if (car == EVAL) return [MLKFunctionCallForm class]; else if (car == EVAL_WHEN) return [MLKEvalWhenForm class]; else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class]; @@ -332,31 +331,6 @@ @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 declarationsWithForms:[[_tail cdr] cdr]]]; - - [self processBody:[[_tail cdr] cdr] - inContext:newContext]; - return self; -} -@end - - @implementation MLKEvalWhenForm -(id) complete { -- cgit v1.2.3 From e7212b465a8d40ae4e5bff112887e3e8c210019f Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 18 Aug 2008 00:51:27 +0200 Subject: MLKForm class cluster: Fix various memory management errors. --- MLKForm.m | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index b255cc9..d8f72bc 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -43,9 +43,10 @@ inContext:(MLKLexicalContext *)context forCompiler:(id)compiler { - _form = object; - _context = context; - _compiler = compiler; + self = [super init]; + LASSIGN (_form, object); + LASSIGN (_context, context); + LASSIGN (_compiler, compiler); return [self complete]; } @@ -170,24 +171,24 @@ else if ([_head isKindOfClass:[MLKCons class]]) { LRELEASE (self); - return [MLKForm formWithObject:[MLKCons cons:FUNCALL - with:object] - inContext:context - forCompiler:compiler]; + return LRETAIN ([MLKForm formWithObject:[MLKCons cons:FUNCALL + with:object] + inContext:context + forCompiler:compiler]); } else if ([context symbolNamesMacro:_head]) { LRELEASE (self); - return [MLKMacroCallForm formWithObject:object - inContext:context - forCompiler:compiler]; + return LRETAIN ([MLKMacroCallForm formWithObject:object + inContext:context + forCompiler:compiler]); } else { LRELEASE (self); - return [MLKFunctionCallForm formWithObject:object - inContext:context - forCompiler:compiler]; + return LRETAIN ([MLKFunctionCallForm formWithObject:object + inContext:context + forCompiler:compiler]); } } @@ -215,9 +216,9 @@ _form, context, nil]] objectAtIndex:0]); - return [MLKForm formWithObject:expansion - inContext:context - forCompiler:compiler]; + return LRETAIN ([MLKForm formWithObject:expansion + inContext:context + forCompiler:compiler]); } @end @@ -225,7 +226,7 @@ @implementation MLKBodyForm -(void) splitDeclarationsAndBody:(id)object { - _body = object; + LASSIGN (_body, object); } -(void) processBody:(id)object inContext:(MLKLexicalContext *)context @@ -523,7 +524,7 @@ inContext:newContext forCompiler:_compiler]; LRELEASE (self); //?FIXME - return newForm; + return LRETAIN (newForm); } @end -- cgit v1.2.3 From bdfe4801295945b92f84b8c03cb2e0be485ae4f0 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 18 Aug 2008 01:19:06 +0200 Subject: Promote special operator APPLY to an intrinsic function. --- MLKForm.m | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index d8f72bc..ee5139f 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -129,8 +129,7 @@ { id car = [object car]; - if (car == APPLY) return [MLKFunctionCallForm class]; - else if (car == CATCH) return [MLKCatchForm class]; + if (car == CATCH) return [MLKCatchForm class]; else if (car == EVAL) return [MLKFunctionCallForm class]; else if (car == EVAL_WHEN) return [MLKEvalWhenForm class]; else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class]; -- cgit v1.2.3 From 1e2602cbd46ab6587aa80f82661e6145e018d05f Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Mon, 18 Aug 2008 14:05:58 +0200 Subject: Add a couple of disabled debugging messages. --- MLKForm.m | 1 + 1 file changed, 1 insertion(+) (limited to 'MLKForm.m') diff --git a/MLKForm.m b/MLKForm.m index ee5139f..c8a5416 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -209,6 +209,7 @@ forCompiler:compiler]; id macrofun = [context macroForSymbol:_head]; + //NSLog (@"Expanding: %@", MLKPrintToString (_form)); id expansion = denullify ([[macrofun applyToArray: [NSArray arrayWithObjects: -- cgit v1.2.3