Add classes MLKLexicalEnvironment and MLKReadEvalPrintLoop.

8 files changed, 368 insertions, 18 deletions

diff --git a/GNUmakefile b/GNUmakefile
index b001940..c496ccb 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -19,16 +19,20 @@ include $(GNUSTEP_MAKEFILES)/common.make
 
 #all:: ToiletKit etshell Test
 
+TOOL_NAME = etshell toilet
+FRAMEWORK_NAME = ToiletKit
+BUNDLE_NAME = Test
+
 ADDITIONAL_OBJCFLAGS = -Wall
 
-FRAMEWORK_NAME = ToiletKit
 ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKDoubleFloat.m	\
                        MLKDynamicContext.m MLKEndOfFileError.m		\
                        MLKEnvironment.m MLKError.m MLKFloat.m		\
                        MLKInteger.m MLKInterpreter.m MLKLinkedList.m	\
-                       MLKLispValue.m MLKPackage.m MLKParenReader.m	\
-                       MLKRatio.m MLKReader.m MLKReadtable.m		\
-                       MLKReaderError.m MLKSingleFloat.m MLKStream.m	\
+                       MLKLexicalEnvironment.m MLKLispValue.m		\
+                       MLKPackage.m MLKParenReader.m MLKRatio.m		\
+                       MLKReader.m MLKReadtable.m MLKReaderError.m	\
+                       MLKSingleFloat.m MLKStream.m			\
                        MLKStringInputStream.m MLKSymbol.m		\
                        MLKThrowException.m				\
                        MLKUndefinedVariableException.m			\
@@ -40,7 +44,6 @@ ToiletKit_LDFLAGS = -lgmp
 #etoilet_OBJC_FILES = main.m
 #etoilet_OBJC_LIBS = -lToiletKit -LToiletKit.framework
 
-TOOL_NAME = etshell
 etshell_OBJC_FILES = StepTalkShell/STShell.m		\
                      StepTalkShell/STShell+output.m	\
                      StepTalkShell/stshell_tool.m
@@ -48,7 +51,9 @@ etshell_OBJC_LIBS += -lStepTalk -lreadline -lncurses -lToiletKit	\
                      -LToiletKit.framework
 etshell_OBJCFLAGS = -w
 
-BUNDLE_NAME = Test
+toilet_OBJC_FILES = MLKReadEvalPrintLoop.m
+toilet_OBJC_LIBS += -ledit -lncurses -lToiletKit -LToiletKit.framework
+
 Test_OBJC_FILES = MLKLowLevelTests.m
 Test_OBJC_LIBS = -lUnitKit -LToiletKit.framework -lToiletKit
 
@@ -58,7 +63,10 @@ include $(GNUSTEP_MAKEFILES)/framework.make
 include $(GNUSTEP_MAKEFILES)/tool.make
 -include GNUmakefile.postamble
 
-before-all:: before-etshell
+before-all:: before-etshell before-toilet
+
+before-toilet::
+	rm -f obj/toilet
 
 before-etshell::
 	rm -f obj/etshell
@@ -70,5 +78,10 @@ before-etshell::
 test: ToiletKit Test
 	env LD_LIBRARY_PATH=`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib ukrun Test.bundle
 
-run: before-etshell ToiletKit etshell
+run-et: before-etshell ToiletKit etshell
 	env LD_LIBRARY_PATH=`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib obj/etshell
+
+run-toilet: before-toilet ToiletKit toilet
+	env LD_LIBRARY_PATH=`pwd`/ToiletKit.framework/Versions/Current:/usr/local/lib obj/toilet
+
+run: run-toilet
diff --git a/MLKInterpreter.h b/MLKInterpreter.h
index 1129c83..8fcc1ec 100644
--- a/MLKInterpreter.h
+++ b/MLKInterpreter.h
@@ -18,7 +18,7 @@
 
 #import <Foundation/NSObject.h>
 
-@class MLKLexicalContext, MLKEnvironment;
+@class MLKLexicalContext, MLKLexicalEnvironment;
 
 
 @interface MLKInterpreter : NSObject
@@ -26,5 +26,5 @@
   
 +(id) eval:(id)program
       inLexicalContext:(MLKLexicalContext *)context
-      withEnvironment:(MLKEnvironment *)lexenv;
+      withEnvironment:(MLKLexicalEnvironment *)lexenv;
 @end
diff --git a/MLKInterpreter.m b/MLKInterpreter.m
index 37da36d..4ab03d2 100644
--- a/MLKInterpreter.m
+++ b/MLKInterpreter.m
@@ -22,11 +22,13 @@
 #import "MLKFuncallable.h"
 #import "MLKInterpreter.h"
 #import "MLKLexicalContext.h"
+#import "MLKLexicalEnvironment.h"
 #import "MLKPackage.h"
 #import "MLKSymbol.h"
 #import "runtime-compatibility.h"
 
 #import <Foundation/NSArray.h>
+#import <Foundation/NSNull.h>
 #import <Foundation/NSString.h>
 
 
@@ -68,7 +70,7 @@ static MLKSymbol *_DEFMACRO;
 
 +(id) eval:(id)program
       inLexicalContext:(MLKLexicalContext *)context
-      withEnvironment:(MLKEnvironment *)lexenv
+      withEnvironment:(MLKLexicalEnvironment *)lexenv
 {
   MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext];
 
@@ -76,7 +78,7 @@ static MLKSymbol *_DEFMACRO;
     {
       if ([context variableIsLexical:program])
         {
-          return [lexenv valueForBinding:program];
+          return [lexenv valueForSymbol:program];
         }
       else
         {
@@ -101,17 +103,17 @@ static MLKSymbol *_DEFMACRO;
                                     withEnvironment:lexenv];
 
               return [[[program cdr] car] applyToArray:(rest
-                                                        ? [rest array]
-                                                        : [NSArray array])];
+                                                        ? (id)[rest array]
+                                                        : (id)[NSArray array])];
             }
           else if (car == EVAL)
             {
               return [self eval:[self eval:[program cdr]
                                       inLexicalContext:context
                                       withEnvironment:lexenv]
-                           inLexicalContext:[MLKLexicalContext nullContext]
-                           withEnvironment:
-                             AUTORELEASE([[MLKEnvironment alloc] init])];
+                           inLexicalContext:[MLKLexicalContext globalContext]
+                           withEnvironment:[MLKLexicalEnvironment
+                                             globalEnvironment]];
             }
           else if (car == PROGN)
             {
@@ -132,7 +134,33 @@ static MLKSymbol *_DEFMACRO;
             }
           else
             {
-              //FIXME: ...
+              if ([context symbolNamesFunction:car])
+                {
+                  id function = [lexenv functionForSymbol:car];
+                  MLKCons *rest = [program cdr];
+                  NSMutableArray *args = [NSMutableArray array];
+                  
+                  while (rest)
+                    {
+                      id result = [self eval:[rest car]
+                                        inLexicalContext:context
+                                        withEnvironment:lexenv];
+                      [args addObject:(result ? (id)result : (id)[NSNull null])];
+                      rest = [rest cdr];
+                    }
+                  
+                  return [function applyToArray:args];
+                }
+              else if ([context symbolNamesMacro:car])
+                {
+                  id macrofun = [context macroForSymbol:car];
+                  id expansion = [macrofun applyToArray:
+                                             [NSArray arrayWithObjects:
+                                                        program, context, nil]];
+                  return [self eval:expansion
+                               inLexicalContext:context
+                               withEnvironment:lexenv];
+                }
             }
         }
       else if (![car isKindOfClass:[MLKCons class]] && [car car] == LAMBDA)
diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h
index a93e40f..68acb80 100644
--- a/MLKLexicalContext.h
+++ b/MLKLexicalContext.h
@@ -42,6 +42,9 @@
 
 -(MLKEnvironment *) environment;
 
+-(BOOL) symbolNamesFunction:(MLKSymbol *)symbol;
+-(BOOL) symbolNamesMacro:(MLKSymbol *)symbol;
+
 -(id) macroForSymbol:(MLKSymbol *)symbol;
 -(id) goTagForSymbol:(MLKSymbol *)symbol;
 -(id) variableLocationForSymbol:(MLKSymbol *)symbol;
diff --git a/MLKLexicalEnvironment.h b/MLKLexicalEnvironment.h
new file mode 100644
index 0000000..8d1300d
--- /dev/null
+++ b/MLKLexicalEnvironment.h
@@ -0,0 +1,54 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include <Foundation/NSObject.h>
+
+@class MLKEnvironment, MLKSymbol, NSLinkedList,
+       NSMutableDictionary, NSString;
+
+
+@interface MLKLexicalEnvironment : NSObject
+{
+  MLKEnvironment *_variables;
+  MLKEnvironment *_functions;
+  MLKLexicalEnvironment *_parent;
+}
+
+-(MLKLexicalEnvironment *) initWithParent:(MLKLexicalEnvironment *)aContext
+                                variables:(NSDictionary *)vars
+                                functions:(NSDictionary *)handlers;
+
++(MLKLexicalEnvironment *) globalEnvironment;
+
+-(id) valueForSymbol:(MLKSymbol *)symbol;
+-(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol;
+-(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol;
+-(void) addBinding:(MLKSymbol *)symbol;
+
+-(id) functionForSymbol:(MLKSymbol *)symbol;
+-(void) setFunction:(id)value forSymbol:(MLKSymbol *)symbol;
+-(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol;
+
+-(BOOL) boundp:(MLKSymbol *)symbol;
+-(void) makunbound:(MLKSymbol *)symbol;
+
+-(BOOL) fboundp:(MLKSymbol *)symbol;
+-(void) fmakunbound:(MLKSymbol *)symbol;
+
+-(void) dealloc;
+@end
diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m
new file mode 100644
index 0000000..58cf7f1
--- /dev/null
+++ b/MLKLexicalEnvironment.m
@@ -0,0 +1,131 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import <Foundation/NSArray.h>
+#import <Foundation/NSDictionary.h>
+#import <Foundation/NSException.h>
+#import <Foundation/NSNull.h>
+#import <Foundation/NSSet.h>
+#import <Foundation/NSString.h>
+#import <Foundation/NSThread.h>
+
+#import "MLKCons.h"
+#import "MLKEnvironment.h"
+#import "MLKLexicalEnvironment.h"
+#import "MLKLinkedList.h"
+#import "MLKPackage.h"
+#import "MLKParenReader.h"
+#import "MLKReadtable.h"
+#import "MLKSymbol.h"
+#import "MLKInteger.h"
+#import "runtime-compatibility.h"
+
+
+#define MAKE_ENVIRONMENT(variable, parent, parent_member)               \
+  (variable                                                             \
+   ? (id) [[MLKEnvironment alloc]                                       \
+            initWithParent:(parent                                      \
+                            ? (id) parent_member                        \
+                            : nil)                                      \
+                  bindings:vars]                                        \
+   : (id) (parent ? (id) RETAIN (parent_member) : nil));
+
+
+static MLKLexicalEnvironment *global_environment;
+
+
+@implementation MLKLexicalEnvironment
+-(MLKLexicalEnvironment *) initWithParent:(MLKLexicalEnvironment *)aContext
+                                variables:(NSDictionary *)vars
+                                functions:(NSDictionary *)handlers
+{
+  self = [super init];
+  ASSIGN (_parent, (aContext ? aContext : global_environment));
+  _variables = MAKE_ENVIRONMENT(vars, _parent, _parent->_variables);
+  _functions = MAKE_ENVIRONMENT(handlers, _parent, _parent->_functions);
+  return self;
+}
+
++(MLKLexicalEnvironment *) globalEnvironment
+{
+  return global_environment;
+}
+
+-(id) valueForSymbol:(MLKSymbol *)symbol
+{
+  return [_variables valueForBinding:symbol];
+}
+
+-(void) setValue:(id)value forSymbol:(MLKSymbol *)symbol
+{
+  [_variables setValue:value forBinding:symbol];
+}
+
+-(void) addValue:(id)value forSymbol:(MLKSymbol *)symbol
+{
+  [_variables addValue:value forBinding:symbol];
+}
+
+-(void) addBinding:(MLKSymbol *)symbol
+{
+  [_variables addBinding:symbol];
+}
+
+-(BOOL) boundp:(MLKSymbol *)symbol
+{
+  return [_variables boundp:symbol];
+}
+
+-(void) makunbound:(MLKSymbol *)symbol
+{
+  [_variables makunbound:symbol];
+}
+
+-(id) functionForSymbol:(MLKSymbol *)symbol
+{
+  return [_functions valueForBinding:symbol];
+}
+
+-(void) setFunction:(id)value forSymbol:(MLKSymbol *)symbol
+{
+  [_functions setValue:value forBinding:symbol];
+}
+
+-(void) addFunction:(id)value forSymbol:(MLKSymbol *)symbol
+{
+  [_functions addValue:value forBinding:symbol];
+}
+
+-(BOOL) fboundp:(MLKSymbol *)symbol
+{
+  return [_functions boundp:symbol];
+}
+
+-(void) fmakunbound:(MLKSymbol *)symbol
+{
+  [_functions makunbound:symbol];
+}
+
+-(void) dealloc
+{
+  RELEASE (_variables);
+  RELEASE (_functions);
+  RELEASE (_parent);
+  [super dealloc];
+}
+@end
diff --git a/MLKReadEvalPrintLoop.h b/MLKReadEvalPrintLoop.h
new file mode 100644
index 0000000..4a6cf75
--- /dev/null
+++ b/MLKReadEvalPrintLoop.h
@@ -0,0 +1,23 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import <Foundation/NSObject.h>
+
+@interface MLKReadEvalPrintLoop : NSObject
++(void) run;
+@end
diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m
new file mode 100644
index 0000000..1d79a2f
--- /dev/null
+++ b/MLKReadEvalPrintLoop.m
@@ -0,0 +1,98 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Étoilisp/Mulklisp, a Common Lisp subset for the Étoilé runtime.
+ * Copyright (C) 2008  Matthias Andreas Benkard.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#import "MLKDynamicContext.h"
+#import "MLKInterpreter.h"
+#import "MLKLexicalEnvironment.h"
+#import "MLKPackage.h"
+#import "MLKReadEvalPrintLoop.h"
+#import "MLKReader.h"
+
+#import <Foundation/NSString.h>
+
+#import <editline/history.h>
+#import <editline/readline.h>
+#import <histedit.h>
+
+
+static int _argc;
+static char **_argv;
+
+
+static const char *prompt (EditLine *e) {
+  MLKPackage *package = [[MLKDynamicContext currentContext]
+                          valueForBinding:[[MLKPackage
+                                             findPackage:@"COMMON-LISP"]
+                                            intern:@"*PACKAGE*"]];
+
+  return [[NSString stringWithFormat:@"%@> ", [package name]] UTF8String];
+}
+
+
+@implementation MLKReadEvalPrintLoop : NSObject
++(void) run
+{
+  EditLine *editline;
+  History *commands;
+  HistEvent event;
+
+  editline = el_init (_argv[0], stdin, stdout, stderr);
+  el_set (editline, EL_PROMPT, &prompt);
+  el_set (editline, EL_EDITOR, "emacs");
+  
+  commands = history_init();
+  history (commands, &event, H_SETSIZE, 1000);
+  el_set (editline, EL_HIST, history, commands);
+
+  while (1)
+    {
+      const char *line;
+      ssize_t line_length;
+
+      line = el_gets (editline, &line_length);
+
+      if (line_length > 0)
+        {
+          NSString *result;
+          id code;
+
+          history (commands, &event, H_ENTER, line);
+          code = [MLKReader readFromString:result];
+          result = [MLKInterpreter eval:code
+                                   inLexicalContext:[MLKLexicalContext
+                                                      globalContext]
+                                   withEnvironment:[MLKLexicalEnvironment
+                                                     globalEnvironment]];
+        }
+
+      //free (line);
+    }
+  
+  history_end (commands);
+  el_end (editline);
+}
+@end
+
+
+int main (int argc, char **argv)
+{
+  _argc = argc;
+  _argv = argv;
+  [MLKReadEvalPrintLoop run];
+  return 0;
+}