summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MLKInterpreter.h19
-rw-r--r--MLKInterpreter.m131
2 files changed, 142 insertions, 8 deletions
diff --git a/MLKInterpreter.h b/MLKInterpreter.h
index 8ff119f..6abf52b 100644
--- a/MLKInterpreter.h
+++ b/MLKInterpreter.h
@@ -24,6 +24,18 @@
#import <Foundation/NSObject.h>
+enum MLKProcessingMode
+{
+ // Compiler
+ compile_time_too_mode,
+ not_compile_time_mode,
+ expand_mode,
+
+ // Evaluator
+ eval_mode
+};
+
+
@interface MLKInterpreter : NSObject
+(void) initialize;
@@ -35,6 +47,11 @@
inLexicalContext:(MLKLexicalContext *)context
withEnvironment:(MLKLexicalEnvironment *)lexenv
expandOnly:(BOOL)expandOnly;
-
+
++(NSArray*) eval:(id)program
+ inLexicalContext:(MLKLexicalContext *)context
+ withEnvironment:(MLKLexicalEnvironment *)lexenv
+ mode:(enum MLKProcessingMode)mode;
+
+(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print;
@end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 303b366..188b583 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -42,6 +42,7 @@
static MLKPackage *cl;
static MLKPackage *sys;
+static MLKPackage *keyword;
static MLKSymbol *IF;
static MLKSymbol *IN_PACKAGE;
static MLKSymbol *DECLARE;
@@ -54,16 +55,19 @@ static MLKSymbol *_FLET;
static MLKSymbol *_MACROLET;
static MLKSymbol *LAMBDA;
static MLKSymbol *LET;
+static MLKSymbol *LOCALLY;
static MLKSymbol *APPLY;
static MLKSymbol *FUNCALL;
static MLKSymbol *FUNCTION;
static MLKSymbol *EVAL;
+static MLKSymbol *EVAL_WHEN;
static MLKSymbol *QUOTE;
static MLKSymbol *SETQ;
static MLKSymbol *SETF;
static MLKSymbol *SET;
static MLKSymbol *_FSETQ;
static MLKSymbol *_FSET;
+static MLKSymbol *SYMBOL_MACROLET;
static MLKSymbol *PROGV;
static MLKSymbol *UNWIND_PROTECT;
static MLKSymbol *VALUES;
@@ -71,6 +75,11 @@ static MLKSymbol *_DEFMACRO;
static MLKSymbol *_LAMBDA;
static MLKSymbol *_LOOP;
static MLKSymbol *V_INITP;
+static MLKSymbol *COMPILE_TOPLEVEL;
+static MLKSymbol *COMPILE;
+static MLKSymbol *LOAD_TOPLEVEL;
+static MLKSymbol *LOAD;
+static MLKSymbol *EXECUTE;
@implementation MLKInterpreter
@@ -78,6 +87,7 @@ static MLKSymbol *V_INITP;
{
cl = [MLKPackage findPackage:@"COMMON-LISP"];
sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+ keyword = [MLKPackage findPackage:@"KEYWORD"];
IF = [cl intern:@"IF"];
IN_PACKAGE = [cl intern:@"IN-PACKAGE"];
@@ -89,11 +99,13 @@ static MLKSymbol *V_INITP;
THROW = [cl intern:@"THROW"];
LAMBDA = [cl intern:@"LAMBDA"];
LET = [cl intern:@"LET"];
+ LOCALLY = [cl intern:@"LOCALLY"];
_FLET = [sys intern:@"%FLET"];
_MACROLET = [sys intern:@"%MACROLET"];
_LOOP = [sys intern:@"%LOOP"];
APPLY = [cl intern:@"APPLY"];
EVAL = [cl intern:@"EVAL"];
+ EVAL_WHEN = [cl intern:@"EVAL-WHEN"];
FUNCALL = [cl intern:@"FUNCALL"];
FUNCTION = [cl intern:@"FUNCTION"];
QUOTE = [cl intern:@"QUOTE"];
@@ -102,12 +114,19 @@ static MLKSymbol *V_INITP;
SET = [cl intern:@"SET"];
_FSETQ = [sys intern:@"%FSETQ"];
_FSET = [sys intern:@"%FSET"];
+ SYMBOL_MACROLET = [cl intern:@"SYMBOL-MACROLET"];
PROGV = [cl intern:@"PROGV"];
VALUES = [cl intern:@"VALUES"];
UNWIND_PROTECT = [cl intern:@"UNWIND-PROTECT"];
_DEFMACRO = [sys intern:@"%DEFMACRO"];
_LAMBDA = [sys intern:@"%LAMBDA"];
V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
+
+ COMPILE_TOPLEVEL = [keyword intern:@"COMPILE-TOPLEVEL"];
+ COMPILE = [cl intern:@"COMPILE"];
+ LOAD_TOPLEVEL = [keyword intern:@"LOAD-TOPLEVEL"];
+ LOAD = [cl intern:@"LOAD"];
+ EXECUTE = [keyword intern:@"EXECUTE"];
}
@@ -122,6 +141,18 @@ static MLKSymbol *V_INITP;
}
++(NSArray*) eval:(id)program
+ inLexicalContext:(MLKLexicalContext *)context
+ withEnvironment:(MLKLexicalEnvironment *)lexenv
+ expandOnly:(BOOL)expandOnly
+{
+ return [self eval:program
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:(expandOnly ? expand_mode : eval_mode)];
+}
+
+
#define RETURN_VALUE(thing) \
{ return [NSArray arrayWithObject:nullify(thing)]; }
@@ -129,13 +160,15 @@ static MLKSymbol *V_INITP;
+(NSArray*) eval:(id)program
inLexicalContext:(MLKLexicalContext *)context
withEnvironment:(MLKLexicalEnvironment *)lexenv
- expandOnly:(BOOL)expandOnly
+ mode:(enum MLKProcessingMode)mode
{
MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
- BOOL trace = NO;
+ BOOL expandOnly = (mode != eval_mode);
#define TRACE_EVAL 0
#if TRACE_EVAL
+ BOOL trace = NO;
+
if ([dynamicContext valueForSymbol:V_INITP])
trace = YES;
@@ -145,6 +178,17 @@ static MLKSymbol *V_INITP;
if (!program || [program isKindOfClass:[MLKSymbol class]])
{
+ if (mode == compile_time_too_mode)
+ {
+ if (![context symbolNamesSymbolMacro:program])
+ {
+ return [self eval:program
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:expand_mode];
+ }
+ }
+
//NSLog (@"Processing symbol.");
if ([context symbolNamesSymbolMacro:program])
{
@@ -158,7 +202,7 @@ static MLKSymbol *V_INITP;
return [self eval:expansion
inLexicalContext:context
withEnvironment:lexenv
- expandOnly:expandOnly];
+ mode:mode];
}
else if ([context variableIsLexical:program])
{
@@ -192,6 +236,19 @@ static MLKSymbol *V_INITP;
if ([car isKindOfClass:[MLKSymbol class]] || !car)
{
+ if (mode == compile_time_too_mode)
+ {
+ if (!([context symbolNamesMacro:program]
+ || car == _MACROLET || car == LOCALLY
+ || car == SYMBOL_MACROLET || car == PROGN))
+ {
+ return [self eval:program
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:expand_mode];
+ }
+ }
+
if (car == APPLY)
{
MLKCons *rest = denullify([[self eval:[[[program cdr] cdr] car]
@@ -345,6 +402,66 @@ static MLKSymbol *V_INITP;
withEnvironment:[MLKLexicalEnvironment
globalEnvironment]];
}
+ else if (car == EVAL_WHEN)
+ {
+ id situationList = [[program cdr] car];
+ id body = [[program cdr] cdr];
+ NSArray *situations;
+ BOOL ct, lt, e;
+
+ if (!situationList)
+ RETURN_VALUE (nil);
+
+ situations = [situationList array];
+ ct = ([situations containsObject:COMPILE_TOPLEVEL]
+ || [situations containsObject:COMPILE]);
+ lt = ([situations containsObject:LOAD_TOPLEVEL]
+ || [situations containsObject:LOAD]);
+ e = ([situations containsObject:EXECUTE]
+ || [situations containsObject:EVAL]);
+
+ switch (mode)
+ {
+ case eval_mode:
+ case expand_mode:
+ if (e)
+ return [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:mode];
+ else
+ RETURN_VALUE (nil);
+
+ case compile_time_too_mode:
+ case not_compile_time_mode:
+ if ((ct && lt)
+ || (lt && e && (mode == compile_time_too_mode)))
+ {
+ return [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:compile_time_too_mode];
+ }
+ else if (lt)
+ {
+ return [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:context
+ withEnvironment:lexenv
+ mode:not_compile_time_mode];
+ }
+ else if (ct || (e && mode == compile_time_too_mode))
+ {
+ [self eval:[MLKCons cons:PROGN with:body]
+ inLexicalContext:context
+ withEnvironment:lexenv];
+ RETURN_VALUE (nil);
+ }
+ else
+ {
+ RETURN_VALUE (nil);
+ }
+ }
+ }
else if (car == FUNCTION)
{
id functionName = [[program cdr] car];
@@ -515,7 +632,7 @@ static MLKSymbol *V_INITP;
result = [self eval:[MLKCons cons:PROGN with:body]
inLexicalContext:ctx
withEnvironment:lexenv
- expandOnly:expandOnly];
+ mode:mode];
if (expandOnly)
{
@@ -797,7 +914,7 @@ static MLKSymbol *V_INITP;
result = [self eval:[rest car]
inLexicalContext:context
withEnvironment:lexenv
- expandOnly:expandOnly];
+ mode:mode];
if (expandOnly)
[results addObjectsFromArray:result];
}
@@ -1114,7 +1231,7 @@ static MLKSymbol *V_INITP;
return [self eval:expansion
inLexicalContext:context
withEnvironment:lexenv
- expandOnly:expandOnly];
+ mode:mode];
}
else
{
@@ -1213,7 +1330,7 @@ static MLKSymbol *V_INITP;
globalContext]
withEnvironment:[MLKLexicalEnvironment
globalEnvironment]
- expandOnly:YES]
+ mode:not_compile_time_mode]
objectAtIndex:0]);
if ([code isKindOfClass:[MLKCons class]] && [code cdr])