summaryrefslogtreecommitdiff
path: root/MLKInterpreter.m
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-07-31 16:00:47 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-07-31 16:00:47 +0200
commit64988d63eb7ff9f324395a03fc6a927b2639bb5e (patch)
tree715a4ce2916f06246b28e57a4c0e89cfc7db84eb /MLKInterpreter.m
parent9a500734046ab8bac571867678d4848e6eeecf5c (diff)
Minimal compiler: In a LET, do not forget to macroexpand the variable clauses.
Diffstat (limited to 'MLKInterpreter.m')
-rw-r--r--MLKInterpreter.m111
1 files changed, 64 insertions, 47 deletions
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 5e11637..343246c 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -606,6 +606,7 @@ static MLKSymbol *_LOOP;
id clauses;
id body;
NSArray *result;
+ NSMutableArray *new_clauses;
MLKLexicalContext *ctx;
MLKLexicalEnvironment *env;
MLKDynamicContext *dynctx;
@@ -622,29 +623,6 @@ static MLKSymbol *_LOOP;
declarations = nil;
}
- if (expandOnly)
- {
- id body_expansion = denullify([[self eval:[MLKCons cons:PROGN
- with:body]
- inLexicalContext:context
- withEnvironment:lexenv
- expandOnly:expandOnly]
- objectAtIndex:0]);
- RETURN_VALUE ([MLKCons
- cons:LET
- with:[MLKCons
- cons:[[program cdr] car]
- with:[MLKCons
- cons:declarations
- with:[MLKCons cons:body_expansion
- with:nil]]]]);
- }
-
- env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
- initWithParent:lexenv
- variables:nil
- functions:nil]);
-
ctx = AUTORELEASE ([[MLKLexicalContext alloc]
initWithParent:context
variables:nil
@@ -655,15 +633,24 @@ static MLKSymbol *_LOOP;
symbolMacros:nil
declarations:declarations]);
- dynctx = [[MLKDynamicContext alloc]
- initWithParent:dynamicContext
- variables:nil
- handlers:nil
- restarts:nil
- catchTags:nil
- activeHandlerEnvironment:nil];
+ if (!expandOnly)
+ {
+ env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
+ initWithParent:lexenv
+ variables:nil
+ functions:nil]);
+
+ dynctx = [[MLKDynamicContext alloc]
+ initWithParent:dynamicContext
+ variables:nil
+ handlers:nil
+ restarts:nil
+ catchTags:nil
+ activeHandlerEnvironment:nil];
+ }
clauses = [[program cdr] car];
+ new_clauses = [NSMutableArray array];
while (clauses)
{
id clause = [clauses car];
@@ -684,42 +671,72 @@ static MLKSymbol *_LOOP;
variable = [clause car];
value = denullify([[self eval:[[clause cdr] car]
inLexicalContext:context
- withEnvironment:lexenv]
+ withEnvironment:lexenv
+ expandOnly:expandOnly]
objectAtIndex:0]);
}
- [ctx addVariable:variable];
- if ([ctx variableIsLexical:variable])
+ if (expandOnly)
{
- [env addValue:value forSymbol:variable];
+ [new_clauses addObject:[MLKCons cons:variable
+ with:[MLKCons cons:value
+ with:nil]]];
}
else
{
- [dynctx addValue:value forSymbol:variable];
+ [ctx addVariable:variable];
+ if ([ctx variableIsLexical:variable])
+ {
+ [env addValue:value forSymbol:variable];
+ }
+ else
+ {
+ [dynctx addValue:value forSymbol:variable];
+ }
}
clauses = [clauses cdr];
}
- [dynctx pushContext];
-
- NS_DURING
+ if (expandOnly)
{
result = [self eval:[MLKCons cons:PROGN with:body]
inLexicalContext:ctx
- withEnvironment:env];
+ withEnvironment:env
+ expandOnly:YES];
+
+ RETURN_VALUE ([MLKCons
+ cons:LET
+ with:[MLKCons
+ cons:[MLKCons listWithArray:new_clauses]
+ with:[MLKCons
+ cons:[MLKCons cons:DECLARE
+ with:declarations]
+ with:[[result objectAtIndex:0] cdr]]]]);
}
- NS_HANDLER
+ else
{
- [MLKDynamicContext popContext];
- [localException raise];
- }
- NS_ENDHANDLER;
+ [dynctx pushContext];
- [MLKDynamicContext popContext];
- RELEASE (dynctx);
+ NS_DURING
+ {
+ result = [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:ctx
+ withEnvironment:env
+ expandOnly:NO];
+ }
+ NS_HANDLER
+ {
+ [MLKDynamicContext popContext];
+ [localException raise];
+ }
+ NS_ENDHANDLER;
+
+ [MLKDynamicContext popContext];
+ RELEASE (dynctx);
- return result;
+ return result;
+ }
}
else if (car == _LOOP)
{