/* -*- mode: objc; coding: utf-8 -*- */
/* Toilet Lisp, a Common Lisp subset for the Étoilé runtime.
* Copyright (C) 2008 Matthias Andreas Benkard.
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or (at
* your option) any later version.
*
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#import "MLKCons.h"
#import "MLKForm.h"
#import "util.h"
#import "special-symbols.h"
#import
@implementation MLKForm
-(void) initialize
{
ensure_symbols ();
}
-(id) initWithObject:(id)object
inContext:(MLKLexicalContext *)context
forCompiler:(id)compiler
{
_form = object;
_context = context;
_compiler = compiler;
return [self complete];
}
-(id) complete
{
return self;
}
+(Class) dispatchClassForObject:(id)object
{
if ([object isKindOfClass:[MLKCons class]])
return [MLKCompoundForm class];
else
return [MLKAtomicForm class];
}
+(id) formWithObject:(id)object
inContext:(MLKLexicalContext *)context
forCompiler:(id)compiler
{
Class cls = [self dispatchClassForObject:object];
if (cls != self)
return [cls formWithObject:object
inContext:context
forCompiler:compiler];
else
return LAUTORELEASE ([[self alloc]
initWithObject:object
inContext:context
forCompiler:compiler]);
}
@end
@implementation MLKAtomicForm
+(Class) dispatchClassForObject:(id)object
{
if ([object isKindOfClass:[MLKSymbol class]])
return [MLKSymbolForm class];
else
return [MLKSelfEvaluatingForm class];
}
@end
@implementation MLKSelfEvaluatingForm
// FIXME
+(Class) dispatchClassForObject:(id)object
{
return self;
}
@end
@implementation MLKSymbolForm
// FIXME
+(Class) dispatchClassForObject:(id)object
{
return self;
}
@end
@implementation MLKCompoundForm
-(id) complete
{
self = [super complete];
_head = [_form car];
_tail = [_form cdr];
return self;
}
+(Class) dispatchClassForObject:(id)object
{
id car = [object car];
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];
else if (car == FUNCTION) return [MLKFunctionForm class];
else if (car == IF) return [MLKIfForm class];
else if (car == IN_PACKAGE) return [MLKInPackageForm class];
else if (car == _LAMBDA) return [MLKSimpleLambdaForm class];
else if (car == _MACROLET) return [MLKSimpleMacroletForm class];
else if (car == _FLET) return [MLKSimpleFletForm class];
else if (car == LET) return [MLKLetForm class];
else if (car == _LOOP) return [MLKSimpleLoopForm class];
else if (car == MULTIPLE_VALUE_CALL) return [MLKMultipleValueCallForm class];
else if (car == PROGN) return [MLKProgNForm class];
else if (car == PROGV) return [MLKProgVForm class];
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];
}
@end
@implementation MLKSimpleCompoundForm
-(id) initWithObject:(id)object
inContext:(MLKLexicalContext *)context
forCompiler:(id)compiler
{
self = [super initWithObject:object
inContext:context
forCompiler:compiler];
if ([_head isKindOfClass:[MLKCons class]])
{
LRELEASE (self);
return [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];
}
else
{
LRELEASE (self);
return [MLKFunctionCallForm formWithObject:object
inContext:context
forCompiler:compiler];
}
}
+(Class) dispatchClassForObject:(id)object
{
return self;
}
@end
@implementation MLKMacroCallForm
-(id) initWithObject:(id)object
inContext:(MLKLexicalContext *)context
forCompiler:(id)compiler
{
self = [super initWithObject:object
inContext:context
forCompiler:compiler];
id macrofun = [context macroForSymbol:_head];
id expansion = denullify ([[macrofun
applyToArray:
[NSArray arrayWithObjects:
_form, context, nil]]
objectAtIndex:0]);
return [MLKForm formWithObject:expansion
inContext:context
forCompiler:compiler];
}
@end
@implementation MLKBodyForm
@end
@implementation MLKDeclaringForm
@end
@implementation MLKDocstringForm
@end
@implementation MLKFunctionCallForm
// -(id ) functionInfo
// {
// return [_context functionInfoForSymbol:_head];
// }
@end
@implementation MLKCatchForm
@end
@implementation MLKSimpleDefmacroForm
@end
@implementation MLKEvalWhenForm
@end
@implementation MLKForeignLambdaForm
@end
@implementation MLKFunctionForm
+(Class) dispatchClassForObject:(id)object
{
id funname = [[object cdr] car];
if ([funname isKindOfClass:[MLKCons class]]
&& [funname car] == LAMBDA)
return [MLKLambdaFunctionForm class];
else
return [MLKSimpleFunctionForm class];
}
@end
@implementation MLKLambdaFunctionForm
@end
@implementation MLKSimpleFunctionForm
@end
@implementation MLKIfForm
@end
@implementation MLKInPackageForm
@end
@implementation MLKSimpleLambdaForm
@end
@implementation MLKSimpleMacroletForm
@end
@implementation MLKSimpleFletForm
@end
@implementation MLKLetForm
@end
@implementation MLKSimpleLoopForm
@end
@implementation MLKMultipleValueCallForm
@end
@implementation MLKProgNForm
@end
@implementation MLKProgVForm
@end
@implementation MLKQuoteForm
@end
@implementation MLKSetQForm
@end
@implementation MLKFSetQForm
@end
@implementation MLKSetForm
@end
@implementation MLKFSetForm
@end
@implementation MLKThrowForm
@end
@implementation MLKUnwindProtectForm
@end