Beginnings of a Lisp compiler.

11 files changed, 312 insertions, 0 deletions

diff --git a/GNUmakefile b/GNUmakefile
new file mode 100644
index 0000000..36c159d
--- /dev/null
+++ b/GNUmakefile
@@ -0,0 +1,26 @@
+## Étoilisp, a Common Lisp subset for Étoilé.
+## 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 $(GNUSTEP_MAKEFILES)/common.make
+
+TOOL_NAME = etoilisp
+etoilisp_OBJC_FILES = MLKCons.m MLKEnvironment.m MLKLinkedList.m	\
+                      MLKLispValue.m MLKUndefinedVariableException.m
+
+-include GNUmakefile.preamble
+include $(GNUSTEP_MAKEFILES)/tool.make
+-include GNUmakefile.postamble
diff --git a/MLKCons.h b/MLKCons.h
new file mode 100644
index 0000000..4430275
--- /dev/null
+++ b/MLKCons.h
@@ -0,0 +1,21 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "MLKLispValue.h"
+
+
+@interface MLKCons : MLKLispValue
+{
+  id _car;
+  id _cdr;
+}
+
++(MLKCons*) cons:(id)car with:(id)cdr;
+
+-(MLKCons*) initWithCar:(id)car cdr:(id)cdr;
+
+-(id) car;
+-(id) cdr;
+-(void) setCar:(id)value;
+-(void) setCdr:(id)value;
+@end
diff --git a/MLKCons.m b/MLKCons.m
new file mode 100644
index 0000000..e9e6360
--- /dev/null
+++ b/MLKCons.m
@@ -0,0 +1,41 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "MLKCons.h"
+
+
+@implementation MLKCons
++(MLKCons*) cons:(id)car with:(id)cdr
+{
+  return AUTORELEASE ([[MLKCons alloc] initWithCar:car cdr:cdr]);
+}
+
+-(MLKCons*) initWithCar:(id)car cdr:(id)cdr
+{
+  ASSIGN (_car, car);
+  ASSIGN (_cdr, cdr);
+  return self;
+}
+
+
+-(id) car
+{
+  return _car;
+}
+
+-(id) cdr
+{
+  return _cdr;
+}
+
+-(void) setCar:(id)value
+{
+  ASSIGN (_car, value);
+}
+
+-(void) setCdr:(id)value
+{
+  ASSIGN (_cdr, value);
+}
+@end
+
diff --git a/MLKEnvironment.h b/MLKEnvironment.h
new file mode 100644
index 0000000..b100137
--- /dev/null
+++ b/MLKEnvironment.h
@@ -0,0 +1,19 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "MLKLispValue.h"
+
+@class NSMutableDictionary, MLKLinkedList, MLKSymbol;
+
+
+@interface MLKEnvironment : MLKLispValue
+{
+  MLKLinkedList *_bindings;
+}
+
+-(MLKEnvironment *) init;
+-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent;
+
+-(void) setBinding:(MLKSymbol *)symbol to:(id)value;
+-(id) valueForBinding:(MLKSymbol *)symbol;
+@end
diff --git a/MLKEnvironment.m b/MLKEnvironment.m
new file mode 100644
index 0000000..56bafb7
--- /dev/null
+++ b/MLKEnvironment.m
@@ -0,0 +1,61 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import <Foundation/NSDictionary.h>
+#import <Foundation/NSArray.h>
+
+#import "MLKEnvironment.h"
+#import "MLKLinkedList.h"
+#import "MLKCons.h"
+#import "MLKUndefinedVariableException.h"
+
+
+@implementation MLKEnvironment
+-(MLKEnvironment *) init
+{
+  _bindings = [[MLKLinkedList alloc] init];
+  return self;
+}
+
+-(MLKEnvironment *) initWithParent:(MLKEnvironment *)parent
+{
+  ASSIGN (_bindings, parent->_bindings);
+  return self;
+}
+
+-(void) setBinding:(MLKSymbol *)symbol to:(id)value
+{
+  MLKCons *cons;
+  for (cons = [_bindings firstCons]; cons; cons = [cons cdr])
+    {
+      NSMutableDictionary *dict = [cons car];
+      if ([[dict allKeys] containsObject:symbol])
+        {
+          [dict setObject:value forKey:symbol];
+          break;
+        }
+    }
+  
+  [[[MLKUndefinedVariableException alloc] initWithEnvironment: self
+                                          variableName: symbol]
+    raise];
+}
+
+-(id) valueForBinding:(MLKSymbol *)symbol
+{
+  MLKCons *cons;
+  for (cons = [_bindings firstCons]; cons; cons = [cons cdr])
+    {
+      NSMutableDictionary *dict = [cons car];
+      if ([[dict allKeys] containsObject:symbol])
+        {
+          return [dict objectForKey:symbol];
+        }
+    }
+
+  [[[MLKUndefinedVariableException alloc] initWithEnvironment: self
+                                          variableName: symbol]
+    raise];
+  return nil;
+}
+@end
diff --git a/MLKLinkedList.h b/MLKLinkedList.h
new file mode 100644
index 0000000..70e4604
--- /dev/null
+++ b/MLKLinkedList.h
@@ -0,0 +1,26 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "Foundation/NSObject.h"
+#import "MLKLispValue.h"
+
+@class MLKCons;
+
+
+@interface MLKLinkedList : NSObject
+{
+  MLKCons *_firstCons;
+}
+
+-(MLKLinkedList*) init;
+-(MLKLinkedList*) initWithCons:(MLKCons*)cons;
+
+-(void) push: (id)object;
+-(id) pop;
+-(MLKCons*) firstCons;
+-(BOOL) null;
+
+#ifdef __OBJC2__
+-(NSUInteger) countByEnumeratingWithState:(NSFastEnumerationState *)state objects:(id *)stackbuf count:(NSUInteger)len;
+#endif
+@end
diff --git a/MLKLinkedList.m b/MLKLinkedList.m
new file mode 100644
index 0000000..40174e0
--- /dev/null
+++ b/MLKLinkedList.m
@@ -0,0 +1,64 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "MLKLinkedList.h"
+#import "MLKCons.h"
+
+
+@implementation MLKLinkedList
+-(MLKLinkedList*) init
+{
+  _firstCons = nil;
+  return self;
+}
+
+-(MLKLinkedList*) initWithCons:(MLKCons*)cons
+{
+  ASSIGN (_firstCons, cons);
+  return self;
+}
+
+-(void) push: (id)object
+{
+  ASSIGN (_firstCons, [MLKCons cons:object with:_firstCons]);
+}
+
+-(id) pop
+{
+  id retval = [_firstCons car];
+  RETAIN (retval);
+  ASSIGN (_firstCons, [_firstCons cdr]);
+  AUTORELEASE (retval);
+  return retval;
+}
+
+-(MLKCons*) firstCons
+{
+  return _firstCons;
+}
+
+-(BOOL) null
+{
+  return !_firstCons;
+}
+
+#ifdef __OBJC2__
+-(NSUInteger) countByEnumeratingWithState:(NSFastEnumerationState *)state objects:(id *)stackbuf count:(NSUInteger)len
+{
+  if (state->state == 0)
+    {
+      state->mutationsPtr = &_firstCons;
+      state->extra[0] = (unsigned long) &_firstCons;
+    }
+  
+  MLKCons *currentCons = (MLKCons*) state->extra[0];
+  if (currentCons)
+    {
+      state->itemsPtr = [currentCons car];
+      return 1;
+    }
+  else
+    return 0;
+}
+#endif
+@end
diff --git a/MLKLispValue.h b/MLKLispValue.h
new file mode 100644
index 0000000..8dcde31
--- /dev/null
+++ b/MLKLispValue.h
@@ -0,0 +1,14 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import <Foundation/NSObject.h>
+
+@interface MLKLispValue : NSObject
+/*
+{
+  int typeTag;
+}
+
++(id) init;
+*/
+@end
diff --git a/MLKLispValue.m b/MLKLispValue.m
new file mode 100644
index 0000000..1b409d2
--- /dev/null
+++ b/MLKLispValue.m
@@ -0,0 +1,8 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#include "MLKLispValue.h"
+
+
+@implementation MLKLispValue
+@end
diff --git a/MLKUndefinedVariableException.h b/MLKUndefinedVariableException.h
new file mode 100644
index 0000000..16005ce
--- /dev/null
+++ b/MLKUndefinedVariableException.h
@@ -0,0 +1,17 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import <Foundation/NSException.h>
+
+@class MLKSymbol, MLKEnvironment;
+
+
+@interface MLKUndefinedVariableException : NSException
+{
+  MLKSymbol *variableName;
+  MLKEnvironment *environment;
+}
+
+-(MLKUndefinedVariableException *) initWithEnvironment:(id)environment
+                                          variableName:(id)symbol;
+@end
diff --git a/MLKUndefinedVariableException.m b/MLKUndefinedVariableException.m
new file mode 100644
index 0000000..531a394
--- /dev/null
+++ b/MLKUndefinedVariableException.m
@@ -0,0 +1,15 @@
+/* -*- mode: objc; coding: utf-8 -*- */
+/* Copyright 2008, Matthias Benkard. */
+
+#import "MLKUndefinedVariableException.h"
+
+
+@implementation MLKUndefinedVariableException
+-(MLKUndefinedVariableException *) initWithEnvironment:(id)anEnvironment
+                                          variableName:(id)aSymbol
+{
+  variableName = aSymbol;
+  environment = anEnvironment;
+  return self;
+}
+@end