diff options
| -rw-r--r-- | GNUmakefile | 18 | ||||
| -rw-r--r-- | MLKClosure.h | 5 | ||||
| -rw-r--r-- | MLKCons.h | 1 | ||||
| -rw-r--r-- | MLKCons.m | 26 | ||||
| -rw-r--r-- | MLKInterpretedClosure.h | 45 | ||||
| -rw-r--r-- | MLKInterpretedClosure.m | 75 | ||||
| -rw-r--r-- | MLKInterpreter.m | 36 | ||||
| -rw-r--r-- | MLKLexicalContext.h | 16 | ||||
| -rw-r--r-- | MLKLexicalContext.m | 27 | ||||
| -rw-r--r-- | MLKLexicalEnvironment.h | 6 | ||||
| -rw-r--r-- | MLKLexicalEnvironment.m | 13 | ||||
| -rw-r--r-- | MLKPackage.m | 22 |
12 files changed, 267 insertions, 23 deletions
diff --git a/GNUmakefile b/GNUmakefile index de97da6..0ec256b 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -27,16 +27,16 @@ ADDITIONAL_OBJCFLAGS = -Wall ToiletKit_OBJC_FILES = MLKCharacter.m MLKCons.m MLKBinding.m \ MLKDoubleFloat.m MLKDynamicContext.m \ - MLKEndOfFileError.m MLKEnvironment.m \ - MLKFloat.m MLKInteger.m MLKInterpreter.m \ - MLKLinkedList.m MLKLexicalContext.m \ - MLKLexicalEnvironment.m MLKLispValue.m \ - MLKPackage.m MLKParenReader.m MLKRatio.m \ - MLKReader.m MLKReadtable.m MLKReaderError.m \ - MLKSingleFloat.m MLKStream.m \ + MLKEndOfFileError.m MLKEnvironment.m MLKFloat.m \ + MLKInteger.m MLKInterpretedClosure.m \ + MLKInterpreter.m MLKLinkedList.m \ + MLKLexicalContext.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 \ - NSObject-MLKPrinting.m NSString-MLKPrinting.m + MLKThrowException.m NSObject-MLKPrinting.m \ + NSString-MLKPrinting.m ToiletKit_LDFLAGS = -lgmp #LIBRARIES_DEPEND_UPON diff --git a/MLKClosure.h b/MLKClosure.h index e8a20d4..8fd30d7 100644 --- a/MLKClosure.h +++ b/MLKClosure.h @@ -17,9 +17,12 @@ */ #import "MLKLispValue.h" +#import "MLKEnvironment.h" #import "MLKFuncallable.h" +#import "MLKFunction.h" -@class MLKFunction, NSArray, NSData; +#import <Foundation/NSArray.h> +#import <Foundation/NSData.h> @interface MLKClosure : MLKLispValue <MLKFuncallable> @@ -28,6 +28,7 @@ } +(MLKCons*) cons:(id)car with:(id)cdr; ++(MLKCons*) listWithArray:(NSArray *)array; -(MLKCons*) initWithCar:(id)car cdr:(id)cdr; @@ -26,7 +26,7 @@ @implementation MLKCons +(MLKCons*) cons:(id)car with:(id)cdr { - return AUTORELEASE ([[MLKCons alloc] initWithCar:car cdr:cdr]); + return AUTORELEASE ([[self alloc] initWithCar:car cdr:cdr]); } -(MLKCons*) initWithCar:(id)car cdr:(id)cdr @@ -37,6 +37,30 @@ return self; } ++(MLKCons*) listWithArray:(NSArray *)array +{ + MLKCons *cons, *tail; + int i; + + cons = nil; + tail = nil; + + for (i = 0; i < [array count]; i++) + { + id item = [array objectAtIndex:i]; + if (!tail) + { + cons = tail = [MLKCons cons:item with:nil]; + } + else + { + [tail setCdr:[MLKCons cons:item with:nil]]; + tail = [tail cdr]; + } + } + + return cons; +} -(id) car { diff --git a/MLKInterpretedClosure.h b/MLKInterpretedClosure.h new file mode 100644 index 0000000..5d1ac25 --- /dev/null +++ b/MLKInterpretedClosure.h @@ -0,0 +1,45 @@ +/* -*- 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 "MLKLexicalContext.h" +#import "MLKLexicalEnvironment.h" + +#import <Foundation/NSArray.h> +#import <Foundation/NSString.h> + + +@interface MLKInterpretedClosure : MLKLispValue <MLKFuncallable> +{ + id bodyForm; + MLKSymbol *lambdaListName; + MLKLexicalContext *context; + MLKLexicalEnvironment *environment; +} + +-(id) initWithBodyForm:(id)form + lambdaListName:(MLKSymbol *)symbol + context:(MLKLexicalContext *)lexctx + environment:(MLKLexicalEnvironment *)lexenv; + +-(NSArray *) applyToArray:(NSArray *)arguments; + +-(NSString *) description; +-(NSString *) descriptionForLisp; +@end diff --git a/MLKInterpretedClosure.m b/MLKInterpretedClosure.m new file mode 100644 index 0000000..48f1805 --- /dev/null +++ b/MLKInterpretedClosure.m @@ -0,0 +1,75 @@ +/* -*- 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 "MLKCons.h" +#import "MLKInterpretedClosure.h" +#import "MLKInterpreter.h" +#import "runtime-compatibility.h" + +#import <Foundation/NSDictionary.h> +#import <Foundation/NSSet.h> + + +@implementation MLKInterpretedClosure +-(id) initWithBodyForm:(id)form + lambdaListName:(MLKSymbol *)symbol + context:(MLKLexicalContext *)lexctx + environment:(MLKLexicalEnvironment *)lexenv +{ + self = [super init]; + ASSIGN (bodyForm, form); + ASSIGN (context, lexctx); + ASSIGN (environment, lexenv); + ASSIGN (lambdaListName, symbol); + return self; +} + +-(NSArray *) applyToArray:(NSArray *)arguments +{ + id arglist = [MLKCons listWithArray:arguments]; + + MLKLexicalEnvironment *new_environment = + [MLKLexicalEnvironment environmentWithParent:environment + variables:[NSDictionary dictionaryWithObject:arglist + forKey:lambdaListName] + functions:nil]; + + MLKLexicalContext *new_context = + [MLKLexicalContext contextWithParent:context + variables:[NSSet setWithObject:lambdaListName] + functions:nil + goTags:nil + macros:nil + symbolMacros:nil + declarations:nil]; + + return [MLKInterpreter eval:bodyForm + inLexicalContext:new_context + withEnvironment:new_environment]; +} + +-(NSString *) description +{ + return [self descriptionForLisp]; +} + +-(NSString *) descriptionForLisp +{ + return [NSString stringWithFormat:@"<Interpreted closure @%p>", self]; +} +@end diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 79b8794..01a915f 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -16,6 +16,7 @@ * along with this program. If not, see <http://www.gnu.org/licenses/>. */ +#import "MLKInterpretedClosure.h" #import "MLKCons.h" #import "MLKDynamicContext.h" #import "MLKEnvironment.h" @@ -51,6 +52,7 @@ static MLKSymbol *QUOTE; static MLKSymbol *SETQ; static MLKSymbol *PROGV; static MLKSymbol *_DEFMACRO; +static MLKSymbol *_LAMBDA; @implementation MLKInterpreter @@ -74,6 +76,7 @@ static MLKSymbol *_DEFMACRO; SETQ = [cl intern:@"SETQ"]; PROGV = [cl intern:@"PROGV"]; _DEFMACRO = [sys intern:@"%DEFMACRO"]; + _LAMBDA = [sys intern:@"%LAMBDA"]; } @@ -128,6 +131,23 @@ static MLKSymbol *_DEFMACRO; ? (id)[rest array] : (id)[NSArray array])]; } + else if (car == _DEFMACRO) + { + // No real lambda lists here. This SYS::%DEFMACRO is + // really as low-level as it gets. + id name = [[program cdr] car]; + id lambdaListAndBody = [[program cdr] cdr]; + + id <MLKFuncallable> function; + + function = [self eval:[MLKCons cons:_LAMBDA with:lambdaListAndBody] + inLexicalContext:context + withEnvironment:lexenv]; + + [context addMacro:function forSymbol:name]; + + return name; + } else if (car == EVAL) { return [self eval:[self eval:[program cdr] @@ -137,6 +157,22 @@ static MLKSymbol *_DEFMACRO; withEnvironment:[MLKLexicalEnvironment globalEnvironment]]; } + else if (car == _LAMBDA) + { + // A bare-bones LAMBDA without a real lambda list. What + // would be a lambda list in a real LAMBDA form must be a + // symbol here. + id lambdaList = [[program cdr] car]; + id body = [[[program cdr] cdr] cdr]; + MLKInterpretedClosure *closure; + + closure = AUTORELEASE ([[MLKInterpretedClosure alloc] + initWithBodyForm:body + lambdaListName:lambdaList + context:context + environment:lexenv]); + return closure; + } else if (car == LET) { id declarations; diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h index 2bf2bc4..552e77d 100644 --- a/MLKLexicalContext.h +++ b/MLKLexicalContext.h @@ -16,12 +16,13 @@ * along with this program. If not, see <http://www.gnu.org/licenses/>. */ +#import "MLKFuncallable.h" #import "MLKLispValue.h" #import <Foundation/NSSet.h> @class MLKEnvironment, MLKLexicalEnvironment, MLKSymbol, NSLinkedList, NSSet, - NSMutableDictionary, NSString, MLKCons, MLKFuncallable; + NSMutableDictionary, NSString, MLKCons; @interface MLKLexicalContext : MLKLispValue @@ -47,6 +48,14 @@ symbolMacros:(NSDictionary *)symbolMacros declarations:(id)declarations; ++(MLKLexicalContext *) contextWithParent:(MLKLexicalContext *)aContext + variables:(NSSet *)vars + functions:(NSSet *)functions + goTags:(NSDictionary *)goTags + macros:(NSDictionary *)macros + symbolMacros:(NSDictionary *)symbolMacros + declarations:(id)declarations; + +(MLKLexicalContext *) globalContext; -(BOOL) symbolNamesFunction:(MLKSymbol *)symbol; @@ -54,10 +63,11 @@ -(BOOL) symbolNamesSymbolMacro:(MLKSymbol *)symbol; -(id) macroForSymbol:(MLKSymbol *)symbol; --(void) setMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol; +-(void) setMacro:(id <MLKFuncallable>)function forSymbol:(MLKSymbol *)symbol; +-(void) addMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol; -(id) symbolMacroForSymbol:(MLKSymbol *)symbol; --(void) setSymbolMacro:(MLKFuncallable *)function forSymbol:(MLKSymbol *)symbol; +-(void) setSymbolMacro:(id <MLKFuncallable>)function forSymbol:(MLKSymbol *)symbol; -(id) goTagForSymbol:(MLKSymbol *)symbol; diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m index 85539f1..32c1bf2 100644 --- a/MLKLexicalContext.m +++ b/MLKLexicalContext.m @@ -101,6 +101,24 @@ static MLKSymbol *LEXICAL; return self; } ++(MLKLexicalContext *) contextWithParent:(MLKLexicalContext *)context + variables:(NSSet *)vars + functions:(NSSet *)functions + goTags:(NSDictionary *)goTags + macros:(NSDictionary *)macros + symbolMacros:(NSDictionary *)symbolMacros + declarations:(id)declarations +{ + return AUTORELEASE ([[self alloc] + initWithParent:context + variables:vars + functions:functions + goTags:goTags + macros:macros + symbolMacros:symbolMacros + declarations:declarations]); +} + +(MLKLexicalContext *) globalContext { return global_context; @@ -111,7 +129,12 @@ static MLKSymbol *LEXICAL; return [_macros valueForSymbol:symbol]; } --(void) setMacro:(MLKFuncallable *)value forSymbol:(MLKSymbol *)symbol +-(void) addMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol +{ + [_symbolMacros addValue:value forSymbol:symbol]; +} + +-(void) setMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol { [_symbolMacros setValue:value forSymbol:symbol]; } @@ -121,7 +144,7 @@ static MLKSymbol *LEXICAL; return [_symbolMacros valueForSymbol:symbol]; } --(void) setSymbolMacro:(MLKFuncallable *)value forSymbol:(MLKSymbol *)symbol +-(void) setSymbolMacro:(id <MLKFuncallable>)value forSymbol:(MLKSymbol *)symbol { [_symbolMacros setValue:value forSymbol:symbol]; } diff --git a/MLKLexicalEnvironment.h b/MLKLexicalEnvironment.h index b8efed3..a97d5b9 100644 --- a/MLKLexicalEnvironment.h +++ b/MLKLexicalEnvironment.h @@ -33,7 +33,11 @@ -(MLKLexicalEnvironment *) initWithParent:(MLKLexicalEnvironment *)aContext variables:(NSDictionary *)vars - functions:(NSDictionary *)handlers; + functions:(NSDictionary *)functions; + ++(MLKLexicalEnvironment *) environmentWithParent:(MLKLexicalEnvironment *)context + variables:(NSDictionary *)vars + functions:(NSDictionary *)functions; +(MLKLexicalEnvironment *) globalEnvironment; diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m index 66d5cb2..61f09c2 100644 --- a/MLKLexicalEnvironment.m +++ b/MLKLexicalEnvironment.m @@ -68,15 +68,24 @@ static MLKLexicalEnvironment *global_environment; -(MLKLexicalEnvironment *) initWithParent:(MLKLexicalEnvironment *)aContext variables:(NSDictionary *)vars - functions:(NSDictionary *)handlers + functions:(NSDictionary *)functions { self = [super init]; ASSIGN (_parent, (aContext ? aContext : global_environment)); _variables = MAKE_ENVIRONMENT(vars, _parent, _parent->_variables); - _functions = MAKE_ENVIRONMENT(handlers, _parent, _parent->_functions); + _functions = MAKE_ENVIRONMENT(functions, _parent, _parent->_functions); return self; } ++(MLKLexicalEnvironment *) environmentWithParent:(MLKLexicalEnvironment *)context + variables:(NSDictionary *)vars + functions:(NSDictionary *)functions +{ + return AUTORELEASE ([[self alloc] initWithParent:context + variables:vars + functions:functions]); +} + +(MLKLexicalEnvironment *) globalEnvironment { return global_environment; diff --git a/MLKPackage.m b/MLKPackage.m index 79e4182..4060e81 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -51,17 +51,31 @@ static NSMutableDictionary *packages = nil; [MLKPackage packageWithName:@"KEYWORD" nicknames:[NSSet set]]; - [tlUser usePackage:toilet]; [tlUser usePackage:cl]; + [tlUser usePackage:toilet]; + [clUser usePackage:cl]; - + [clUser usePackage:toilet]; + [clUser usePackage:sys]; + [cl import:nil]; [cl export:nil]; [cl export:[cl intern:@"T"]]; + [cl export:[cl intern:@"IF"]]; + [cl export:[cl intern:@"LET"]]; + [cl export:[cl intern:@"LAMBDA"]]; + [cl export:[cl intern:@"FUNCALL"]]; + [cl export:[cl intern:@"PROGN"]]; + [cl export:[cl intern:@"APPLY"]]; + [cl export:[cl intern:@"PROGV"]]; + [cl export:[cl intern:@"SETQ"]]; + [cl export:[cl intern:@"DECLARE"]]; + [cl export:[cl intern:@"QUOTE"]]; + + [sys export:[sys intern:@"%DEFMACRO"]]; + [sys export:[sys intern:@"%LAMBDA"]]; - [sys intern:@"%DEFMACRO"]; [tlUser usePackage:clUser]; - [cl export:[cl intern:@"IF"]]; } -(MLKPackage *) initWithName:(NSString *)name |