From 1560780b5fad554f12ce3964854bd474da1048f8 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 11:51:35 +0200 Subject: MLKLexicalContext: Add -functionIsInline:. --- MLKLLVMCompiler.mm | 2 +- MLKLexicalContext.h | 1 + MLKLexicalContext.m | 35 ++++++++++++++++++++++++----------- special-symbols.h | 8 ++++++++ 4 files changed, 34 insertions(+), 12 deletions(-) diff --git a/MLKLLVMCompiler.mm b/MLKLLVMCompiler.mm index 2aaa0e8..75b8770 100644 --- a/MLKLLVMCompiler.mm +++ b/MLKLLVMCompiler.mm @@ -548,7 +548,7 @@ static Constant [MLKPrintToString(_head) UTF8String]); // XXX - if (NO && [_context functionInline:_head]) + if ([_context functionIsInline:_head]) { InlineFunction (call); } diff --git a/MLKLexicalContext.h b/MLKLexicalContext.h index e350b63..0702704 100644 --- a/MLKLexicalContext.h +++ b/MLKLexicalContext.h @@ -93,6 +93,7 @@ -(void) addFunction:(MLKSymbol *)symbol; -(BOOL) variableIsLexical:(MLKSymbol *)symbol; +-(BOOL) functionIsInline:(MLKSymbol *)symbol; -(id) deepPropertyForVariable:(id)name key:(id)key; -(void) setDeepProperty:(id)object diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m index 3f820a8..a1bb8e8 100644 --- a/MLKLexicalContext.m +++ b/MLKLexicalContext.m @@ -35,6 +35,7 @@ #import "MLKSymbol.h" #import "MLKInteger.h" #import "runtime-compatibility.h" +#import "special-symbols.h" #import "util.h" #include @@ -51,18 +52,10 @@ static MLKLexicalContext *global_context; -static MLKPackage *cl; -static MLKPackage *sys; -static MLKSymbol *SPECIAL; -static MLKSymbol *LEXICAL; - - @implementation MLKLexicalContext +(void) initialize { MLKLexicalEnvironment *globalenv = [MLKLexicalEnvironment globalEnvironment]; - cl = [MLKPackage findPackage:@"COMMON-LISP"]; - sys = [MLKPackage findPackage:@"TOILET-SYSTEM"]; global_context = [[self alloc] initWithParent:nil variables:[globalenv variables] @@ -72,9 +65,8 @@ static MLKSymbol *LEXICAL; compilerMacros:nil symbolMacros:nil declarations:nil]; - - SPECIAL = [cl intern:@"SPECIAL"]; - LEXICAL = [sys intern:@"LEXICAL"]; + + ensure_symbols (); } -(MLKLexicalContext *) initWithParent:(MLKLexicalContext *)aContext @@ -299,6 +291,27 @@ static MLKSymbol *LEXICAL; else return (_parent && [_parent variableIsLexical:symbol]); } +-(BOOL) functionIsInline:(MLKSymbol *)symbol +{ + if ([_functions containsObject:symbol]) + { + id rest = _declarations; + while (rest) + { + id item = [rest car]; + if ([item isKindOfClass:[MLKCons class]] && [[item cdr] car] == symbol) + { + if ([item car] == INLINE) + return YES; + else if ([item car] == NOTINLINE) + return NO; + } + rest = [rest cdr]; + } + } + else return (_parent && [_parent functionIsInline:symbol]); +} + -(void) addVariable:(MLKSymbol *)symbol { symbol = symbol ? (id)symbol : (id)[NSNull null]; diff --git a/special-symbols.h b/special-symbols.h index d7e7351..806c758 100644 --- a/special-symbols.h +++ b/special-symbols.h @@ -58,6 +58,10 @@ static MLKSymbol *LOAD_TOPLEVEL; static MLKSymbol *LOAD; static MLKSymbol *EXECUTE; static MLKSymbol *MULTIPLE_VALUE_CALL; +static MLKSymbol *INLINE; +static MLKSymbol *NOTINLINE; +static MLKSymbol *SPECIAL; +static MLKSymbol *LEXICAL; static void @@ -99,6 +103,10 @@ ensure_symbols () _LAMBDA = [sys intern:@"%LAMBDA"]; V_INITP = [sys intern:@"*SYSTEM-INITIALISED-P*"]; MULTIPLE_VALUE_CALL = [cl intern:@"MULTIPLE-VALUE-CALL"]; + INLINE = [cl intern:@"INLINE"]; + NOTINLINE = [cl intern:@"NOTINLINE"]; + SPECIAL = [cl intern:@"INLINE"]; + LEXICAL = [sys intern:@"NOTINLINE"]; COMPILE_TOPLEVEL = [keyword intern:@"COMPILE-TOPLEVEL"]; COMPILE = [cl intern:@"COMPILE"]; -- cgit v1.2.3 From 0be08d02045b70bdb3eb8ab7f01051f4372a2d04 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 14:34:19 +0200 Subject: MLKLexicalContext: Support NIL as a variable and function name. --- MLKLexicalContext.m | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/MLKLexicalContext.m b/MLKLexicalContext.m index a1bb8e8..d5c6add 100644 --- a/MLKLexicalContext.m +++ b/MLKLexicalContext.m @@ -326,12 +326,12 @@ static MLKLexicalContext *global_context; -(id) deepPropertyForVariable:(id)name key:(id)key { - NSDictionary *props = [_variableInfo objectForKey:name]; + NSDictionary *props = [_variableInfo objectForKey:nullify(name)]; id property; if (props && (property = [props objectForKey:key])) return property; - else if (!_parent || [_variables containsObject:name]) + else if (!_parent || [_variables containsObject:nullify(name)]) return nil; else return [_parent deepPropertyForVariable:name key:key]; @@ -345,13 +345,13 @@ static MLKLexicalContext *global_context; // lexically apparent binding, the property is set in the global // context. This does not make it pervasive, however. - if (!_parent || [_variables containsObject:name]) + if (!_parent || [_variables containsObject:nullify(name)]) { - NSMutableDictionary *props = [_variableInfo objectForKey:name]; + NSMutableDictionary *props = [_variableInfo objectForKey:nullify(name)]; if (!props) { props = [NSMutableDictionary dictionary]; - [_variableInfo setObject:props forKey:name]; + [_variableInfo setObject:props forKey:nullify(name)]; } [props setObject:object forKey:key]; } @@ -363,12 +363,12 @@ static MLKLexicalContext *global_context; -(id) deepPropertyForFunction:(id)name key:(id)key { - NSDictionary *props = [_functionInfo objectForKey:name]; + NSDictionary *props = [_functionInfo objectForKey:nullify(name)]; id property; if (props && (property = [props objectForKey:key])) return property; - else if (!_parent || [_functions containsObject:name]) + else if (!_parent || [_functions containsObject:nullify(name)]) return nil; else return [_parent deepPropertyForFunction:name key:key]; @@ -378,13 +378,13 @@ static MLKLexicalContext *global_context; forFunction:(id)name key:(id)key { - if (!_parent || [_functions containsObject:name]) + if (!_parent || [_functions containsObject:nullify(name)]) { - NSMutableDictionary *props = [_functionInfo objectForKey:name]; + NSMutableDictionary *props = [_functionInfo objectForKey:nullify(name)]; if (!props) { props = [NSMutableDictionary dictionary]; - [_functionInfo setObject:props forKey:name]; + [_functionInfo setObject:props forKey:nullify(name)]; } [props setObject:object forKey:key]; } -- cgit v1.2.3 From 0b4042d8142aa62f8ef6e6fb9d1b1e5cfe922bca Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 14:36:17 +0200 Subject: MLKLexicalEnvironment: Fix value setting. --- MLKLexicalEnvironment.m | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/MLKLexicalEnvironment.m b/MLKLexicalEnvironment.m index 723c955..91ff351 100644 --- a/MLKLexicalEnvironment.m +++ b/MLKLexicalEnvironment.m @@ -125,7 +125,7 @@ static MLKLexicalEnvironment *global_environment; || [_variables environmentForSymbol:symbol] == global_environment->_variables) { id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol]; - [*cell setValue:value forSymbol:symbol]; + [*cell setValue:value]; } else { @@ -138,7 +138,7 @@ static MLKLexicalEnvironment *global_environment; if (self == global_environment) { id *cell = [[MLKLexicalContext globalContext] bindingCellForSymbol:symbol]; - [*cell setValue:value forSymbol:symbol]; + [*cell setValue:value]; } else { -- cgit v1.2.3 From f4240af04599a9b25645ecae78e5a45b46247cca Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 14:39:55 +0200 Subject: Update Xcode project. --- Toilet Lisp.xcodeproj/project.pbxproj | 375 +++++++++++++++++++++++++++++++++- configure | 5 +- 2 files changed, 374 insertions(+), 6 deletions(-) diff --git a/Toilet Lisp.xcodeproj/project.pbxproj b/Toilet Lisp.xcodeproj/project.pbxproj index 011ee8f..aba3f8c 100644 --- a/Toilet Lisp.xcodeproj/project.pbxproj +++ b/Toilet Lisp.xcodeproj/project.pbxproj @@ -9,9 +9,48 @@ /* Begin PBXBuildFile section */ A72E9E380E51CB0500BDE40F /* MLKCompiledClosure.h in Headers */ = {isa = PBXBuildFile; fileRef = A72E9E370E51CB0500BDE40F /* MLKCompiledClosure.h */; }; A72E9E3A0E51CB1300BDE40F /* MLKCompiledClosure.m in Sources */ = {isa = PBXBuildFile; fileRef = A72E9E390E51CB1300BDE40F /* MLKCompiledClosure.m */; }; - A72E9E6E0E5220B700BDE40F /* MLKLexicalContext-MLKLLVMCompilation.h in Headers */ = {isa = PBXBuildFile; fileRef = A72E9E6D0E5220B700BDE40F /* MLKLexicalContext-MLKLLVMCompilation.h */; }; A745C3590E607D5A00C43A04 /* MLKLexicalContext-MLKLLVMCompilation.mm in Sources */ = {isa = PBXBuildFile; fileRef = A72E9E6B0E5220A200BDE40F /* MLKLexicalContext-MLKLLVMCompilation.mm */; }; A745C35A0E607D6F00C43A04 /* MLKLLVMCompiler.mm in Sources */ = {isa = PBXBuildFile; fileRef = A78713810E4EFF4000A7191F /* MLKLLVMCompiler.mm */; }; + A745C4080E6189EB00C43A04 /* MLKReadEvalPrintLoop.m in Sources */ = {isa = PBXBuildFile; fileRef = A7E5C4850E21698100A01D81 /* MLKReadEvalPrintLoop.m */; }; + A745C40A0E6189EB00C43A04 /* Foundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = A7E5C55B0E21740C00A01D81 /* Foundation.framework */; }; + A745C40C0E6189EB00C43A04 /* control-flow.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834010E477B76005D64E0 /* control-flow.lisp */; }; + A745C40D0E6189EB00C43A04 /* defun-0.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834020E477B76005D64E0 /* defun-0.lisp */; }; + A745C40E0E6189EB00C43A04 /* defun-1.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834030E477B76005D64E0 /* defun-1.lisp */; }; + A745C40F0E6189EB00C43A04 /* destructuring-bind.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834040E477B76005D64E0 /* destructuring-bind.lisp */; }; + A745C4100E6189EB00C43A04 /* evaluation.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834050E477B76005D64E0 /* evaluation.lisp */; }; + A745C4110E6189EB00C43A04 /* init.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834060E477B76005D64E0 /* init.lisp */; }; + A745C4120E6189EB00C43A04 /* list-functions-2.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834070E477B76005D64E0 /* list-functions-2.lisp */; }; + A745C4130E6189EB00C43A04 /* list-functions.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834080E477B76005D64E0 /* list-functions.lisp */; }; + A745C4140E6189EB00C43A04 /* numbers.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A834090E477B76005D64E0 /* numbers.lisp */; }; + A745C4150E6189EB00C43A04 /* reader.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8340A0E477B76005D64E0 /* reader.lisp */; }; + A745C4160E6189EB00C43A04 /* sharpsign.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8340B0E477B76005D64E0 /* sharpsign.lisp */; }; + A745C4170E6189EB00C43A04 /* types.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8340C0E477B76005D64E0 /* types.lisp */; }; + A745C4180E6189EB00C43A04 /* util.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8340D0E477B76005D64E0 /* util.lisp */; }; + A745C41A0E6189EB00C43A04 /* array.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835670E477C26005D64E0 /* array.lisp */; }; + A745C41B0E6189EB00C43A04 /* character.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835680E477C26005D64E0 /* character.lisp */; }; + A745C41C0E6189EB00C43A04 /* clos.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835690E477C26005D64E0 /* clos.lisp */; }; + A745C41D0E6189EB00C43A04 /* condition.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356A0E477C26005D64E0 /* condition.lisp */; }; + A745C41E0E6189EB00C43A04 /* cons.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356B0E477C26005D64E0 /* cons.lisp */; }; + A745C41F0E6189EB00C43A04 /* core.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356C0E477C26005D64E0 /* core.lisp */; }; + A745C4200E6189EB00C43A04 /* data-and-control.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356D0E477C26005D64E0 /* data-and-control.lisp */; }; + A745C4210E6189EB00C43A04 /* do.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356E0E477C26005D64E0 /* do.lisp */; }; + A745C4220E6189EB00C43A04 /* eval.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8356F0E477C26005D64E0 /* eval.lisp */; }; + A745C4230E6189EB00C43A04 /* hash-table.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835700E477C26005D64E0 /* hash-table.lisp */; }; + A745C4240E6189EB00C43A04 /* init.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835710E477C26005D64E0 /* init.lisp */; }; + A745C4250E6189EB00C43A04 /* loop.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835720E477C26005D64E0 /* loop.lisp */; }; + A745C4260E6189EB00C43A04 /* package.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835730E477C26005D64E0 /* package.lisp */; }; + A745C4270E6189EB00C43A04 /* printer.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835740E477C26005D64E0 /* printer.lisp */; }; + A745C4280E6189EB00C43A04 /* reader.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835750E477C26005D64E0 /* reader.lisp */; }; + A745C4290E6189EB00C43A04 /* sequence.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835760E477C26005D64E0 /* sequence.lisp */; }; + A745C42A0E6189EB00C43A04 /* share-2.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835770E477C26005D64E0 /* share-2.lisp */; }; + A745C42B0E6189EB00C43A04 /* share.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835780E477C26005D64E0 /* share.lisp */; }; + A745C42C0E6189EB00C43A04 /* stand-in.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A835790E477C26005D64E0 /* stand-in.lisp */; }; + A745C42D0E6189EB00C43A04 /* stream.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8357A0E477C26005D64E0 /* stream.lisp */; }; + A745C42E0E6189EB00C43A04 /* string.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8357B0E477C26005D64E0 /* string.lisp */; }; + A745C42F0E6189EB00C43A04 /* symbol.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8357C0E477C26005D64E0 /* symbol.lisp */; }; + A745C4300E6189EB00C43A04 /* testbed.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8357D0E477C26005D64E0 /* testbed.lisp */; }; + A745C44E0E618B2C00C43A04 /* MLKLLVMCompiler.h in Headers */ = {isa = PBXBuildFile; fileRef = A78713850E4EFF5D00A7191F /* MLKLLVMCompiler.h */; }; + A745C44F0E618B2C00C43A04 /* MLKLexicalContext-MLKLLVMCompilation.h in Headers */ = {isa = PBXBuildFile; fileRef = A72E9E6D0E5220B700BDE40F /* MLKLexicalContext-MLKLLVMCompilation.h */; }; A78711320E4C459200A7191F /* globals.m in Sources */ = {isa = PBXBuildFile; fileRef = A787112E0E4C459200A7191F /* globals.m */; }; A78711330E4C459200A7191F /* MLKArray.m in Sources */ = {isa = PBXBuildFile; fileRef = A787112F0E4C459200A7191F /* MLKArray.m */; }; A78711350E4C459200A7191F /* MLKForeignProcedure.m in Sources */ = {isa = PBXBuildFile; fileRef = A78711310E4C459200A7191F /* MLKForeignProcedure.m */; }; @@ -57,7 +96,6 @@ A78712250E4C4ADE00A7191F /* testbed.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A7A8357D0E477C26005D64E0 /* testbed.lisp */; }; A78713820E4EFF4000A7191F /* MLKForm.m in Sources */ = {isa = PBXBuildFile; fileRef = A78713800E4EFF4000A7191F /* MLKForm.m */; }; A78713870E4EFF5D00A7191F /* MLKForm.h in Headers */ = {isa = PBXBuildFile; fileRef = A78713840E4EFF5D00A7191F /* MLKForm.h */; }; - A78713880E4EFF5D00A7191F /* MLKLLVMCompiler.h in Headers */ = {isa = PBXBuildFile; fileRef = A78713850E4EFF5D00A7191F /* MLKLLVMCompiler.h */; }; A78713890E4EFF5D00A7191F /* special-symbols.h in Headers */ = {isa = PBXBuildFile; fileRef = A78713860E4EFF5D00A7191F /* special-symbols.h */; }; A787138E0E4EFF8A00A7191F /* ffi.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A787138B0E4EFF8A00A7191F /* ffi.lisp */; }; A787138F0E4EFF8A00A7191F /* package.lisp in CopyFiles */ = {isa = PBXBuildFile; fileRef = A787138C0E4EFF8A00A7191F /* package.lisp */; }; @@ -190,6 +228,13 @@ remoteGlobalIDString = A745C34F0E607C6600C43A04 /* libtoilet-llvm */; remoteInfo = "libtoilet-llvm"; }; + A745C4040E6189EB00C43A04 /* PBXContainerItemProxy */ = { + isa = PBXContainerItemProxy; + containerPortal = A7E5C3CE0E21682800A01D81 /* Project object */; + proxyType = 1; + remoteGlobalIDString = A7E5C3EA0E21689F00A01D81; + remoteInfo = ToiletKit; + }; A7E5C4890E2169C600A01D81 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = A7E5C3CE0E21682800A01D81 /* Project object */; @@ -200,6 +245,60 @@ /* End PBXContainerItemProxy section */ /* Begin PBXCopyFilesBuildPhase section */ + A745C40B0E6189EB00C43A04 /* CopyFiles */ = { + isa = PBXCopyFilesBuildPhase; + buildActionMask = 2147483647; + dstPath = ""; + dstSubfolderSpec = 16; + files = ( + A745C40C0E6189EB00C43A04 /* control-flow.lisp in CopyFiles */, + A745C40D0E6189EB00C43A04 /* defun-0.lisp in CopyFiles */, + A745C40E0E6189EB00C43A04 /* defun-1.lisp in CopyFiles */, + A745C40F0E6189EB00C43A04 /* destructuring-bind.lisp in CopyFiles */, + A745C4100E6189EB00C43A04 /* evaluation.lisp in CopyFiles */, + A745C4110E6189EB00C43A04 /* init.lisp in CopyFiles */, + A745C4120E6189EB00C43A04 /* list-functions-2.lisp in CopyFiles */, + A745C4130E6189EB00C43A04 /* list-functions.lisp in CopyFiles */, + A745C4140E6189EB00C43A04 /* numbers.lisp in CopyFiles */, + A745C4150E6189EB00C43A04 /* reader.lisp in CopyFiles */, + A745C4160E6189EB00C43A04 /* sharpsign.lisp in CopyFiles */, + A745C4170E6189EB00C43A04 /* types.lisp in CopyFiles */, + A745C4180E6189EB00C43A04 /* util.lisp in CopyFiles */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; + A745C4190E6189EB00C43A04 /* CopyFiles */ = { + isa = PBXCopyFilesBuildPhase; + buildActionMask = 2147483647; + dstPath = Sacla; + dstSubfolderSpec = 16; + files = ( + A745C41A0E6189EB00C43A04 /* array.lisp in CopyFiles */, + A745C41B0E6189EB00C43A04 /* character.lisp in CopyFiles */, + A745C41C0E6189EB00C43A04 /* clos.lisp in CopyFiles */, + A745C41D0E6189EB00C43A04 /* condition.lisp in CopyFiles */, + A745C41E0E6189EB00C43A04 /* cons.lisp in CopyFiles */, + A745C41F0E6189EB00C43A04 /* core.lisp in CopyFiles */, + A745C4200E6189EB00C43A04 /* data-and-control.lisp in CopyFiles */, + A745C4210E6189EB00C43A04 /* do.lisp in CopyFiles */, + A745C4220E6189EB00C43A04 /* eval.lisp in CopyFiles */, + A745C4230E6189EB00C43A04 /* hash-table.lisp in CopyFiles */, + A745C4240E6189EB00C43A04 /* init.lisp in CopyFiles */, + A745C4250E6189EB00C43A04 /* loop.lisp in CopyFiles */, + A745C4260E6189EB00C43A04 /* package.lisp in CopyFiles */, + A745C4270E6189EB00C43A04 /* printer.lisp in CopyFiles */, + A745C4280E6189EB00C43A04 /* reader.lisp in CopyFiles */, + A745C4290E6189EB00C43A04 /* sequence.lisp in CopyFiles */, + A745C42A0E6189EB00C43A04 /* share-2.lisp in CopyFiles */, + A745C42B0E6189EB00C43A04 /* share.lisp in CopyFiles */, + A745C42C0E6189EB00C43A04 /* stand-in.lisp in CopyFiles */, + A745C42D0E6189EB00C43A04 /* stream.lisp in CopyFiles */, + A745C42E0E6189EB00C43A04 /* string.lisp in CopyFiles */, + A745C42F0E6189EB00C43A04 /* symbol.lisp in CopyFiles */, + A745C4300E6189EB00C43A04 /* testbed.lisp in CopyFiles */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; A787116F0E4C4A0200A7191F /* CopyFiles */ = { isa = PBXCopyFilesBuildPhase; buildActionMask = 2147483647; @@ -321,6 +420,8 @@ A72E9E6B0E5220A200BDE40F /* MLKLexicalContext-MLKLLVMCompilation.mm */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.cpp.objcpp; path = "MLKLexicalContext-MLKLLVMCompilation.mm"; sourceTree = ""; }; A72E9E6D0E5220B700BDE40F /* MLKLexicalContext-MLKLLVMCompilation.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = "MLKLexicalContext-MLKLLVMCompilation.h"; sourceTree = ""; }; A745C3500E607C6600C43A04 /* libtoilet-llvm.a */ = {isa = PBXFileReference; explicitFileType = archive.ar; includeInIndex = 0; path = "libtoilet-llvm.a"; sourceTree = BUILT_PRODUCTS_DIR; }; + A745C4390E6189EB00C43A04 /* toilet */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = toilet; sourceTree = BUILT_PRODUCTS_DIR; }; + A745C46D0E618D7300C43A04 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = configure; sourceTree = ""; }; A787112C0E4C456C00A7191F /* array.lisp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = array.lisp; sourceTree = ""; }; A787112E0E4C459200A7191F /* globals.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = globals.m; sourceTree = ""; }; A787112F0E4C459200A7191F /* MLKArray.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = MLKArray.m; sourceTree = ""; }; @@ -471,6 +572,14 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + A745C4090E6189EB00C43A04 /* Frameworks */ = { + isa = PBXFrameworksBuildPhase; + buildActionMask = 2147483647; + files = ( + A745C40A0E6189EB00C43A04 /* Foundation.framework in Frameworks */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; A7E5C3E90E21689F00A01D81 /* Frameworks */ = { isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; @@ -559,6 +668,7 @@ A7E5C3CC0E21682800A01D81 = { isa = PBXGroup; children = ( + A745C46D0E618D7300C43A04 /* configure */, A720D3670E5B1CB700734638 /* GNUmakefile */, A7A834A40E477B86005D64E0 /* Lisp Files */, A7E5C55B0E21740C00A01D81 /* Foundation.framework */, @@ -575,6 +685,7 @@ A7E5C3EB0E21689F00A01D81 /* ToiletKit.framework */, A7E5C3F30E21690200A01D81 /* toilet */, A745C3500E607C6600C43A04 /* libtoilet-llvm.a */, + A745C4390E6189EB00C43A04 /* toilet */, ); name = Products; sourceTree = ""; @@ -697,6 +808,8 @@ isa = PBXHeadersBuildPhase; buildActionMask = 2147483647; files = ( + A745C44E0E618B2C00C43A04 /* MLKLLVMCompiler.h in Headers */, + A745C44F0E618B2C00C43A04 /* MLKLexicalContext-MLKLLVMCompilation.h in Headers */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -750,10 +863,8 @@ A787113B0E4C45A300A7191F /* MLKArray.h in Headers */, A787113D0E4C45A300A7191F /* MLKForeignProcedure.h in Headers */, A78713870E4EFF5D00A7191F /* MLKForm.h in Headers */, - A78713880E4EFF5D00A7191F /* MLKLLVMCompiler.h in Headers */, A78713890E4EFF5D00A7191F /* special-symbols.h in Headers */, A72E9E380E51CB0500BDE40F /* MLKCompiledClosure.h in Headers */, - A72E9E6E0E5220B700BDE40F /* MLKLexicalContext-MLKLLVMCompilation.h in Headers */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -777,6 +888,25 @@ productReference = A745C3500E607C6600C43A04 /* libtoilet-llvm.a */; productType = "com.apple.product-type.library.static"; }; + A745C4020E6189EB00C43A04 /* toilet (no LLVM) */ = { + isa = PBXNativeTarget; + buildConfigurationList = A745C4310E6189EB00C43A04 /* Build configuration list for PBXNativeTarget "toilet (no LLVM)" */; + buildPhases = ( + A745C4070E6189EB00C43A04 /* Sources */, + A745C4090E6189EB00C43A04 /* Frameworks */, + A745C40B0E6189EB00C43A04 /* CopyFiles */, + A745C4190E6189EB00C43A04 /* CopyFiles */, + ); + buildRules = ( + ); + dependencies = ( + A745C4030E6189EB00C43A04 /* PBXTargetDependency */, + ); + name = "toilet (no LLVM)"; + productName = toilet; + productReference = A745C4390E6189EB00C43A04 /* toilet */; + productType = "com.apple.product-type.tool"; + }; A7E5C3EA0E21689F00A01D81 /* ToiletKit */ = { isa = PBXNativeTarget; buildConfigurationList = A7E5C3ED0E2168A000A01D81 /* Build configuration list for PBXNativeTarget "ToiletKit" */; @@ -830,6 +960,7 @@ A7E5C3EA0E21689F00A01D81 /* ToiletKit */, A7E5C3F20E21690200A01D81 /* toilet */, A745C34F0E607C6600C43A04 /* toilet-llvm */, + A745C4020E6189EB00C43A04 /* toilet (no LLVM) */, ); }; /* End PBXProject section */ @@ -844,6 +975,14 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + A745C4070E6189EB00C43A04 /* Sources */ = { + isa = PBXSourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + A745C4080E6189EB00C43A04 /* MLKReadEvalPrintLoop.m in Sources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; A7E5C3E80E21689F00A01D81 /* Sources */ = { isa = PBXSourcesBuildPhase; buildActionMask = 2147483647; @@ -909,6 +1048,11 @@ target = A745C34F0E607C6600C43A04 /* toilet-llvm */; targetProxy = A745C35B0E607DD600C43A04 /* PBXContainerItemProxy */; }; + A745C4030E6189EB00C43A04 /* PBXTargetDependency */ = { + isa = PBXTargetDependency; + target = A7E5C3EA0E21689F00A01D81 /* ToiletKit */; + targetProxy = A745C4040E6189EB00C43A04 /* PBXContainerItemProxy */; + }; A7E5C48A0E2169C600A01D81 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = A7E5C3EA0E21689F00A01D81 /* ToiletKit */; @@ -1127,6 +1271,216 @@ }; name = "Release 10.4+ (fast + GC)"; }; + A745C4320E6189EB00C43A04 /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_MODEL_TUNING = G4; + GCC_OPTIMIZATION_LEVEL = 0; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/AppKit.framework/Headers/AppKit.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = Debug; + }; + A745C4340E6189EB00C43A04 /* Debug 10.4+ (fast) */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_FAST_OBJC_DISPATCH = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_MODEL_TUNING = G4; + GCC_OPTIMIZATION_LEVEL = 0; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/AppKit.framework/Headers/AppKit.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = "Debug 10.4+ (fast)"; + }; + A745C4350E6189EB00C43A04 /* Debug 10.4+ (fast + GC) */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_ENABLE_OBJC_GC = YES; + GCC_FAST_OBJC_DISPATCH = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_MODEL_TUNING = G4; + GCC_OPTIMIZATION_LEVEL = 0; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/Foundation.framework/Headers/Foundation.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = "Debug 10.4+ (fast + GC)"; + }; + A745C4360E6189EB00C43A04 /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = ( + ppc, + ppc64, + i386, + x86_64, + ); + COPY_PHASE_STRIP = YES; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + GCC_MODEL_TUNING = G4; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/AppKit.framework/Headers/AppKit.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = Release; + }; + A745C4370E6189EB00C43A04 /* Release 10.4+ (fast) */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = ( + ppc, + ppc64, + i386, + x86_64, + ); + COPY_PHASE_STRIP = YES; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + GCC_FAST_OBJC_DISPATCH = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + GCC_MODEL_TUNING = G4; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/AppKit.framework/Headers/AppKit.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = "Release 10.4+ (fast)"; + }; + A745C4380E6189EB00C43A04 /* Release 10.4+ (fast + GC) */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = ( + ppc, + ppc64, + i386, + x86_64, + ); + COPY_PHASE_STRIP = YES; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + GCC_ENABLE_OBJC_GC = YES; + GCC_FAST_OBJC_DISPATCH = YES; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + GCC_MODEL_TUNING = G4; + GCC_PRECOMPILE_PREFIX_HEADER = YES; + GCC_PREFIX_HEADER = "$(SYSTEM_LIBRARY_DIR)/Frameworks/AppKit.framework/Headers/AppKit.h"; + GCC_WARN_ABOUT_MISSING_NEWLINE = YES; + HEADER_SEARCH_PATHS = /opt/local/include; + INSTALL_PATH = "$(HOME)/bin"; + LIBRARY_SEARCH_PATHS = /opt/local/lib; + OTHER_CFLAGS = "-DHAVE_FFI_H"; + OTHER_LDFLAGS = ( + "-framework", + Foundation, + "-lgmp", + "-ledit", + "-framework", + ToiletKit, + "-L/opt/local/lib", + "-lstdc++", + ); + PREBINDING = NO; + PRODUCT_NAME = toilet; + ZERO_LINK = NO; + }; + name = "Release 10.4+ (fast + GC)"; + }; A78711410E4C46FA00A7191F /* Debug 10.4+ (fast) */ = { isa = XCBuildConfiguration; buildSettings = { @@ -1779,6 +2133,19 @@ defaultConfigurationIsVisible = 0; defaultConfigurationName = Release; }; + A745C4310E6189EB00C43A04 /* Build configuration list for PBXNativeTarget "toilet (no LLVM)" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + A745C4320E6189EB00C43A04 /* Debug */, + A745C4340E6189EB00C43A04 /* Debug 10.4+ (fast) */, + A745C4350E6189EB00C43A04 /* Debug 10.4+ (fast + GC) */, + A745C4360E6189EB00C43A04 /* Release */, + A745C4370E6189EB00C43A04 /* Release 10.4+ (fast) */, + A745C4380E6189EB00C43A04 /* Release 10.4+ (fast + GC) */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; A7E5C3CF0E21682800A01D81 /* Build configuration list for PBXProject "Toilet Lisp" */ = { isa = XCConfigurationList; buildConfigurations = ( diff --git a/configure b/configure index 73eeebd..b037df9 100755 --- a/configure +++ b/configure @@ -169,10 +169,11 @@ if (!$installp && !@steps) { print "Congratulations! You can now build Toilet Lisp by following these steps:\n"; if ($xcode) { print " * In a shell, type:\n $XCODEBUILD"; + print ' -configuration Debug'; if ($optionalp) { - print ' -configuration "Debug (no LLVM)"' if ($optionalp); + print ' -target toilet'; } else { - print ' -configuration Debug'; + print ' -target "toilet (no LLVM)"'; } print " OTHER_CFLAGS=\""; print "`llvm-config --cflags` -DUSE_LLVM " unless ($optionalp); -- cgit v1.2.3 From 3fd292f83ef33f8052feb22eb133d37913d33c66 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 17:03:33 +0200 Subject: Refactor the interpreter so as to build upon the MLKForm class cluster. The transition is not finished yet, so lots of things are broken right now. --- MLKForeignProcedure.h | 2 +- MLKForeignProcedure.m | 4 +- MLKForm.h | 2 +- MLKForm.m | 10 +- MLKInterpreter.h | 25 +- MLKInterpreter.m | 1688 +++++++++++++++++-------------------------------- 6 files changed, 597 insertions(+), 1134 deletions(-) diff --git a/MLKForeignProcedure.h b/MLKForeignProcedure.h index c01772d..160bb7c 100644 --- a/MLKForeignProcedure.h +++ b/MLKForeignProcedure.h @@ -35,7 +35,7 @@ -(id) initWithCode:(void *)code argumentTypes:(NSArray *)argTypes - returnType:(id)returnType; + returnType:(MLKForeignType)returnType; -(NSArray *) applyToArray:(NSArray *)arguments; diff --git a/MLKForeignProcedure.m b/MLKForeignProcedure.m index 459ce97..b8dab83 100644 --- a/MLKForeignProcedure.m +++ b/MLKForeignProcedure.m @@ -36,7 +36,7 @@ @implementation MLKForeignProcedure -(id) initWithCode:(void *)code argumentTypes:(NSArray *)argTypes - returnType:(id)returnType + returnType:(MLKForeignType)returnType { int i; NSEnumerator *e; @@ -45,7 +45,7 @@ self = [super init]; _code = code; - _returnType = MLKForeignTypeWithTypeDesignator (returnType); + _returnType = returnType; _argumentTypes = malloc (sizeof (MLKForeignType) * [argTypes count]); diff --git a/MLKForm.h b/MLKForm.h index 5263dbd..a57faa3 100644 --- a/MLKForm.h +++ b/MLKForm.h @@ -146,7 +146,7 @@ @interface MLKForeignLambdaForm : MLKCompoundForm { NSString *_foreignName; - MLKSymbol *_name; + MLKSymbol *_foreignLibraryDesignator; MLKForeignType _returnType; MLKForeignType *_argumentTypes; int _argc; diff --git a/MLKForm.m b/MLKForm.m index c8a5416..16ab207 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -18,7 +18,7 @@ #import "MLKCons.h" #import "MLKForm.h" -#import "MLKLLVMCompiler.h" +#import "MLKInterpreter.h" #import "util.h" #import "special-symbols.h" @@ -361,11 +361,11 @@ int i; self = [super complete]; - LASSIGN (_foreignName, [[_tail cdr] car]); - LASSIGN (_name, [_tail car]); - _returnType = MLKForeignTypeWithTypeDesignator ([[[_tail cdr] cdr] car]); + LASSIGN (_foreignName, [_tail car]); + LASSIGN (_foreignLibraryDesignator, [[_tail cdr] car]); + _returnType = MLKForeignTypeWithTypeDesignator ([[[[_tail cdr] cdr] cdr] car]); - argtypes = [[[_tail cdr] cdr] cdr]; + argtypes = [[[_tail cdr] cdr] car]; _argc = [argtypes length]; _argumentTypes = malloc (_argc * sizeof (MLKForeignType)); diff --git a/MLKInterpreter.h b/MLKInterpreter.h index 59e2dfd..67f7377 100644 --- a/MLKInterpreter.h +++ b/MLKInterpreter.h @@ -16,9 +16,10 @@ * along with this program. If not, see . */ -#import "MLKStream.h" +#import "MLKForm.h" #import "MLKLexicalContext.h" #import "MLKLexicalEnvironment.h" +#import "MLKStream.h" #import #import @@ -43,15 +44,19 @@ enum MLKProcessingMode inLexicalContext:(MLKLexicalContext *)context withEnvironment:(MLKLexicalEnvironment *)lexenv; -+(NSArray*) eval:(id)program - inLexicalContext:(MLKLexicalContext *)context - withEnvironment:(MLKLexicalEnvironment *)lexenv - expandOnly:(BOOL)expandOnly; ++(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print; -+(NSArray*) eval:(id)program - inLexicalContext:(MLKLexicalContext *)context - withEnvironment:(MLKLexicalEnvironment *)lexenv - mode:(enum MLKProcessingMode)mode; ++(id) compile:(id)object + inContext:(MLKLexicalContext *)context; +@end -+(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print; + +@interface MLKForm (MLKInterpretation) +-(NSArray *) interpret; +-(NSArray *) interpretWithEnvironment:(MLKLexicalEnvironment *)env; +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env; +@end + +@interface MLKBodyForm (MLKInterpretation) +-(NSArray *) interpretBodyWithEnvironment:(MLKLexicalEnvironment *)env; @end diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 7fd59ad..334b33c 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -65,1126 +65,24 @@ ensure_symbols (); } - -+(NSArray*) eval:(id)program - inLexicalContext:(MLKLexicalContext *)context - withEnvironment:(MLKLexicalEnvironment *)lexenv ++(id) compile:(id)object inContext:(MLKLexicalContext *)context { - return (NSArray *)[self eval:program - inLexicalContext:context - withEnvironment:lexenv - expandOnly:NO]; + return [[self eval:object + inLexicalContext:context + withEnvironment:[MLKLexicalEnvironment globalEnvironment]] + objectAtIndex:0]; } - +(NSArray*) eval:(id)program inLexicalContext:(MLKLexicalContext *)context withEnvironment:(MLKLexicalEnvironment *)lexenv - expandOnly:(BOOL)expandOnly { - return [self eval:program - inLexicalContext:context - withEnvironment:lexenv - mode:(expandOnly ? expand_mode : eval_mode)]; -} - - -#define RETURN_VALUE(thing) \ - { return [NSArray arrayWithObject:nullify(thing)]; } - - -+(NSArray*) eval:(id)program - inLexicalContext:(MLKLexicalContext *)context - withEnvironment:(MLKLexicalEnvironment *)lexenv - mode:(enum MLKProcessingMode)mode -{ - MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext]; - BOOL expandOnly = (mode != eval_mode); - -#define TRACE_EVAL 0 -#if TRACE_EVAL - BOOL trace = NO; - - if ([dynamicContext valueForSymbol:V_INITP]) - trace = YES; - - if (trace) - NSLog (@"; EVAL: %@", MLKPrintToString(program)); -#endif // TRACE_EVAL - - if (MLKFixnumP (program)) - { - // Fixnums evaluate to themselves. - // - // We need to get this case out of the way as early as possible, - // as we're going to repeatedly send messages to `program' after - // this point. - RETURN_VALUE (program); - } - else if (!program || [program isKindOfClass:[MLKSymbol class]]) - { - if (mode == compile_time_too_mode) - { - if (![context symbolNamesSymbolMacro:program]) - { - return [self eval:program - inLexicalContext:context - withEnvironment:lexenv - mode:expand_mode]; - } - } - - //NSLog (@"Processing symbol."); - if ([context symbolNamesSymbolMacro:program]) - { - id macrofun, expansion; - - macrofun = [context macroForSymbol:program]; - expansion = [macrofun applyToArray: - [NSArray arrayWithObjects: - program, context, nil]]; - - return [self eval:expansion - inLexicalContext:context - withEnvironment:lexenv - mode:mode]; - } - else if ([context variableIsLexical:program]) - { - //NSLog (@"Processing lexical variable %@.", MLKPrintToString(program)); - //NSLog (@"Lexical environment: %@.", lexenv); - //NSLog (@"Lexical variable value: %@.", [lexenv valueForSymbol:program]); - if (expandOnly) - RETURN_VALUE (program); - - RETURN_VALUE ([lexenv valueForSymbol:program]); - } - else - { - //NSLog (@"Processing special variable %@.", MLKPrintToString(program)); - //NSLog (@"Dynamic context: %@.", dynamicContext); - //NSLog (@"Special variable value: %@.", [dynamicContext valueForSymbol:program]); - if (expandOnly) - RETURN_VALUE (program); - - RETURN_VALUE ([dynamicContext valueForSymbol:program]); - } - } - else if (![program isKindOfClass:[MLKCons class]]) - { - // Everything that is not a list or a symbol evaluates to itself. - RETURN_VALUE (program); - } - else - { - id car = [program car]; - - if ([car isKindOfClass:[MLKSymbol class]] || !car) - { - if (mode == compile_time_too_mode) - { - if (!([context symbolNamesMacro:program] - || car == _MACROLET || car == LOCALLY - || car == SYMBOL_MACROLET || car == PROGN)) - { - return [self eval:program - inLexicalContext:context - withEnvironment:lexenv - mode:expand_mode]; - } - } - - if (car == CATCH) - { - id catchTag; - NSArray *values; - MLKDynamicContext *newctx; - - catchTag = [[self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - - NS_DURING - { - if (!expandOnly) - { - newctx = [[MLKDynamicContext alloc] - initWithParent:dynamicContext - variables:nil - handlers:nil - restarts:nil - catchTags:[NSSet setWithObject:catchTag] - activeHandlerEnvironment:nil]; - [newctx pushContext]; - } - - values = [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - - if (expandOnly) - NS_VALUERETURN ([NSArray arrayWithObject: - [MLKCons - cons:CATCH - with:[MLKCons - cons:catchTag - with:[[values - objectAtIndex:0] - cdr]]]], - NSArray *); - - [MLKDynamicContext popContext]; - LRELEASE (newctx); - - NS_VALUERETURN (values, NSArray *); - } - NS_HANDLER - { - [MLKDynamicContext popContext]; - LRELEASE (newctx); - - if ([[localException name] isEqualToString:@"MLKThrow"]) - { - id thrownTag = [[localException userInfo] - objectForKey:@"THROWN TAG"]; - - if (thrownTag == catchTag) - return [[localException userInfo] - objectForKey:@"THROWN OBJECTS"]; - else - [localException raise]; - } - else - [localException raise]; - } - NS_ENDHANDLER; - - return nil; - } - else if (car == EVAL) - { - NSArray *evaluand = denullify([[self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - - if (expandOnly) - RETURN_VALUE ([MLKCons cons:EVAL with:[MLKCons cons:evaluand with:nil]]); - - return [self eval:evaluand - inLexicalContext:[MLKLexicalContext globalContext] - withEnvironment:[MLKLexicalEnvironment - globalEnvironment]]; - } - else if (car == EVAL_WHEN) - { - id situationList = [[program cdr] car]; - id body = [[program cdr] cdr]; - NSArray *situations; - BOOL ct, lt, e; - - if (!situationList) - RETURN_VALUE (nil); - - situations = [situationList array]; - ct = ([situations containsObject:COMPILE_TOPLEVEL] - || [situations containsObject:COMPILE]); - lt = ([situations containsObject:LOAD_TOPLEVEL] - || [situations containsObject:LOAD]); - e = ([situations containsObject:EXECUTE] - || [situations containsObject:EVAL]); - - switch (mode) - { - case eval_mode: - case expand_mode: - if (e) - return [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:context - withEnvironment:lexenv - mode:mode]; - else - RETURN_VALUE (nil); - - case compile_time_too_mode: - case not_compile_time_mode: - if ((ct && lt) - || (lt && e && (mode == compile_time_too_mode))) - { - return [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:context - withEnvironment:lexenv - mode:compile_time_too_mode]; - } - else if (lt) - { - return [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:context - withEnvironment:lexenv - mode:not_compile_time_mode]; - } - else if (ct || (e && mode == compile_time_too_mode)) - { - [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:context - withEnvironment:lexenv]; - RETURN_VALUE (nil); - } - else - { - RETURN_VALUE (nil); - } - } - } - else if (car == _FOREIGN_LAMBDA) - { - int (*function)(); - NSString *name = [[program cdr] car]; - id libraryDesignator = [[[program cdr] cdr] car]; - id argtypes = [[[[program cdr] cdr] cdr] car]; - id returnType = [[[[[program cdr] cdr] cdr] cdr] car]; - - // FIXME: Support library designators. - -#ifdef _WIN32 - // FIXME - //EnumProcessModules (...); - //GetProcAddress (..., [name UTF8String]); -#else - function = dlsym (RTLD_DEFAULT, [name UTF8String]); -#endif - - RETURN_VALUE (LAUTORELEASE ([[MLKForeignProcedure alloc] - initWithCode:function - argumentTypes:[argtypes array] - returnType:returnType])); - } - else if (car == FUNCTION) - { - id functionName = [[program cdr] car]; - - if ([functionName isKindOfClass:[MLKCons class]] - && ([functionName car] == LAMBDA - || [functionName car] == _LAMBDA)) - { - return [self eval:functionName - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - } - else if (expandOnly) - { - RETURN_VALUE (program); - } - else - { - // FIXME: Function names need not be symbols. - id function = - [lexenv functionForSymbol:functionName]; - RETURN_VALUE (function); - } - } - else if (car == IF) - { - id condition = [[program cdr] car]; - id consequent = [[[program cdr] cdr] car]; - // Incidentally works for the two-clause case: - id alternative = [[[[program cdr] cdr] cdr] car]; - - id condition_value = denullify([[self eval:condition - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - - if (expandOnly) - { - id conseq_expansion = denullify([[self eval:consequent - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - id alt_expansion = denullify([[self eval:alternative - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - RETURN_VALUE ([MLKCons - cons:IF - with:[MLKCons - cons:condition_value - with:[MLKCons - cons:conseq_expansion - with:[MLKCons cons:alt_expansion - with:nil]]]]); - } - - if (!condition_value) - return [self eval:alternative - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - else - return [self eval:consequent - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - } - else if (car == IN_PACKAGE) - { - if (expandOnly) - RETURN_VALUE (program); - - id cadr = [[program cdr] car]; - id package = [MLKPackage findPackage:stringify(cadr)]; - - [[MLKDynamicContext currentContext] - setValue:package - forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"] - intern:@"*PACKAGE*"]]; - - RETURN_VALUE (package); - } - 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]; - MLKInterpretedClosure *closure; - - if (expandOnly) - { - id body_expansion = denullify([[self eval:[MLKCons cons:PROGN - with:body] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - RETURN_VALUE ([MLKCons - cons:_LAMBDA - with:[MLKCons cons:lambdaList - with:[MLKCons cons:body_expansion - with:nil]]]); - } - - closure = LAUTORELEASE ([[MLKInterpretedClosure alloc] - initWithBodyForms:body - lambdaListName:lambdaList - context:context - environment:lexenv]); - return [NSArray arrayWithObject:nullify(closure)]; - } - else if (car == _MACROLET) - { - id declarations, doc; - id clauses; - id body; - NSArray *result; - MLKLexicalContext *ctx; - - MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body, - [[program cdr] cdr], NO); - ctx = LAUTORELEASE ([[MLKLexicalContext alloc] - initWithParent:context - variables:nil - functions:nil - goTags:nil - macros:nil - compilerMacros:nil - symbolMacros:nil - declarations:declarations]); - - clauses = [[program cdr] car]; - while (clauses) - { - id clause = [clauses car]; - id name, value; - - name = [clause car]; - value = denullify([[self eval:[MLKCons cons:_LAMBDA - with:[clause cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:NO] //! - objectAtIndex:0]); - - [ctx addMacro:value forSymbol:name]; - - clauses = [clauses cdr]; - } - - result = [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:ctx - withEnvironment:lexenv - mode:mode]; - - if (expandOnly) - { - RETURN_VALUE ([MLKCons - cons:LET - with:[MLKCons - cons:nil - with:[MLKCons - cons:[MLKCons cons:DECLARE - with:declarations] - with:[[result objectAtIndex:0] cdr]]]]); - } - else - { - return result; - } - } - else if (car == _FLET) - { - id declarations, doc; - id clauses; - NSMutableArray *new_clauses; - id body; - NSArray *result; - MLKLexicalContext *ctx; - MLKLexicalEnvironment *env; - - MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body, - [[program cdr] cdr], NO); - - ctx = LAUTORELEASE ([[MLKLexicalContext alloc] - initWithParent:context - variables:nil - functions:nil - goTags:nil - macros:nil - compilerMacros:nil - symbolMacros:nil - declarations:declarations]); - - if (!expandOnly) - env = LAUTORELEASE ([[MLKLexicalEnvironment alloc] - initWithParent:lexenv - variables:nil - functions:nil]); - - clauses = [[program cdr] car]; - new_clauses = [NSMutableArray array]; - while (clauses) - { - id clause = [clauses car]; - id name, value; - - name = [clause car]; - - value = denullify([[self eval:[MLKCons cons:_LAMBDA - with:[clause cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - - [ctx addFunction:name]; - - if (!expandOnly) - [env addFunction:value forSymbol:name]; - else - [new_clauses addObject:[MLKCons cons:name with:[value cdr]]]; - - clauses = [clauses cdr]; - } - - result = [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:ctx - withEnvironment:(expandOnly ? lexenv : env) - expandOnly:expandOnly]; - - if (expandOnly) - { - RETURN_VALUE ([MLKCons - cons:_FLET - with:[MLKCons - cons:[MLKCons listWithArray:new_clauses] - with:[MLKCons - cons:[MLKCons cons:DECLARE - with:declarations] - with:[[result objectAtIndex:0] cdr]]]]); - } - else - { - return result; - } - } - else if (car == LET) - { - id declarations, doc; - id clauses; - id body; - NSArray *result; - NSMutableArray *new_clauses; - MLKLexicalContext *ctx; - MLKLexicalEnvironment *env; - MLKDynamicContext *dynctx; - - MLKSplitDeclarationsDocAndForms (&declarations, &doc, &body, - [[program cdr] cdr], NO); - - ctx = LAUTORELEASE ([[MLKLexicalContext alloc] - initWithParent:context - variables:nil - functions:nil - goTags:nil - macros:nil - compilerMacros:nil - symbolMacros:nil - declarations:declarations]); - - if (!expandOnly) - { - env = LAUTORELEASE ([[MLKLexicalEnvironment alloc] - initWithParent:lexenv - variables:nil - functions:nil]); - - dynctx = [[MLKDynamicContext alloc] - initWithParent:dynamicContext - variables:nil - handlers:nil - restarts:nil - catchTags:nil - activeHandlerEnvironment:nil]; - } - - clauses = [[program cdr] car]; - new_clauses = [NSMutableArray array]; - while (clauses) - { - id clause = [clauses car]; - id variable, value; - - if (!clause || [clause isKindOfClass:[MLKSymbol class]]) - { - variable = clause; - value = nil; - } - else if ([clause cdr] == nil) - { - variable = [clause car]; - value = nil; - } - else - { - variable = [clause car]; - value = denullify([[self eval:[[clause cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - } - - if (expandOnly) - { - [new_clauses addObject:[MLKCons cons:variable - with:[MLKCons cons:value - with:nil]]]; - } - else - { - [ctx addVariable:variable]; - if ([ctx variableIsLexical:variable]) - { - [env addValue:value forSymbol:variable]; - } - else - { - [dynctx addValue:value forSymbol:variable]; - } - } - - clauses = [clauses cdr]; - } - - if (expandOnly) - { - result = [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:ctx - withEnvironment:lexenv - expandOnly:YES]; - - RETURN_VALUE ([MLKCons - cons:LET - with:[MLKCons - cons:[MLKCons listWithArray:new_clauses] - with:[MLKCons - cons:[MLKCons cons:DECLARE - with:declarations] - with:[[result objectAtIndex:0] cdr]]]]); - } - else - { - [dynctx pushContext]; - - NS_DURING - { - result = [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:ctx - withEnvironment:env - expandOnly:NO]; - } - NS_HANDLER - { - [MLKDynamicContext popContext]; - [localException raise]; - } - NS_ENDHANDLER; - - [MLKDynamicContext popContext]; - LRELEASE (dynctx); - - return result; - } - } - else if (car == _LOOP) - { - id rest; - - if (expandOnly) - { - RETURN_VALUE ([MLKCons cons:_LOOP - with:[[[self eval:[MLKCons cons:PROGN - with:[program cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:YES] - objectAtIndex:0] - cdr]]); - } - - while (YES) - { - rest = program; - while ((rest = [rest cdr])) - { - [self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - } - } - - RETURN_VALUE (nil); // never reached - } - else if (car == MULTIPLE_VALUE_CALL) - { - NSMutableArray *results = [NSMutableArray array]; - id rest = [program cdr]; - id function = [[self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - mode:mode] - objectAtIndex:0]; - - while ((rest = [rest cdr])) - { - id values = [self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - mode:mode]; - [results addObjectsFromArray:values]; - } - - if (expandOnly) - { - RETURN_VALUE ([MLKCons - cons:MULTIPLE_VALUE_CALL - with:[MLKCons - cons:function - with:[MLKCons - listWithArray:results]]]); - } - else - { - return [function applyToArray:results]; - } - } - else if (car == PROGN) - { - id result = nil; - id rest = program; - NSMutableArray *results = [NSMutableArray array]; - while ((rest = [rest cdr])) - { - result = [self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - mode:mode]; - if (expandOnly) - [results addObjectsFromArray:result]; - } - - if (expandOnly) - { - RETURN_VALUE ([MLKCons cons:PROGN - with:[MLKCons listWithArray:results]]); - } - else - return result; - } - else if (car == PROGV) - { - id variables, values, body, result; - MLKDynamicContext *dynctx; - - if (expandOnly) - { - RETURN_VALUE ([MLKCons - cons:PROGV - with:[denullify([[self eval:[MLKCons - cons:PROGN - with:[program cdr]] - inLexicalContext:context - withEnvironment:lexenv - mode:mode] - objectAtIndex:0]) cdr]]); - } - - dynctx = [[MLKDynamicContext alloc] - initWithParent:dynamicContext - variables:nil - handlers:nil - restarts:nil - catchTags:nil - activeHandlerEnvironment:nil]; - - body = [[[program cdr] cdr] cdr]; - variables = denullify ([[self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv] - objectAtIndex:0]); - values = denullify ([[self eval:[[[program cdr] cdr] car] - inLexicalContext:context - withEnvironment:lexenv] - objectAtIndex:0]); - - for (; variables; (variables = [variables cdr], values = [values cdr])) - { - id var = [variables car]; - id value = [values car]; - - [dynctx addValue:value forSymbol:var]; - } - - [dynctx pushContext]; - - NS_DURING - { - result = [self eval:[MLKCons cons:PROGN with:body] - inLexicalContext:context - withEnvironment:lexenv]; - } - NS_HANDLER - { - [MLKDynamicContext popContext]; - [localException raise]; - } - NS_ENDHANDLER; - - [MLKDynamicContext popContext]; - LRELEASE (dynctx); - - return result; - } - else if (car == QUOTE) - { - if (expandOnly) - RETURN_VALUE (program); - RETURN_VALUE ([[program cdr] car]); - } - else if (car == SETQ || car == _FSETQ) - { - id symbol = [[program cdr] car]; - id value = [[self eval:[[[program cdr] cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - id rest = [[[program cdr] cdr] cdr]; - - if (![program cdr]) - RETURN_VALUE (nil); - - if (car == SETQ && [context symbolNamesSymbolMacro:symbol]) - { - id macrofun = [context symbolMacroForSymbol:symbol]; - id expansion = [macrofun applyToArray: - [NSArray arrayWithObjects: - program, context, nil]]; - return [self eval: - [MLKCons cons:SETF - with: - [MLKCons cons:expansion - with: - [[program cdr] cdr]]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - } - - if (expandOnly) - { - id thisSETQ = [MLKCons - cons:car - with:[MLKCons - cons:symbol - with:[MLKCons - cons:value - with:nil]]]; - id more = denullify([[self eval:[MLKCons cons:car with:rest] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]); - - if (!more) - { - RETURN_VALUE (thisSETQ); - } - else - { - RETURN_VALUE ([MLKCons cons:PROGN - with:[MLKCons - cons:thisSETQ - with:[MLKCons - cons:more - with:nil]]]); - - } - } - - if (car == _FSETQ) - { - if ([context symbolNamesFunction:symbol]) - { - [lexenv setFunction:value forSymbol:symbol]; - } - else - { - // FIXME: Maybe print a warning. - [[MLKLexicalContext globalContext] addFunction:symbol]; - [[MLKLexicalEnvironment globalEnvironment] - addFunction:value - forSymbol:symbol]; - } - } - else if ([context variableIsLexical:symbol]) - [lexenv setValue:value forSymbol:symbol]; - else if ([dynamicContext bindingForSymbol:symbol]) - [dynamicContext setValue:value forSymbol:symbol]; - else - // FIXME: Maybe print a warning. - [[MLKDynamicContext globalContext] addValue:value - forSymbol:symbol]; - - - if (rest) - return [self eval:[MLKCons cons:car with:rest] - inLexicalContext:context - withEnvironment:lexenv]; - else - RETURN_VALUE (value); - } - else if (car == THROW) - { - id catchTag; - NSArray *values; - NSDictionary *userInfo; - - catchTag = [[self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - - values = [self eval:[[[program cdr] cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - - if (expandOnly) - RETURN_VALUE ([MLKCons cons:THROW - with:[MLKCons cons:denullify(catchTag) - with:[MLKCons cons:denullify([values objectAtIndex:0]) - with:nil]]]); - - userInfo = [NSDictionary dictionaryWithObjectsAndKeys: - catchTag, @"THROWN TAG", - values, @"THROWN OBJECTS", nil]; - - if ([dynamicContext catchTagIsEstablished:denullify (catchTag)]) - [[NSException exceptionWithName:@"MLKThrow" - reason:[NSString stringWithFormat: - @"THROW: tag %@, values %@.", - MLKPrintToString(catchTag), - MLKPrintToString(values)] - userInfo:userInfo] raise]; - else - // FIXME: This should really be a condition rather than - // an exception. See CLHS THROW. - [[NSException exceptionWithName:@"MLKControlError" - reason:[NSString stringWithFormat: - @"THROW without a corresponding CATCH: tag %@, values %@.", - MLKPrintToString(catchTag), - MLKPrintToString(values)] - userInfo:userInfo] raise]; - - return nil; - } - else if (car == UNWIND_PROTECT) - { - NSArray *results; - - if (expandOnly) - { - id protectee = [self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - id protection = [self eval:[MLKCons cons:PROGN - with:[[program cdr] cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - RETURN_VALUE ([MLKCons cons:UNWIND_PROTECT - with:[MLKCons cons:protectee - with:[MLKCons cons:protection - with:nil]]]); - } - - NS_DURING - { - results = [self eval:[[program cdr] car] - inLexicalContext:context - withEnvironment:lexenv]; - } - NS_HANDLER - { - [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - - [localException raise]; - } - NS_ENDHANDLER; - - [self eval:[MLKCons cons:PROGN with:[[program cdr] cdr]] - inLexicalContext:context - withEnvironment:lexenv]; - - return results; - } - else - { - if ([context symbolNamesFunction:car]) - { - id function; - MLKCons *rest = [program cdr]; - NSMutableArray *args = [NSMutableArray array]; - - while (rest) - { - id result = [[self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - [args addObject:result]; - rest = [rest cdr]; - } - - if (expandOnly) - { - RETURN_VALUE ([MLKCons cons:[program car] - with:[MLKCons listWithArray:args]]); - } - else - { - function = [lexenv functionForSymbol:car]; - return [function applyToArray:args]; - } - } - else if ([context symbolNamesMacro:car]) - { - id macrofun = [context macroForSymbol:car]; - id expansion = denullify([[macrofun - applyToArray: - [NSArray arrayWithObjects: - program, context, nil]] - objectAtIndex:0]); - - return [self eval:expansion - inLexicalContext:context - withEnvironment:lexenv - mode:mode]; - } - else - { - NSMutableArray *args = [NSMutableArray array]; - MLKCons *rest = [program cdr]; - NSArray *results; - - while (rest) - { - id result = [[self eval:[rest car] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly] - objectAtIndex:0]; - [args addObject:result]; - rest = [rest cdr]; - } - - if (expandOnly) - { - RETURN_VALUE ([MLKCons cons:[program car] - with:[MLKCons listWithArray:args]]); - } - - results = [MLKRoot dispatch:car withArguments:args]; - - if (results) - { - return results; - } - else - { - [NSException raise:@"MLKNoSuchOperatorException" - format:@"%@ does not name a known operator.", - MLKPrintToString(car)]; - return nil; - } - } - } - } - else if ([car isKindOfClass:[MLKCons class]] && [car car] == LAMBDA) - { - return [self eval:[MLKCons cons:FUNCALL with:program] - inLexicalContext:context - withEnvironment:lexenv - expandOnly:expandOnly]; - } - else - { - [NSException raise:@"MLKInvalidExpressionException" - format:@"%@ is not a valid operator name.", - MLKPrintToString(car)]; - return nil; - } - } + id form = [MLKForm formWithObject:program + inContext:context + forCompiler:self]; + return [form interpretWithEnvironment:lexenv]; } - +(BOOL) load:(MLKStream *)stream verbose:(BOOL)verbose print:(BOOL)print { id eofValue = [[NSObject alloc] init]; @@ -1243,8 +141,7 @@ inLexicalContext:[MLKLexicalContext globalContext] withEnvironment:[MLKLexicalEnvironment - globalEnvironment] - mode:not_compile_time_mode] + globalEnvironment]] objectAtIndex:0]); if ([code isKindOfClass:[MLKCons class]] && [code cdr]) @@ -1258,8 +155,7 @@ result = [MLKInterpreter eval:expansion inLexicalContext:[MLKLexicalContext globalContext] - withEnvironment:[MLKLexicalEnvironment globalEnvironment] - expandOnly:NO]; + withEnvironment:[MLKLexicalEnvironment globalEnvironment]]; //NSLog (@"; LOAD: Top-level form evaluated."); } @@ -1276,3 +172,565 @@ return YES; } @end + + +#define RETURN_VALUE(thing) \ +{ return [NSArray arrayWithObject:nullify(thing)]; } + + +@implementation MLKForm (MLKInterpretation) +-(NSArray *) interpret +{ + return [self interpretWithEnvironment:[MLKLexicalEnvironment globalEnvironment]]; +} + + +-(NSArray *) interpretWithEnvironment:(MLKLexicalEnvironment *)env +{ +#define TRACE_EVAL 0 +#if TRACE_EVAL + BOOL trace = NO; + + if ([dynamicContext valueForSymbol:V_INITP]) + trace = YES; + + if (trace) + NSLog (@"; EVAL: %@", MLKPrintToString(program)); +#endif // TRACE_EVAL + + return [self reallyInterpretWithEnvironment:env]; +} + + +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + NSLog (@"WARNING: Unrecognised form type: %@", self); + return [NSArray array]; +} +@end + + +@implementation MLKSelfEvaluatingForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + RETURN_VALUE (_form); +} +@end + + +@implementation MLKSymbolForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + if ([_context symbolNamesSymbolMacro:_form]) + { + id macrofun, expansion; + + macrofun = [_context macroForSymbol:_form]; + expansion = [macrofun applyToArray: + [NSArray arrayWithObjects: + _form, _context, nil]]; + + return [expansion interpretWithEnvironment:env]; + } + else if ([_context variableIsLexical:_form]) + { + RETURN_VALUE ([env valueForSymbol:_form]); + } + else + { + RETURN_VALUE ([[MLKDynamicContext currentContext] valueForSymbol:_form]); + } +} +@end + + +@implementation MLKCatchForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id catchTag; + NSArray *values; + MLKDynamicContext *newctx; + + catchTag = [[_tagForm interpretWithEnvironment:env] objectAtIndex:0]; + + NS_DURING + { + newctx = [[MLKDynamicContext alloc] initWithParent:[MLKDynamicContext currentContext] + variables:nil + handlers:nil + restarts:nil + catchTags:[NSSet setWithObject:catchTag] + activeHandlerEnvironment:nil]; + [newctx pushContext]; + + values = [self interpretBodyWithEnvironment:env]; + + [MLKDynamicContext popContext]; + LRELEASE (newctx); + + NS_VALUERETURN (values, NSArray *); + } + NS_HANDLER + { + [MLKDynamicContext popContext]; + LRELEASE (newctx); + + if ([[localException name] isEqualToString:@"MLKThrow"]) + { + id thrownTag = [[localException userInfo] + objectForKey:@"THROWN TAG"]; + + if (thrownTag == catchTag) + return [[localException userInfo] + objectForKey:@"THROWN OBJECTS"]; + else + [localException raise]; + } + else + [localException raise]; + } + NS_ENDHANDLER; + + return nil; +} +@end + + +@implementation MLKForeignLambdaForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + // FIXME: Support library designators. + + int (*function)(); + +#ifdef _WIN32 + // FIXME + //EnumProcessModules (...); + //GetProcAddress (..., [_foreignName UTF8String]); +#else + function = dlsym (RTLD_DEFAULT, [_foreignName UTF8String]); +#endif + + NSMutableArray *argtypes = [NSMutableArray array]; + int i; + for (i = 0; i++; i < _argc) + [argtypes addObject:[NSNumber numberWithInt:_argumentTypes[i]]]; + + RETURN_VALUE (LAUTORELEASE ([[MLKForeignProcedure alloc] + initWithCode:function + argumentTypes:argtypes + returnType:_returnType])); +} +@end + + +@implementation MLKLambdaFunctionForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + return [_lambdaForm interpretWithEnvironment:env]; +} +@end + + +@implementation MLKSimpleFunctionForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + RETURN_VALUE ([env functionForSymbol:_functionName]); +} +@end + + +@implementation MLKIfForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id cndval = [[_conditionForm interpretWithEnvironment:env] objectAtIndex:0]; + if (cndval) + return [_consequentForm interpretWithEnvironment:env]; + else + return [_alternativeForm interpretWithEnvironment:env]; +} +@end + + +@implementation MLKInPackageForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id package = [MLKPackage findPackage:stringify(_packageDesignator)]; + + [[MLKDynamicContext currentContext] + setValue:package + forSymbol:[[MLKPackage findPackage:@"COMMON-LISP"] + intern:@"*PACKAGE*"]]; + + RETURN_VALUE (package); +} +@end + + +@implementation MLKLambdaForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id lambdaList = [_tail car]; + id body = [_tail cdr]; + id closure = LAUTORELEASE ([[MLKInterpretedClosure alloc] + initWithBodyForms:_body + lambdaListName:lambdaList + context:_context + environment:env]); + RETURN_VALUE (closure); +} +@end + + +@implementation MLKSimpleFletForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + MLKLexicalEnvironment *newenv = [MLKLexicalEnvironment environmentWithParent:env + variables:nil + functions:nil]; + + for (i = 0; i < [_functionBindingForms count]; i++) + { + [[_functionBindingForms objectAtIndex:i] interpretWithEnvironment:newenv]; + } + + return [self interpretBodyWithEnvironment:newenv]; +} +@end + + +@implementation MLKSimpleFunctionBindingForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id value = [_compiler compile:[MLKCons cons:_LAMBDA with:_tail] + inContext:_context]; + [env addFunction:value forSymbol:_name]; + return nil; +} +@end + + +@implementation MLKLetForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + NSArray *values; + MLKLexicalEnvironment *newenv; + MLKDynamicContext *dynctx; + + newenv = [MLKLexicalEnvironment environmentWithParent:env + variables:nil + functions:nil]; + dynctx = [[MLKDynamicContext alloc] initWithParent:[MLKDynamicContext currentContext] + variables:nil + handlers:nil + restarts:nil + catchTags:nil + activeHandlerEnvironment:nil]; + + for (i = 0; i < [_variableBindingForms count]; i++) + { + id variable = [[_variableBindingForms objectAtIndex:i] name]; + id value = [[[_variableBindingForms objectAtIndex:i] + interpretWithEnvironment:env] + objectAtIndex:0]; + if ([_context variableIsLexical:variable]) + { + [newenv addValue:value forSymbol:variable]; + } + else + { + [dynctx addValue:value forSymbol:variable]; + } + } + + [dynctx pushContext]; + + NS_DURING + { + values = [self interpretBodyWithEnvironment:newenv]; + } + NS_HANDLER + { + [MLKDynamicContext popContext]; + LRELEASE (dynctx); + [localException raise]; + } + NS_ENDHANDLER; + + [MLKDynamicContext popContext]; + LRELEASE (dynctx); + + return values; +} +@end + + +@implementation MLKSimpleLoopForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + while (YES) + { + [self interpretBodyWithEnvironment:env]; + } + + RETURN_VALUE (nil); // never reached +} +@end + + +@implementation MLKMultipleValueCallForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + NSMutableArray *results = [NSMutableArray array]; + int i; + id function = [[_functionForm interpretWithEnvironment:env] objectAtIndex:0]; + + for (i = 0; i < [_bodyForms count]; i++) + { + NSArray *values = [[_bodyForms objectAtIndex:i] interpretWithEnvironment:env]; + [results addObjectsFromArray:values]; + } + + return [function applyToArray:results]; +} +@end + + +@implementation MLKProgNForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + return [self interpretBodyWithEnvironment:env]; +} +@end + + +@implementation MLKBodyForm (MLKInterpretation) +-(NSArray *) interpretBodyWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + NSArray *values = nil; + + for (i = 0; i < [_bodyForms count]; i++) + { + values = [[_bodyForms objectAtIndex:i] interpretWithEnvironment:env]; + } + + return values; +} +@end + + +@implementation MLKProgVForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id variables = [[_variableListForm interpretWithEnvironment:env] + objectAtIndex:0]; + id values = [[_valueListForm interpretWithEnvironment:env] + objectAtIndex:0]; + MLKDynamicContext *dynctx; + id result; + + dynctx = [[MLKDynamicContext alloc] + initWithParent:[MLKDynamicContext currentContext] + variables:nil + handlers:nil + restarts:nil + catchTags:nil + activeHandlerEnvironment:nil]; + + for (; variables; (variables = [variables cdr], values = [values cdr])) + { + id var = [variables car]; + id value = [values car]; + + [dynctx addValue:value forSymbol:var]; + } + + [dynctx pushContext]; + + NS_DURING + { + result = [self interpretBodyWithEnvironment:env]; + } + NS_HANDLER + { + [MLKDynamicContext popContext]; + LRELEASE (dynctx); + [localException raise]; + } + NS_ENDHANDLER; + + [MLKDynamicContext popContext]; + LRELEASE (dynctx); + + return result; +} +@end + + +@implementation MLKQuoteForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + return _quotedData; +} +@end + + +@implementation MLKThrowForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + id catchTag; + NSArray *values; + NSDictionary *userInfo; + + catchTag = [[_tagForm interpretWithEnvironment:env] objectAtIndex:0]; + values = [_valueForm interpretWithEnvironment:env]; + + userInfo = [NSDictionary dictionaryWithObjectsAndKeys: + catchTag, @"THROWN TAG", + values, @"THROWN OBJECTS", nil]; + + if ([[MLKDynamicContext currentContext] catchTagIsEstablished:denullify (catchTag)]) + [[NSException exceptionWithName:@"MLKThrow" + reason:[NSString stringWithFormat: + @"THROW: tag %@, values %@.", + MLKPrintToString(catchTag), + MLKPrintToString(values)] + userInfo:userInfo] raise]; + else + // FIXME: This should really be a condition rather than + // an exception. See CLHS THROW. + [[NSException exceptionWithName:@"MLKControlError" + reason:[NSString stringWithFormat: + @"THROW without a corresponding CATCH: tag %@, values %@.", + MLKPrintToString(catchTag), + MLKPrintToString(values)] + userInfo:userInfo] raise]; + + return nil; +} +@end + + +@implementation MLKUnwindProtectForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + NSArray *results; + + NS_DURING + { + results = [_protectedForm interpretWithEnvironment:env]; + } + NS_HANDLER + { + [self interpretBodyWithEnvironment:env]; + [localException raise]; + } + NS_ENDHANDLER; + + [self interpretBodyWithEnvironment:env]; + + return results; +} +@end + + +@implementation MLKFunctionCallForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + NSArray *results = nil; + NSMutableArray *args = [NSMutableArray array]; + + for (i = 0; i < [_argumentForms count]; i++) + { + id result = [[[_argumentForms objectAtIndex:i] + interpretWithEnvironment:env] + objectAtIndex:0]; + [args addObject:result]; + } + + if (![_context symbolNamesFunction:_head]) + { + if (_head && [_head homePackage] == sys) + { + results = [MLKRoot dispatch:_head withArguments:args]; + } + + if (results) + { + return results; + } + else + { + [NSException raise:@"MLKNoSuchOperatorException" + format:@"%@ does not name a known operator.", + MLKPrintToString(_head)]; + return nil; + } + } + else + { + id function = [env functionForSymbol:_head]; + return [function applyToArray:args]; + } +} +@end + + +@implementation MLKSetQForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + id value = nil; + MLKDynamicContext *dynamicContext = [MLKDynamicContext currentContext]; + + for (i = 0; i < [_variables count]; i++) + { + id symbol = denullify([_variables objectAtIndex:i]); + value = [[[_valueForms objectAtIndex:i] interpretWithEnvironment:env] objectAtIndex:0]; + + if ([_context variableIsLexical:symbol]) + [env setValue:value forSymbol:symbol]; + else if ([dynamicContext bindingForSymbol:symbol]) + [dynamicContext setValue:value forSymbol:symbol]; + else + // FIXME: Maybe print a warning. + [[MLKDynamicContext globalContext] addValue:value + forSymbol:symbol]; + } + + RETURN_VALUE (value); +} +@end + + +@implementation MLKFSetQForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + int i; + id value = nil; + + for (i = 0; i < [_functionNames count]; i++) + { + id symbol = denullify([_functionNames objectAtIndex:i]); + value = [[[_valueForms objectAtIndex:i] interpretWithEnvironment:env] objectAtIndex:0]; + + if ([_context symbolNamesFunction:symbol]) + { + [env setFunction:value forSymbol:symbol]; + } + else + { + // FIXME: Maybe print a warning. + [[MLKLexicalContext globalContext] addFunction:symbol]; + [[MLKLexicalEnvironment globalEnvironment] addFunction:value + forSymbol:symbol]; + } + } + + RETURN_VALUE (value); +} +@end -- cgit v1.2.3 From 926dce9dc2c7afa009cacab46fb6f1b704c80ca7 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 17:57:15 +0200 Subject: Fix some bugs in the new interpreter. --- MLKInterpreter.m | 75 +++++++++++++++++++++++++------------------------------- 1 file changed, 34 insertions(+), 41 deletions(-) diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 334b33c..1921c5a 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -136,27 +136,11 @@ } else { - expansion = denullify([[MLKInterpreter - eval:code - inLexicalContext:[MLKLexicalContext - globalContext] - withEnvironment:[MLKLexicalEnvironment - globalEnvironment]] - objectAtIndex:0]); - - if ([code isKindOfClass:[MLKCons class]] && [code cdr]) - formdesc = [NSString stringWithFormat:@"(%@ %@ ...)", - MLKPrintToString([expansion car]), - MLKPrintToString([[expansion cdr] car])]; - else - formdesc = MLKPrintToString(expansion); - - //fprintf (stderr, "; LOAD: %s\n", [formdesc UTF8String]); + expansion = code; result = [MLKInterpreter eval:expansion inLexicalContext:[MLKLexicalContext globalContext] withEnvironment:[MLKLexicalEnvironment globalEnvironment]]; - //NSLog (@"; LOAD: Top-level form evaluated."); } LRELEASE (pool); @@ -187,18 +171,27 @@ -(NSArray *) interpretWithEnvironment:(MLKLexicalEnvironment *)env { + NSArray *values; + #define TRACE_EVAL 0 #if TRACE_EVAL BOOL trace = NO; + + //if ([dynamicContext valueForSymbol:V_INITP]) + // trace = YES; + + //if (trace) + NSLog (@"; EVAL: %@", MLKPrintToString(_form)); +#endif // TRACE_EVAL + + values = [self reallyInterpretWithEnvironment:env]; - if ([dynamicContext valueForSymbol:V_INITP]) - trace = YES; - - if (trace) - NSLog (@"; EVAL: %@", MLKPrintToString(program)); +#if TRACE_EVAL + //if (trace) + NSLog (@"; EVAL END: %@", MLKPrintToString(_form)); #endif // TRACE_EVAL - return [self reallyInterpretWithEnvironment:env]; + return values; } @@ -221,23 +214,14 @@ @implementation MLKSymbolForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { - if ([_context symbolNamesSymbolMacro:_form]) - { - id macrofun, expansion; - - macrofun = [_context macroForSymbol:_form]; - expansion = [macrofun applyToArray: - [NSArray arrayWithObjects: - _form, _context, nil]]; - - return [expansion interpretWithEnvironment:env]; - } - else if ([_context variableIsLexical:_form]) + if ([_context variableIsLexical:_form]) { +// NSLog (@"Lexical?"); RETURN_VALUE ([env valueForSymbol:_form]); } else { +// NSLog (@"Special?"); RETURN_VALUE ([[MLKDynamicContext currentContext] valueForSymbol:_form]); } } @@ -343,7 +327,7 @@ @implementation MLKIfForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { - id cndval = [[_conditionForm interpretWithEnvironment:env] objectAtIndex:0]; + id cndval = denullify([[_conditionForm interpretWithEnvironment:env] objectAtIndex:0]); if (cndval) return [_consequentForm interpretWithEnvironment:env]; else @@ -367,7 +351,7 @@ @end -@implementation MLKLambdaForm (MLKInterpretation) +@implementation MLKSimpleLambdaForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { id lambdaList = [_tail car]; @@ -435,7 +419,7 @@ id value = [[[_variableBindingForms objectAtIndex:i] interpretWithEnvironment:env] objectAtIndex:0]; - if ([_context variableIsLexical:variable]) + if ([_bodyContext variableIsLexical:variable]) { [newenv addValue:value forSymbol:variable]; } @@ -467,6 +451,14 @@ @end +@implementation MLKVariableBindingForm (MLKInterpretation) +-(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env +{ + return [_valueForm interpretWithEnvironment:env]; +} +@end + + @implementation MLKSimpleLoopForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { @@ -510,7 +502,7 @@ -(NSArray *) interpretBodyWithEnvironment:(MLKLexicalEnvironment *)env { int i; - NSArray *values = nil; + NSArray *values = [NSArray array]; for (i = 0; i < [_bodyForms count]; i++) { @@ -573,7 +565,7 @@ @implementation MLKQuoteForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { - return _quotedData; + RETURN_VALUE (_quotedData); } @end @@ -641,7 +633,6 @@ -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { int i; - NSArray *results = nil; NSMutableArray *args = [NSMutableArray array]; for (i = 0; i < [_argumentForms count]; i++) @@ -654,6 +645,8 @@ if (![_context symbolNamesFunction:_head]) { + NSArray *results = nil; + if (_head && [_head homePackage] == sys) { results = [MLKRoot dispatch:_head withArguments:args]; -- cgit v1.2.3 From 03f8b9a2dd1a41baee46fd82e07545ad7c10986d Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 18:07:16 +0200 Subject: MLKInterpretedClosure: Adapt to the new interpreter. --- MLKForm.h | 2 ++ MLKForm.m | 6 ++++++ MLKInterpretedClosure.h | 14 ++++++-------- MLKInterpretedClosure.m | 38 ++++++++++---------------------------- MLKInterpreter.m | 8 ++------ 5 files changed, 26 insertions(+), 42 deletions(-) diff --git a/MLKForm.h b/MLKForm.h index a57faa3..ef62d97 100644 --- a/MLKForm.h +++ b/MLKForm.h @@ -200,6 +200,8 @@ { MLKSymbol *_lambdaListName; } + +-(MLKSymbol *) lambdaListName; @end diff --git a/MLKForm.m b/MLKForm.m index 16ab207..024ac2d 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -215,6 +215,7 @@ [NSArray arrayWithObjects: _form, context, nil]] objectAtIndex:0]); + //NSLog (@"=> %@", MLKPrintToString (expansion)); return LRETAIN ([MLKForm formWithObject:expansion inContext:context @@ -483,6 +484,11 @@ inContext:newContext]; return self; } + +-(MLKSymbol *) lambdaListName +{ + return _lambdaListName; +} @end diff --git a/MLKInterpretedClosure.h b/MLKInterpretedClosure.h index 4955c4c..9651c70 100644 --- a/MLKInterpretedClosure.h +++ b/MLKInterpretedClosure.h @@ -16,7 +16,9 @@ * along with this program. If not, see . */ +#import "MLKForm.h" #import "MLKFuncallable.h" +#import "MLKInterpreter.h" #import "MLKLexicalContext.h" #import "MLKLexicalEnvironment.h" @@ -26,16 +28,12 @@ @interface MLKInterpretedClosure : NSObject { - id bodyForm; - MLKSymbol *lambdaListName; - MLKLexicalContext *context; - MLKLexicalEnvironment *environment; + MLKSimpleLambdaForm *_form; + MLKLexicalEnvironment *_environment; } --(id) initWithBodyForms:(id)forms - lambdaListName:(MLKSymbol *)symbol - context:(MLKLexicalContext *)lexctx - environment:(MLKLexicalEnvironment *)lexenv; +-(id) initWithForm:(MLKSimpleLambdaForm *)aForm + environment:(MLKLexicalEnvironment *)lexenv; -(NSArray *) applyToArray:(NSArray *)arguments; diff --git a/MLKInterpretedClosure.m b/MLKInterpretedClosure.m index 6507956..8389bdb 100644 --- a/MLKInterpretedClosure.m +++ b/MLKInterpretedClosure.m @@ -38,16 +38,12 @@ static MLKSymbol *PROGN; PROGN = [cl intern:@"PROGN"]; } --(id) initWithBodyForms:(id)forms - lambdaListName:(MLKSymbol *)symbol - context:(MLKLexicalContext *)lexctx - environment:(MLKLexicalEnvironment *)lexenv +-(id) initWithForm:(MLKSimpleLambdaForm *)form + environment:(MLKLexicalEnvironment *)lexenv { self = [super init]; - LASSIGN (bodyForm, [MLKCons cons:PROGN with:forms]); - LASSIGN (context, lexctx); - LASSIGN (environment, lexenv); - LASSIGN (lambdaListName, symbol); + LASSIGN (_environment, lexenv); + LASSIGN (_form, form); return self; } @@ -56,24 +52,12 @@ static MLKSymbol *PROGN; id arglist = [MLKCons listWithArray:arguments]; MLKLexicalEnvironment *new_environment = - [MLKLexicalEnvironment environmentWithParent:environment - variables:[NSDictionary dictionaryWithObject:nullify(arglist) - forKey:lambdaListName] + [MLKLexicalEnvironment environmentWithParent:_environment + variables:[NSDictionary dictionaryWithObject:arglist + forKey:nullify([_form lambdaListName])] functions:nil]; - MLKLexicalContext *new_context = - [MLKLexicalContext contextWithParent:context - variables:[NSSet setWithObject:lambdaListName] - functions:nil - goTags:nil - macros:nil - compilerMacros:nil - symbolMacros:nil - declarations:nil]; - - return [MLKInterpreter eval:bodyForm - inLexicalContext:new_context - withEnvironment:new_environment]; + return [_form interpretBodyWithEnvironment:new_environment]; } -(NSString *) description @@ -88,10 +72,8 @@ static MLKSymbol *PROGN; -(void) dealloc { - LDESTROY (bodyForm); - LDESTROY (lambdaListName); - LDESTROY (context); - LDESTROY (environment); + LDESTROY (_environment); + LDESTROY (_form); [super dealloc]; } @end diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 1921c5a..9612ad4 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -354,13 +354,9 @@ @implementation MLKSimpleLambdaForm (MLKInterpretation) -(NSArray *) reallyInterpretWithEnvironment:(MLKLexicalEnvironment *)env { - id lambdaList = [_tail car]; - id body = [_tail cdr]; id closure = LAUTORELEASE ([[MLKInterpretedClosure alloc] - initWithBodyForms:_body - lambdaListName:lambdaList - context:_context - environment:env]); + initWithForm:self + environment:env]); RETURN_VALUE (closure); } @end -- cgit v1.2.3 From f403bb6e9b0c64e2ce05eaf382c95884e753644e Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 18:44:05 +0200 Subject: Promote special operator EVAL to an intrinsic function. --- MLKForm.m | 1 - MLKPackage.m | 2 +- MLKRoot.m | 8 ++++++++ special-symbols.h | 2 -- 4 files changed, 9 insertions(+), 4 deletions(-) diff --git a/MLKForm.m b/MLKForm.m index 024ac2d..3f529dc 100644 --- a/MLKForm.m +++ b/MLKForm.m @@ -130,7 +130,6 @@ id car = [object car]; if (car == CATCH) return [MLKCatchForm class]; - else if (car == EVAL) return [MLKFunctionCallForm class]; else if (car == EVAL_WHEN) return [MLKEvalWhenForm class]; else if (car == _FOREIGN_LAMBDA) return [MLKForeignLambdaForm class]; else if (car == FUNCTION) return [MLKFunctionForm class]; diff --git a/MLKPackage.m b/MLKPackage.m index 6d97652..d432465 100644 --- a/MLKPackage.m +++ b/MLKPackage.m @@ -98,7 +98,6 @@ static NSMutableDictionary *packages = nil; [cl export:[cl intern:@"DECLARE"]]; [cl export:[cl intern:@"QUOTE"]]; [cl export:[cl intern:@"VALUES"]]; - [cl export:[cl intern:@"EVAL"]]; [cl export:[cl intern:@"SPECIAL"]]; [cl export:[cl intern:@"UNWIND-PROTECT"]]; [cl export:[cl intern:@"MULTIPLE-VALUE-CALL"]]; @@ -155,6 +154,7 @@ static NSMutableDictionary *packages = nil; [sys export:[sys intern:@"COMPILE"]]; [sys export:[sys intern:@"SET"]]; [sys export:[sys intern:@"APPLY"]]; + [sys export:[sys intern:@"EVAL"]]; [sys export:[sys intern:@"OBJC-CLASS-OF"]]; [sys export:[sys intern:@"OBJC-SUBCLASSP"]]; diff --git a/MLKRoot.m b/MLKRoot.m index 361ce16..8045f54 100644 --- a/MLKRoot.m +++ b/MLKRoot.m @@ -776,4 +776,12 @@ as provided by method %@ of object %@", ? (id)[arglist array] : (id)[NSArray array])]; } + ++(NSArray *) eval:(NSArray *)args +{ + id evaluand = denullify ([args objectAtIndex:0]); + return [MLKInterpreter eval:evaluand + inLexicalContext:[MLKLexicalContext globalContext] + withEnvironment:[MLKLexicalEnvironment globalEnvironment]]; +} @end diff --git a/special-symbols.h b/special-symbols.h index 806c758..d0f93b0 100644 --- a/special-symbols.h +++ b/special-symbols.h @@ -38,7 +38,6 @@ static MLKSymbol *LET; static MLKSymbol *LOCALLY; static MLKSymbol *FUNCALL; static MLKSymbol *FUNCTION; -static MLKSymbol *EVAL; static MLKSymbol *EVAL_WHEN; static MLKSymbol *QUOTE; static MLKSymbol *SETQ; @@ -87,7 +86,6 @@ ensure_symbols () _FLET = [sys intern:@"%FLET"]; _MACROLET = [sys intern:@"%MACROLET"]; _LOOP = [sys intern:@"%LOOP"]; - EVAL = [cl intern:@"EVAL"]; EVAL_WHEN = [cl intern:@"EVAL-WHEN"]; FUNCALL = [cl intern:@"FUNCALL"]; FUNCTION = [cl intern:@"FUNCTION"]; -- cgit v1.2.3 From a34b771cd9cc823260407b2905312b3be05390db Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 24 Aug 2008 18:54:47 +0200 Subject: Add a couple of debugging statements. --- MLKInterpreter.m | 29 ++++++++++++++++++----------- MLKReadEvalPrintLoop.m | 6 ++++++ 2 files changed, 24 insertions(+), 11 deletions(-) diff --git a/MLKInterpreter.m b/MLKInterpreter.m index 9612ad4..f85bf21 100644 --- a/MLKInterpreter.m +++ b/MLKInterpreter.m @@ -173,24 +173,31 @@ { NSArray *values; -#define TRACE_EVAL 0 -#if TRACE_EVAL +#if 0 BOOL trace = NO; - //if ([dynamicContext valueForSymbol:V_INITP]) // trace = YES; //if (trace) - NSLog (@"; EVAL: %@", MLKPrintToString(_form)); -#endif // TRACE_EVAL - + NSLog (@"; EVAL END: %@", MLKPrintToString(_form)); values = [self reallyInterpretWithEnvironment:env]; - -#if TRACE_EVAL //if (trace) - NSLog (@"; EVAL END: %@", MLKPrintToString(_form)); -#endif // TRACE_EVAL - + NSLog (@"; EVAL: %@", MLKPrintToString(_form)); +#elif 1 + NS_DURING + { + values = [self reallyInterpretWithEnvironment:env]; + } + NS_HANDLER + { + NSLog (@"; BROKEN EVAL: %@", MLKPrintToString(_form)); + [localException raise]; + } + NS_ENDHANDLER; +#else + values = [self reallyInterpretWithEnvironment:env]; +#endif + return values; } diff --git a/MLKReadEvalPrintLoop.m b/MLKReadEvalPrintLoop.m index 53943bc..de2f4f1 100644 --- a/MLKReadEvalPrintLoop.m +++ b/MLKReadEvalPrintLoop.m @@ -98,8 +98,10 @@ static const char *prompt (EditLine *e) { pool = [[NSAutoreleasePool alloc] init]; printf ("Loading init.lisp.\n"); +#if 1 NS_DURING { +#endif input = [NSInputStream inputStreamWithFileAtPath:@"init.lisp"]; stream = LAUTORELEASE ([[MLKStream alloc] initWithInputStream:input]); @@ -107,6 +109,7 @@ static const char *prompt (EditLine *e) { [MLKInterpreter load:stream verbose:YES print:YES]; success = [MLKInterpreter load:stream verbose:YES print:YES]; [input close]; +#if 1 } NS_HANDLER { @@ -115,6 +118,7 @@ static const char *prompt (EditLine *e) { [[localException reason] UTF8String]); } NS_ENDHANDLER; +#endif printf ("Done.\n\n"); @@ -151,9 +155,11 @@ static const char *prompt (EditLine *e) { #if 1 NS_DURING #else +#ifdef GNUSTEP GSDebugAllocationActive (YES); [NSObject enableDoubleReleaseCheck:YES]; NSZombieEnabled = YES; +#endif #endif { int i; -- cgit v1.2.3