From 0f7abae8b9525d60685ae3b9ecc2fb4131c766a4 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sat, 26 Jul 2008 19:23:28 +0200 Subject: Reader: Support quasiquotation. --- GNUmakefile | 25 +++++++++--------- MLKBackquoteReader.h | 27 +++++++++++++++++++ MLKBackquoteReader.m | 62 ++++++++++++++++++++++++++++++++++++++++++++ MLKCommaReader.h | 27 +++++++++++++++++++ MLKCommaReader.m | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++ MLKDynamicContext.m | 12 +++++++-- MLKRoot.m | 6 +++-- util.lisp | 37 ++++++++++++++++++++++++++ 8 files changed, 253 insertions(+), 16 deletions(-) create mode 100644 MLKBackquoteReader.h create mode 100644 MLKBackquoteReader.m create mode 100644 MLKCommaReader.h create mode 100644 MLKCommaReader.m 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 . + */ + +#import "MLKFuncallable.h" +#import "MLKLispValue.h" + +#import + + +@interface MLKBackquoteReader : MLKLispValue +-(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 . + */ + +#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 . + */ + +#import "MLKFuncallable.h" +#import "MLKLispValue.h" + +#import + + +@interface MLKCommaReader : MLKLispValue +-(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 . + */ + +#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 #import +#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 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))) -- cgit v1.2.3