summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-07-31 15:47:52 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-07-31 15:47:52 +0200
commitd4cea2c3033b37445a53730dc82630e14d443e0c (patch)
treec29c9eb6f5a7a0bf5fe0c3d71c12d746e6b880a7
parent44694422755e946fd07ea2228259bbeebdb3302b (diff)
Add %FLET and FLET.
-rw-r--r--MLKInterpreter.m88
-rw-r--r--MLKPackage.m1
2 files changed, 89 insertions, 0 deletions
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 74a2fe1..5e11637 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -50,6 +50,7 @@ static MLKSymbol *TAGBODY;
static MLKSymbol *GO;
static MLKSymbol *CATCH;
static MLKSymbol *THROW;
+static MLKSymbol *_FLET;
static MLKSymbol *_MACROLET;
static MLKSymbol *LAMBDA;
static MLKSymbol *LET;
@@ -86,6 +87,7 @@ static MLKSymbol *_LOOP;
THROW = [cl intern:@"THROW"];
LAMBDA = [cl intern:@"LAMBDA"];
LET = [cl intern:@"LET"];
+ _FLET = [sys intern:@"%FLET"];
_MACROLET = [sys intern:@"%MACROLET"];
_LOOP = [sys intern:@"%LOOP"];
APPLY = [cl intern:@"APPLY"];
@@ -512,6 +514,92 @@ static MLKSymbol *_LOOP;
return result;
}
}
+ else if (car == _FLET)
+ {
+ id declarations;
+ id clauses;
+ NSMutableArray *new_clauses;
+ id body;
+ NSArray *result;
+ MLKLexicalContext *ctx;
+ MLKLexicalEnvironment *env;
+
+ body = [[program cdr] cdr];
+
+ if ([[body car] isKindOfClass:[MLKCons class]]
+ && [[body car] car] == DECLARE)
+ {
+ declarations = [[body car] cdr];
+ body = [body cdr];
+ }
+ else
+ {
+ declarations = nil;
+ }
+
+ ctx = AUTORELEASE ([[MLKLexicalContext alloc]
+ initWithParent:context
+ variables:nil
+ functions:nil
+ goTags:nil
+ macros:nil
+ compilerMacros:nil
+ symbolMacros:nil
+ declarations:declarations]);
+
+ if (!expandOnly)
+ env = AUTORELEASE ([[MLKLexicalEnvironment alloc]
+ initWithParent:lexenv
+ variables:nil
+ functions:nil]);
+
+ clauses = [[program cdr] car];
+ new_clauses = [NSMutableArray array];
+ while (clauses)
+ {
+ id clause = [clauses car];
+ id name, value;
+
+ name = [clause car];
+
+ value = denullify([[self eval:[MLKCons cons:_LAMBDA
+ with:[clause cdr]]
+ inLexicalContext:context
+ withEnvironment:lexenv
+ expandOnly:expandOnly]
+ objectAtIndex:0]);
+
+ [ctx addFunction:name];
+
+ if (!expandOnly)
+ [env addFunction:value forSymbol:name];
+ else
+ [new_clauses addObject:[MLKCons cons:name with:[value cdr]]];
+
+ clauses = [clauses cdr];
+ }
+
+ result = [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:ctx
+ withEnvironment:env
+ expandOnly:expandOnly];
+
+ if (expandOnly)
+ {
+ RETURN_VALUE ([MLKCons
+ cons:_FLET
+ with:[MLKCons
+ cons:[MLKCons listWithArray:new_clauses]
+ with:[MLKCons
+ cons:[MLKCons cons:DECLARE
+ with:declarations]
+ with:[[result objectAtIndex:0] cdr]]]]);
+ }
+ else
+ {
+ return result;
+ }
+ }
else if (car == LET)
{
id declarations;
diff --git a/MLKPackage.m b/MLKPackage.m
index d3cadd7..ae839d4 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -92,6 +92,7 @@ static NSMutableDictionary *packages = nil;
[sys export:[sys intern:@"%LAMBDA"]];
[sys export:[sys intern:@"%FSET"]];
[sys export:[sys intern:@"%LOOP"]];
+ [sys export:[sys intern:@"%FLET"]];
[sys export:[sys intern:@"%MACROLET"]];
[sys export:[sys intern:@"CAR"]];