summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--GNUmakefile25
-rw-r--r--MLKBackquoteReader.h27
-rw-r--r--MLKBackquoteReader.m62
-rw-r--r--MLKCommaReader.h27
-rw-r--r--MLKCommaReader.m73
-rw-r--r--MLKDynamicContext.m12
-rw-r--r--MLKRoot.m6
-rw-r--r--util.lisp37
8 files changed, 253 insertions, 16 deletions
diff --git a/GNUmakefile b/GNUmakefile
index 3ba767b..143598a 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -27,18 +27,19 @@ BUNDLE_NAME = Test
ADDITIONAL_OBJCFLAGS = -Wall
-ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBinding.m \
- MLKDoubleFloat.m MLKDynamicContext.m \
- MLKEnvironment.m MLKFloat.m MLKInteger.m \
- MLKInterpretedClosure.m MLKInterpreter.m \
- MLKLinkedList.m MLKLexicalContext.m \
- MLKLexicalEnvironment.m MLKLispValue.m \
- MLKNumber.m MLKPackage.m MLKParenReader.m \
- MLKQuoteReader.m MLKRatio.m MLKReader.m \
- MLKReadtable.m MLKReaderError.m MLKRoot.m \
- MLKSemicolonReader.m MLKSingleFloat.m MLKStream.m \
- MLKStringInputStream.m MLKStringOutputStream.m \
- MLKStringReader.m MLKSymbol.m MLKThrowException.m \
+ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBackquoteReader.m \
+ MLKBinding.m MLKCommaReader.m MLKDoubleFloat.m \
+ MLKDynamicContext.m MLKEnvironment.m MLKFloat.m \
+ MLKInteger.m MLKInterpretedClosure.m \
+ MLKInterpreter.m MLKLinkedList.m \
+ MLKLexicalContext.m MLKLexicalEnvironment.m \
+ MLKLispValue.m MLKNumber.m MLKPackage.m \
+ MLKParenReader.m MLKQuoteReader.m MLKRatio.m \
+ MLKReader.m MLKReadtable.m MLKReaderError.m \
+ MLKRoot.m MLKSemicolonReader.m MLKSingleFloat.m \
+ MLKStream.m MLKStringInputStream.m \
+ MLKStringOutputStream.m MLKStringReader.m \
+ MLKSymbol.m MLKThrowException.m \
NSObject-MLKPrinting.m NSString-MLKPrinting.m
ToiletKit_LDFLAGS = -lgmp
#LIBRARIES_DEPEND_UPON
diff --git a/MLKBackquoteReader.h b/MLKBackquoteReader.h
new file mode 100644
index 0000000..1c35bfa
--- /dev/null
+++ b/MLKBackquoteReader.h
@@ -0,0 +1,27 @@
+/* -*- 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 "MLKFuncallable.h"
+#import "MLKLispValue.h"
+
+#import <Foundation/NSArray.h>
+
+
+@interface MLKBackquoteReader : MLKLispValue <MLKFuncallable>
+-(NSArray *) applyToArray:(NSArray *)arguments;
+@end
diff --git a/MLKBackquoteReader.m b/MLKBackquoteReader.m
new file mode 100644
index 0000000..47989ab
--- /dev/null
+++ b/MLKBackquoteReader.m
@@ -0,0 +1,62 @@
+/* -*- 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 "MLKBackquoteReader.h"
+
+#import "MLKCons.h"
+#import "MLKDynamicContext.h"
+#import "MLKReader.h"
+#import "MLKReadtable.h"
+#import "MLKPackage.h"
+#import "MLKStream.h"
+#import "runtime-compatibility.h"
+#import "util.h"
+
+
+@implementation MLKBackquoteReader
+-(NSArray *) applyToArray:(NSArray *)arguments
+{
+ MLKStream *stream;
+ MLKReadtable *readtable;
+ MLKPackage *cl, *sys;
+ unichar ch;
+ id quoted_form;
+
+ cl = [MLKPackage findPackage:@"COMMON-LISP"];
+ sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+ stream = [arguments objectAtIndex:0];
+ readtable = [[MLKDynamicContext currentContext]
+ valueForSymbol:[cl intern:@"*READTABLE*"]];
+
+ while ([readtable isWhitespaceCharacter:(ch = [stream readChar])]);
+
+ [stream unreadChar:ch];
+
+ quoted_form = [MLKReader readFromStream:stream
+ eofError:YES
+ eofValue:nil
+ recursive:YES
+ preserveWhitespace:NO];
+
+ return [NSArray arrayWithObject:
+ [MLKCons cons:[sys intern:@"QUASIQUOTE"]
+ with:[MLKCons cons:nullify(quoted_form)
+ with:nil]]];
+}
+@end
diff --git a/MLKCommaReader.h b/MLKCommaReader.h
new file mode 100644
index 0000000..5f5d11e
--- /dev/null
+++ b/MLKCommaReader.h
@@ -0,0 +1,27 @@
+/* -*- 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 "MLKFuncallable.h"
+#import "MLKLispValue.h"
+
+#import <Foundation/NSArray.h>
+
+
+@interface MLKCommaReader : MLKLispValue <MLKFuncallable>
+-(NSArray *) applyToArray:(NSArray *)arguments;
+@end
diff --git a/MLKCommaReader.m b/MLKCommaReader.m
new file mode 100644
index 0000000..3a0115b
--- /dev/null
+++ b/MLKCommaReader.m
@@ -0,0 +1,73 @@
+/* -*- 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 "MLKCommaReader.h"
+
+#import "MLKCons.h"
+#import "MLKDynamicContext.h"
+#import "MLKReader.h"
+#import "MLKReadtable.h"
+#import "MLKPackage.h"
+#import "MLKStream.h"
+#import "runtime-compatibility.h"
+#import "util.h"
+
+
+@implementation MLKCommaReader
+-(NSArray *) applyToArray:(NSArray *)arguments
+{
+ MLKStream *stream;
+ MLKReadtable *readtable;
+ MLKPackage *cl, *sys;
+ MLKSymbol *marker;
+ unichar ch;
+ id quoted_form;
+
+ cl = [MLKPackage findPackage:@"COMMON-LISP"];
+ sys = [MLKPackage findPackage:@"TOILET-SYSTEM"];
+
+ stream = [arguments objectAtIndex:0];
+ readtable = [[MLKDynamicContext currentContext]
+ valueForSymbol:[cl intern:@"*READTABLE*"]];
+
+ if ((ch = [stream readChar]) == '@')
+ {
+ marker = [sys intern:@"UNQUOTE-SPLICING"];
+ }
+ else
+ {
+ marker = [sys intern:@"UNQUOTE"];
+ [stream unreadChar:ch];
+ }
+
+ while ([readtable isWhitespaceCharacter:(ch = [stream readChar])]);
+
+ [stream unreadChar:ch];
+
+ quoted_form = [MLKReader readFromStream:stream
+ eofError:YES
+ eofValue:nil
+ recursive:YES
+ preserveWhitespace:NO];
+
+ return [NSArray arrayWithObject:
+ [MLKCons cons:marker
+ with:[MLKCons cons:nullify(quoted_form)
+ with:nil]]];
+}
+@end
diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 593f4a7..1b8725b 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -24,6 +24,8 @@
#import <Foundation/NSString.h>
#import <Foundation/NSThread.h>
+#import "MLKBackquoteReader.h"
+#import "MLKCommaReader.h"
#import "MLKCons.h"
#import "MLKDynamicContext.h"
#import "MLKEnvironment.h"
@@ -147,8 +149,6 @@ static MLKDynamicContext *global_context;
[readtable setSyntaxType:MULTI_ESCAPE forCharacter:'|'];
// [readtable setSyntaxType:NONTERMINATING_MACRO forCharacter:'#'];
- // [readtable setSyntaxType:TERMINATING_MACRO forCharacter:'`'];
- // [readtable setSyntaxType:TERMINATING_MACRO forCharacter:','];
[readtable setSyntaxType:SINGLE_ESCAPE forCharacter:'\\'];
@@ -164,6 +164,14 @@ static MLKDynamicContext *global_context;
[readtable setSyntaxType:TERMINATING_MACRO forCharacter:'\''];
[readtable setMacroFunction:AUTORELEASE([[MLKQuoteReader alloc] init])
forCharacter:'\''];
+
+ [readtable setSyntaxType:TERMINATING_MACRO forCharacter:'`'];
+ [readtable setMacroFunction:AUTORELEASE([[MLKBackquoteReader alloc] init])
+ forCharacter:'`'];
+
+ [readtable setSyntaxType:TERMINATING_MACRO forCharacter:','];
+ [readtable setMacroFunction:AUTORELEASE([[MLKCommaReader alloc] init])
+ forCharacter:','];
[readtable setSyntaxType:TERMINATING_MACRO forCharacter:';'];
[readtable setMacroFunction:AUTORELEASE([[MLKSemicolonReader alloc] init])
diff --git a/MLKRoot.m b/MLKRoot.m
index dc2560d..d007173 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -225,10 +225,12 @@ static id truify (BOOL value)
+(NSArray *) macroexpand_1:(NSArray *)args
{
id form = [args objectAtIndex:0];
- id env = [args count] > 1 ? [args objectAtIndex:1] : nil;
+ id env = [args count] > 1 ? denullify([args objectAtIndex:1]) : nil;
MLKLexicalContext *context = env ? (id)env : (id)[MLKLexicalContext globalContext];
- if ([context symbolNamesMacro:[form car]])
+ if ([form isKindOfClass:[MLKCons class]]
+ && (![form car] || [[form car] isKindOfClass:[MLKSymbol class]])
+ && [context symbolNamesMacro:[form car]])
{
id <MLKFuncallable> macrofun = [context macroForSymbol:[form car]];
form = denullify ([[macrofun applyToArray:
diff --git a/util.lisp b/util.lisp
index 50688a3..ca1b25a 100644
--- a/util.lisp
+++ b/util.lisp
@@ -134,3 +134,40 @@
(list 'quote (car this-clause))))
(cons 'progn (cdr this-clause))
(list* 'case object-sym rest)))))))
+
+(%defmacro* sys::quasiquote (object)
+ (if (not (consp object))
+ (list 'quote object)
+ (cond ((eq 'sys::unquote (car object)) (car (cdr object)))
+ ((eq 'sys::quasiquote (car object)) (list 'quote object))
+ ((and (consp (car object))
+ (eq 'sys::unquote-splicing (car (car object))))
+ (list 'append
+ (car (cdr (car object)))
+ (list 'sys::quasiquote (cdr object))))
+ (t (list 'cons
+ (list 'sys::quasiquote (car object))
+ (list 'sys::quasiquote (cdr object)))))))
+
+(%defun* list-eqp (list1 list2)
+ "Not really EQUALP (only works on trees of symbols)."
+ (if (and (consp list1) (consp list2))
+ (and (list-eqp (car list1) (car list2))
+ (list-eqp (cdr list1) (cdr list2)))
+ (eq list1 list2)))
+
+(%defun* macroexpand (object . rest)
+ (let* ((env (if rest (car rest) nil))
+ (expansion-1 (macroexpand-1 object env))
+ (expansion-2 (macroexpand-1 expansion-1 env)))
+ (if (list-eqp expansion-1 expansion-2)
+ expansion-1
+ (macroexpand expansion-2))))
+
+(%defun* macroexpand-all (object . rest)
+ (let* ((env (if rest (car rest) nil)))
+ (if (consp object)
+ (let ((expansion (macroexpand object env)))
+ (cons (macroexpand-all (car expansion))
+ (macroexpand-all (cdr expansion))))
+ object)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 04:48:33 +0000