From 256438ccf9eaf2f45a50c98349d2ac02f52755af Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Thu, 7 Aug 2008 15:45:58 +0200
Subject: Prettify LOAD output.
---
MLKDynamicContext.m | 3 +++
MLKInterpreter.m | 9 +++++++--
MLKRoot.m | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 57 insertions(+), 3 deletions(-)
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 083fc14..ed01263 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -265,6 +265,9 @@ static MLKDynamicContext *global_context;
[vars setObject:NIL forKey:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
intern:@"*SYSTEM-INITIALISED-P*"]];
+ [vars setObject:[MLKInteger integerWithInt:0]
+ forKey:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
+ intern:@"*LOAD-LEVEL*"]];
global_context = [[self alloc] initWithParent:nil
variables:vars
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 159de2a..a2aa81e 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -1392,6 +1392,9 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
+(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print
{
id eofValue = [[NSObject alloc] init];
+ int level = MLKIntWithInteger ([[MLKDynamicContext currentContext]
+ valueForSymbol:[sys intern:@"*LOAD-LEVEL*"]]);
+ int i;
while (YES)
{
@@ -1427,7 +1430,10 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
formdesc = MLKPrintToString(code);
//fprintf (stderr, "; COMPILE-MINIMALLY: %s\n", [formdesc UTF8String]);
- fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]);
+ fprintf (stderr, "; ");
+ for (i = 0; i < level; i++)
+ fprintf (stderr, "| ");
+ fprintf (stderr, "LOAD: %s\n", [formdesc UTF8String]);
expansion = denullify([[MLKInterpreter
eval:code
inLexicalContext:[MLKLexicalContext
@@ -1462,7 +1468,6 @@ static MLKSymbol *MULTIPLE_VALUE_CALL;
}
}
- //NSLog (@"; LOAD: END");
return YES;
}
@end
diff --git a/MLKRoot.m b/MLKRoot.m
index f726841..f295c77 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -150,18 +150,64 @@ static id truify (BOOL value)
{
// FIXME
BOOL success;
+ int l, i;
NSString *fileName = denullify ([args objectAtIndex:0]);
NSInputStream *input = [NSInputStream inputStreamWithFileAtPath:fileName];
MLKStream *stream = LAUTORELEASE ([[MLKStream alloc] initWithInputStream:input]);
+ MLKDynamicContext *oldContext = [MLKDynamicContext currentContext];
+ int level = MLKIntWithInteger ([oldContext
+ valueForSymbol:[sys intern:@"*LOAD-LEVEL*"]]);
+ MLKDynamicContext *ctx;
+
+ l = [fileName length];
+ fprintf (stderr, ";\n; ");
+ for (i = 0; i < 68 - 2*level; i++)
+ fprintf (stderr, "_");
+
+ fprintf (stderr, "\n; /");
+ for (i = 0; i < 30 - l/2 - level; i++)
+ fprintf (stderr, "-");
+ fprintf (stderr, " LOAD: %s ", [fileName UTF8String]);
+ for (i = 0; i < 30 - (l+1)/2 - level; i++)
+ fprintf (stderr, "-");
+ fprintf (stderr, "\n; |\n");
//NSLog (@"%d", [input hasBytesAvailable]);
[input open];
//NSLog (@"%d", [input hasBytesAvailable]);
- success = [MLKInterpreter load:stream verbose:YES print:YES];
+ ctx = [[MLKDynamicContext alloc]
+ initWithParent:oldContext
+ variables:nil
+ handlers:nil
+ restarts:nil
+ catchTags:nil
+ activeHandlerEnvironment:nil];
+ [ctx addValue:MLKIntegerWithInt(level + 1)
+ forSymbol:[sys intern:@"*LOAD-LEVEL*"]];
+ [ctx pushContext];
+ NS_DURING
+ {
+ success = [MLKInterpreter load:stream verbose:YES print:YES];
+ }
+ NS_HANDLER
+ {
+ [MLKDynamicContext popContext];
+ LRELEASE (ctx);
+ [input close];
+ }
+ NS_ENDHANDLER;
+
+ [MLKDynamicContext popContext];
+ LRELEASE (ctx);
[input close];
+ fprintf (stderr, "; \\");
+ for (i = 0; i < 68 - 2*level; i++)
+ fprintf (stderr, "_");
+ fprintf (stderr, "\n; \n");
+
RETURN_VALUE (truify (success));
}
--
cgit v1.2.3