/* -*- 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
#import
#import
#import
#import
#import
#import
#import "MLKCompiledClosure.h"
#import "MLKCons.h"
#import "MLKEnvironment.h"
#import "MLKLexicalContext.h"
#import "MLKLexicalEnvironment.h"
#import "MLKPackage.h"
#import "MLKParenReader.h"
#import "MLKReadtable.h"
#import "MLKSymbol.h"
#import "MLKInteger.h"
#import "MLKValuesFunction.h"
#import "runtime-compatibility.h"
#import "util.h"
#define MAKE_ENVIRONMENT(variable, parent, parent_member) \
[[MLKEnvironment alloc] \
initWithParent:(parent \
? (id) parent_member \
: nil) \
values:variable]
static MLKLexicalEnvironment *global_environment;
@implementation MLKLexicalEnvironment
+(void) initialize
{
NSMutableDictionary *vars = [NSMutableDictionary dictionary];
NSMutableDictionary *funs = [NSMutableDictionary dictionary];
MLKPackage *cl = [MLKPackage findPackage:@"COMMON-LISP"];
// MLKPackage *sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
[vars setObject:[NSNull null] forKey:[NSNull null]];
[vars setObject:[cl intern:@"T"] forKey:[cl intern:@"T"]];
[funs setObject:LAUTORELEASE ([[MLKValuesFunction alloc] init])
forKey:[cl intern:@"VALUES"]];
global_environment = [[self alloc] initWithParent:nil
variables:vars
functions:funs];
}
-(MLKLexicalEnvironment *) initWithParent:(MLKLexicalEnvironment *)aContext
variables:(NSDictionary *)vars
functions:(NSDictionary *)functions
{
self = [super init];
LASSIGN (_parent, (aContext ? aContext : global_environment));
_variables = MAKE_ENVIRONMENT(vars, _parent, _parent->_variables);
_functions = MAKE_ENVIRONMENT(functions, _parent, _parent->_functions);
return self;
}
+(MLKLexicalEnvironment *) environmentWithParent:(MLKLexicalEnvironment *)context
variables:(NSDictionary *)vars
functions:(NSDictionary *)functions
{
return LAUTORELEASE ([[self alloc] initWithParent:context
variables:vars
functions:functions]);
}
+(MLKLexicalEnvironment *) globalEnvironment
{
return global_environment;
}
-(NSSet *) variables
{
return [_variables bindings];
}
-(NSSet *) functions
{
return [_functions bindings];
}
-(id) valueForSymbol:(MLKSymbol *)symbol
{
if (![_variables environmentForSymbol:symbol]
|| [_variables environmentForSymbol:symbol] == global_environment->_variables)
{
id cell = [[MLKLexicalContext globalContext] bindingForSymbol:symbol];
return [cell value];
}
else
{
return [_variables valueForSymbol:symbol];
}
}
-(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol
{
if (![_variables environmentForSymbol:symbol]
|| [_variables environmentForSymbol:symbol] == global_environment->_variables)
{
id cell = [[MLKLexicalContext globalContext] bindingForSymbol:symbol];
[cell setValue:value];
}
else
{
[_variables setValue:value forSymbol:symbol];
}
}
-(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
{
if (self == global_environment)
{
id cell = [[MLKLexicalContext globalContext] bindingForSymbol:symbol];
[cell setValue:value];
}
else
{
[_variables addValue:value forSymbol:symbol];
}
}
-(void) addBindingForSymbol:(MLKSymbol *)symbol
{
[_variables addBindingForSymbol:symbol];
}
-(BOOL) boundp:(MLKSymbol *)symbol
{
return [_variables boundp:symbol];
}
-(void) makunbound:(MLKSymbol *)symbol
{
[_variables makunbound:symbol];
}
-(id) functionForSymbol:(MLKSymbol *)symbol
{
return [_functions valueForSymbol:symbol];
}
-(void) setFunction:(id)value forSymbol:(MLKSymbol *)symbol
{
[_functions setValue:value forSymbol:symbol];
if ([_functions environmentForSymbol:symbol] == global_environment->_functions)
{
// If we're changing the global environment, we need to
// interoperate with compiled code. In this case, be sure to set
// the global function cell.
//
// Note that this reserves memory for the function cell that is
// never freed, which is why we do it for global function bindings
// only!
id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
functionCellForSymbol:symbol];
void **closure_data_cell = [[MLKLexicalContext globalContext]
closureDataPointerForSymbol:symbol];
if ([value isKindOfClass:[MLKCompiledClosure class]])
{
*cell = (id (*)(void *, ...))[value code];
*closure_data_cell = [value closureData];
}
else
{
*cell = MLKInterpretedFunctionTrampoline;
*closure_data_cell = value;
}
}
}
-(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol
{
[_functions addValue:value forSymbol:symbol];
if (self == global_environment)
{
// If we're changing the global environment, we need to
// interoperate with compiled code. In this case, be sure to set
// the global function cell.
//
// Note that this reserves memory for the function cell that is
// never freed, which is why we do it for global function bindings
// only!
id (**cell)(void *, ...) = [[MLKLexicalContext globalContext]
functionCellForSymbol:symbol];
void **closure_data_cell = [[MLKLexicalContext globalContext]
closureDataPointerForSymbol:symbol];
if ([value isKindOfClass:[MLKCompiledClosure class]])
{
*cell = (id (*)(void *, ...))[value code];
*closure_data_cell = [value closureData];
}
else
{
*cell = MLKInterpretedFunctionTrampoline;
*closure_data_cell = value;
}
}
}
-(BOOL) fboundp:(MLKSymbol *)symbol
{
return [_functions boundp:symbol];
}
-(void) fmakunbound:(MLKSymbol *)symbol
{
[_functions makunbound:symbol];
}
-(void) dealloc
{
LRELEASE (_variables);
LRELEASE (_functions);
LRELEASE (_parent);
[super dealloc];
}
@end