From 226e1e2ddfdf84237a1b8caaab7a4114c70ca8f3 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Sat, 2 Aug 2008 23:42:21 +0200
Subject: Add *SYSTEM-INITIALISED-P*.

---
 MLKDynamicContext.m    |  3 +++
 MLKInterpreter.m       | 23 ++++++++++++++++++-----
 MLKPackage.m           |  2 ++
 MLKReadEvalPrintLoop.m |  6 ++++++
 init.lisp              |  2 ++
 5 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index bf70929..87b8b9b 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -263,6 +263,9 @@ static MLKDynamicContext *global_context;
   //  INIT(@"*TERMINAL-IO*", );
   //  INIT(@"*TRACE-OUTPUT* ", );
 
+  [vars setObject:NIL forKey:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
+                               intern:@"*SYSTEM-INITIALISED-P*"]];
+
   global_context = [[self alloc] initWithParent:nil
                                  variables:vars
                                  handlers:nil
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 3e00b37..d2c29c0 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -70,6 +70,7 @@ static MLKSymbol *VALUES;
 static MLKSymbol *_DEFMACRO;
 static MLKSymbol *_LAMBDA;
 static MLKSymbol *_LOOP;
+static MLKSymbol *V_INITP;
 
 
 @implementation MLKInterpreter
@@ -106,6 +107,7 @@ static MLKSymbol *_LOOP;
   UNWIND_PROTECT = [cl intern:@"UNWIND-PROTECT"];
   _DEFMACRO = [sys intern:@"%DEFMACRO"];
   _LAMBDA = [sys intern:@"%LAMBDA"];
+  V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"];
 }
 
 
@@ -130,18 +132,29 @@ static MLKSymbol *_LOOP;
             expandOnly:(BOOL)expandOnly
 {
   MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
+  BOOL trace = NO;
 
-  //  NSLog (@"eval: %@", [program descriptionForLisp]);
+#define TRACE_EVAL 0
+#if TRACE_EVAL
+  if ([dynamicContext valueForSymbol:V_INITP])
+    trace = YES;
+
+  if (trace)
+    NSLog (@"; EVAL: %@", [program descriptionForLisp]);
+#endif  // TRACE_EVAL
 
   if (!program || [program isKindOfClass:[MLKSymbol class]])
     {
       //NSLog (@"Processing symbol.");
       if ([context symbolNamesSymbolMacro:program])
         {
-          id macrofun = [context macroForSymbol:program];
-          id expansion = [macrofun applyToArray:
-                                     [NSArray arrayWithObjects:
-                                                program, context, nil]];
+          id macrofun, expansion;
+
+          macrofun = [context macroForSymbol:program];
+          expansion = [macrofun applyToArray:
+                                  [NSArray arrayWithObjects:
+                                             program, context, nil]];
+
           return [self eval:expansion
                        inLexicalContext:context
                        withEnvironment:lexenv
diff --git a/MLKPackage.m b/MLKPackage.m
index 66a2fbb..28207b4 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -96,6 +96,8 @@ static NSMutableDictionary *packages = nil;
   [sys export:[sys intern:@"%FLET"]];
   [sys export:[sys intern:@"%MACROLET"]];
 
+  [sys export:[sys intern:@"*SYSTEM-INITIALISED-P*"]];
+
   [sys export:[sys intern:@"CAR"]];
   [sys export:[sys intern:@"CDR"]];
   [sys export:[sys intern:@"RPLACA"]];
diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m
index 8370f35..32cd5b1 100644
--- a/MLKReadEvalPrintLoop.m
+++ b/MLKReadEvalPrintLoop.m
@@ -101,6 +101,12 @@ static const char *prompt (EditLine *e) {
   printf ("This is Toilet Lisp, version 0.0.1.\n");
   printf ("Please make yourself at home.\n");
 
+  [[MLKDynamicContext currentContext]
+    setValue:[[MLKPackage findPackage:@"COMMON-LISP"]
+               intern:@"T"]
+    forSymbol:[[MLKPackage findPackage:@"TOILET-SYSTEM"]
+                intern:@"*SYSTEM-INITIALISED-P*"]];
+
   while (1)
     {
       const char *line;
diff --git a/init.lisp b/init.lisp
index 7a57779..08319d3 100644
--- a/init.lisp
+++ b/init.lisp
@@ -30,4 +30,6 @@
 (load "types.lisp")
 (load "list-functions-2.lisp")
 
+(setq *system-initialised-p* t)
+
 (in-package #:common-lisp-user)
-- 
cgit v1.2.3