// // TLFunc.m // TinyLisp // // Created by David Phillip Oster on 9/2/07. // // Copyright 2007 David Phillip Oster // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. // You may obtain a copy of the License at // http://www.apache.org/licenses/LICENSE-2.0 // Unless required by applicable law or agreed to in writing, software // distributed under the License is distributed on an "AS IS" BASIS, // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. // See the License for the specific language governing permissions and // limitations under the License. #import "TLLisp.h" @interface TLFuncAbstract(PrivateMethods) + (TLID *)tlApplyInner:(NSArray *)arg; + (NSArray *)evaluateArgs:(NSArray *)call fromIndex:(int)index; @end @implementation TLFuncAbstract(PrivateMethods) + (TLID *)tlApplyInner:(NSArray *)arg { return nil; } + (NSArray *)evaluateArgs:(NSArray *)call fromIndex:(int)index{ NSMutableArray *result = [NSMutableArray array]; int i, iCount = [call count]; for (i = 0;i < index; ++i) { [result addObject:[call objectAtIndex:i]]; // already evaluated } for (;i < iCount; ++i) { TLID *val = [[call objectAtIndex:i] tlEval]; if (nil == val) { val = [NSNull null]; } [result addObject:val]; } return result; } @end @implementation TLFuncAbstract + (TLID *)tlApply:(NSArray *)arg { return [self tlApplyInner:[self evaluateArgs:arg]]; } // abstract class just returns args. TLFunc evaluates. // This makes defining special funcs easy. + (NSArray *)evaluateArgs:(NSArray *)call { return call; } + (BOOL)isLambdaCall:(TLID *)first withArray:(NSArray *)call { return [first isKindOfClass:[NSArray class]] && 3 <= [(NSArray *)first count] && gTLLambda == [(NSArray *)first objectAtIndex:0]; } + (TLID *)performLambdaCall:(TLID *)first withArray:(NSArray *)call { NSArray *args = [self evaluateArgs:call]; NSArray *formals = [(NSArray *)first objectAtIndex:1]; TLID *token = TLBind(formals, args); TLID *val = nil; int i, iCount = [(NSArray *)first count]; // the lambda expression starts with a lambda, and a formals list. for (i = 2;i < iCount; ++i) { val = [[(NSArray *)first objectAtIndex:i] tlEval]; } TLUnbind(token); return val; } + (BOOL)isObjectiveCCall:(TLID *)first withArray:(NSArray *)call { //TODO not yet return NO; } + (TLID *)performObjectiveCCall:(TLID *)first withArray:(NSArray *)call { //TODO not yet return nil; } @end // inherit from this, is you can't have arguments pre-evaluated. @implementation TLFuncSpecial + (NSArray *)evaluateArgs:(NSArray *)call { return call; } @end @implementation TLFunc + (NSArray *)evaluateArgs:(NSArray *)call { return [self evaluateArgs:call fromIndex:1]; } @end @implementation TLFuncprogn + (TLID *)tlApplyInner:(NSArray *)args { return [args lastObject]; } @end @implementation TLFuncprog0 + (TLID *)tlApplyInner:(NSArray *)args { return [args objectAtIndex:1]; } @end @implementation TLFuncquote + (TLID *)tlApplyInner:(NSArray *)call { return [call objectAtIndex:1]; } @end @implementation TLFuncset + (TLID *)tlApplyInner:(NSArray *)args { TLID *val = nil; int i, iCount = [args count]; for(i = 1; i < iCount; i += 2) { TLAtom *atom = [args objectAtIndex:i]; val = [args objectAtIndex:i+1]; [atom setValue:val]; } return val; } @end @implementation TLFuncClassFromString + (TLID *)tlApplyInner:(NSArray *)args { TLID *atomSelf = [args objectAtIndex:1]; return (TLID *) NSClassFromString((NSString *)atomSelf); } @end @implementation TLFuncPerformSelector + (TLID *)tlApplyInner:(NSArray *)args { TLID *atomSelf = [args objectAtIndex:1]; TLID *atomSelector = [args objectAtIndex:2]; int i, iCount = [args count]; SEL sel = NSSelectorFromString((NSString *)atomSelector); NSMethodSignature *sig = [atomSelf methodSignatureForSelector:sel]; if (nil == sig) { return nil; } NSInvocation *voke = [NSInvocation invocationWithMethodSignature:sig]; [voke setTarget:atomSelf]; [voke setSelector:sel]; for(i = 3;i < iCount; ++i){ const char *argType = [sig getArgumentTypeAtIndex:i-1]; if (0 == strcmp(argType, "I") || 0 == strcmp(argType, "i")) { NSNumber *num = [args objectAtIndex:i]; int n = [num intValue]; [voke setArgument:&n atIndex:i-1]; } else { TLID *arg = [args objectAtIndex:i]; [voke setArgument:&arg atIndex:i-1]; } } [voke invoke]; unsigned int length = [sig methodReturnLength]; if (length == sizeof(TLID*)) { TLID *result; [voke getReturnValue:&result]; const char *resultType = [sig methodReturnType]; if (0 == strcmp(resultType, "I") || 0 == strcmp(resultType, "i")) { return [NSNumber numberWithInt:(int)result]; } return result; } // possibly other cases here. return nil; } @end @implementation TLFunctlIf + (TLID *)tlApplyInner:(NSArray *)call { TLID *val = [[call objectAtIndex:1] tlEval]; if (nil == val || [val isEqual:[NSNull null]]) { if (4 == [call count]) { return [[call objectAtIndex:3] tlEval]; } return nil; } else { return [[call objectAtIndex:2] tlEval]; } } @end @implementation TLFunctlWhile + (TLID *)tlApplyInner:(NSArray *)call { TLID *result = nil; for(;;){ TLID *val = [[call objectAtIndex:1] tlEval]; if (nil == val || [val isEqual:[NSNull null]]) { break; // <-- normal loop exit } result = [self evaluateArgs:call fromIndex:2]; result = [(NSArray *)result lastObject]; } return result; } @end @implementation TLFunctlAnd + (TLID *)tlApplyInner:(NSArray *)call { TLID *result = nil; int i, iCount = [call count]; for(i = 1;i < iCount;++i){ result = [[call objectAtIndex:i] tlEval]; if (nil == result || [result isEqual:[NSNull null]]) { break; // <-- normal loop exit } } return result; } @end @implementation TLFunctlOr + (TLID *)tlApplyInner:(NSArray *)call { TLID *result = nil; int i, iCount = [call count]; for(i = 1;i < iCount;++i){ result = [[call objectAtIndex:i] tlEval]; if ( ! (nil == result || [result isEqual:[NSNull null]])) { break; // <-- normal loop exit } } return result; } @end @implementation TLFunceq + (TLID *)tlApplyInner:(NSArray *)args { BOOL isEqual = YES; int i, iCount = [args count]; if (1 < iCount) { TLID *first = [args objectAtIndex:1]; for (i = 2; isEqual && i < iCount; ++i) { if ( ! [first isEqual:[args objectAtIndex:i]]) { isEqual = NO; } } } return isEqual ? gTLT : nil; } @end @implementation TLFuncplus + (TLID *)tlApplyInner:(NSArray *)args { double n = 0; int i, iCount = [args count]; for (i = 1; i < iCount; ++i) { n += [[args objectAtIndex:i] floatValue]; } return [NSNumber numberWithDouble:n]; } @end @implementation TLFuncminus + (TLID *)tlApplyInner:(NSArray *)args { double n = 0; if (2 == [args count]) { n = - [[args objectAtIndex:1] floatValue]; } else { n = [[args objectAtIndex:1] floatValue] - [[args objectAtIndex:2] floatValue]; } return [NSNumber numberWithDouble:n]; } @end @implementation TLFunctimes + (TLID *)tlApplyInner:(NSArray *)args { double n = 1.; int i, iCount = [args count]; for (i = 1; i < iCount; ++i) { n *= [[args objectAtIndex:i] floatValue]; } return [NSNumber numberWithDouble:n]; } @end @implementation TLFuncdivide + (TLID *)tlApplyInner:(NSArray *)args { double n = 0; if (2 == [args count]) { n = 1. / [[args objectAtIndex:1] floatValue]; } else { n = [[args objectAtIndex:1] floatValue] / [[args objectAtIndex:2] floatValue]; } return [NSNumber numberWithDouble:n]; } @end @implementation TLFuncgt + (TLID *)tlApplyInner:(NSArray *)args { BOOL val = YES; float n0 = [[args objectAtIndex:1] floatValue]; int i, iCount = [args count]; for (i = 2;i < iCount;++i){ float n1 = [[args objectAtIndex:i] floatValue]; if (n0 > n1) { n0 = n1; } else { val = NO; break; } } return val ? gTLT : nil; } @end @implementation TLFunclt + (TLID *)tlApplyInner:(NSArray *)args { BOOL val = YES; int i, iCount = [args count]; float n0 = [[args objectAtIndex:1] floatValue]; for (i = 2;i < iCount;++i){ float n1 = [[args objectAtIndex:i] floatValue]; if (n0 < n1) { n0 = n1; } else { val = NO; break; } } return val ? gTLT : nil; } @end @implementation TLFuncge + (TLID *)tlApplyInner:(NSArray *)args { BOOL val = YES; int i, iCount = [args count]; float n0 = [[args objectAtIndex:1] floatValue]; for (i = 2;i < iCount;++i){ float n1 = [[args objectAtIndex:i] floatValue]; if (n0 >= n1) { n0 = n1; } else { val = NO; break; } } return val ? gTLT : nil; } @end @implementation TLFuncle + (TLID *)tlApplyInner:(NSArray *)args { BOOL val = YES; int i, iCount = [args count]; float n0 = [[args objectAtIndex:1] floatValue]; for (i = 2;i < iCount;++i){ float n1 = [[args objectAtIndex:i] floatValue]; if (n0 <= n1) { n0 = n1; } else { val = NO; break; } } return val ? gTLT : nil; } @end @implementation TLFuncprint + (TLID *)tlApplyInner:(NSArray *)args { int i, iCount = [args count]; NSMutableString *outS = [NSMutableString string]; TLID *val = nil; for (i = 1;i < iCount;++i){ val = [args objectAtIndex:i]; [val tlPrint:outS]; } printf("%s\n", [outS UTF8String]); return val; } @end @implementation TLFunccount + (TLID *)tlApplyInner:(NSArray *)args { TLID *val = [args objectAtIndex:1]; int n = 0; if ([val respondsToSelector:@selector(count)]) { n = (int) [val performSelector:@selector(count)]; } else if([val respondsToSelector:@selector(length)]) { n = (int) [val performSelector:@selector(length)]; } return [NSNumber numberWithInt:n]; } @end // (list 2 3 4) returns (2 3 4) @implementation TLFunclist + (TLID *)tlApplyInner:(NSArray *)args { NSMutableArray *result = [[args mutableCopy] autorelease]; [result removeObjectAtIndex:0]; return result; } @end // objectAtIndex = at @implementation TLFuncAtIndex + (TLID *)tlApplyInner:(NSArray *)args { TLID *arry = [args objectAtIndex:1]; TLID *num = [args objectAtIndex:2]; if ([arry respondsToSelector:@selector(objectAtIndex:)]) { return [(NSArray *)arry objectAtIndex:[(NSNumber *)num intValue]]; } else if ([arry respondsToSelector:@selector(characterAtIndex:)]) { return [NSNumber numberWithInt:[(NSString *)arry characterAtIndex:[(NSNumber *)num intValue]]]; } return nil; } @end // insertAtIndex @implementation TLFuncInsertAtIndex + (TLID *)tlApplyInner:(NSArray *)args { NSMutableArray *arry = (NSMutableArray *) [args objectAtIndex:1]; TLID *newObj = [args objectAtIndex:2]; NSNumber *num = (NSNumber *) [args objectAtIndex:3]; if ([arry respondsToSelector:@selector(insertObject:atIndex:)]) { [arry insertObject:newObj atIndex:[num intValue]]; } else if ([arry respondsToSelector:@selector(insertString:atIndex:)]) { NSString *s = nil; if ([newObj isKindOfClass:[NSString class]]) { s = (NSString *) newObj; } else if ([newObj respondsToSelector:@selector(intValue)]) { unichar c = [(NSNumber *)newObj intValue]; s = [[[NSString alloc] initWithCharacters:&c length:1] autorelease]; } if (s) { [(NSMutableString *)arry insertString:s atIndex:[num intValue]]; } } return nil; } @end // removeAtIndex @implementation TLFuncRemoveAtIndex + (TLID *)tlApplyInner:(NSArray *)args { NSMutableArray *arry = (NSMutableArray *) [args objectAtIndex:1]; NSNumber *num = (NSNumber *) [args objectAtIndex:2]; if ([arry respondsToSelector:@selector(removeObjectAtIndex:)]) { [arry removeObjectAtIndex:[num intValue]]; } else if ([arry respondsToSelector:@selector(deleteCharactersInRange:)]) { [(NSMutableString *)arry deleteCharactersInRange:NSMakeRange([num intValue], 1)]; } return nil; } @end // replaceAtIndex @implementation TLFuncReplaceAtIndexWith + (TLID *)tlApplyInner:(NSArray *)args { NSMutableArray *arry = (NSMutableArray *) [args objectAtIndex:1]; NSNumber *num = (NSNumber *) [args objectAtIndex:2]; TLID *newObj = [args objectAtIndex:3]; if ([arry respondsToSelector:@selector(replaceObjectAtIndex:withObject:)]) { [arry replaceObjectAtIndex:[num intValue] withObject:newObj]; } else if ([arry respondsToSelector:@selector(replaceCharactersInRange:withString:)]) { NSString *s = nil; if ([newObj isKindOfClass:[NSString class]]) { s = (NSString *) newObj; } else if ([newObj respondsToSelector:@selector(intValue)]) { unichar c = [(NSNumber *)newObj intValue]; s = [[[NSString alloc] initWithCharacters:&c length:1] autorelease]; } if (s) { [(NSMutableString *)arry replaceCharactersInRange:NSMakeRange([num intValue], 1) withString:s]; } } return nil; } @end // (propertyForKey 'a "foo") @implementation TLFuncPropertyForKey + (TLID *)tlApplyInner:(NSArray *)args { TLAtom *atom = (TLAtom *) [args objectAtIndex:1]; NSString *key = [args objectAtIndex:2]; return [atom propertyForKey:key]; } @end // (removePropertyForKey 'a "foo") @implementation TLFuncRemovePropertyForKey + (TLID *)tlApplyInner:(NSArray *)args { TLAtom *atom = (TLAtom *) [args objectAtIndex:1]; NSString *key = [args objectAtIndex:2]; [atom removePropertyForKey:key]; return nil; } @end // (setPropertyForKey 'a 5 "foo") @implementation TLFuncSetPropertyForKey + (TLID *)tlApplyInner:(NSArray *)args { TLAtom *atom = (TLAtom *) [args objectAtIndex:1]; TLID *val = [args objectAtIndex:2]; [atom setProperty:val forKey:[args objectAtIndex:3]]; return val; } @end // (propertyKeys 'a) @implementation TLFuncPropertyKeys + (TLID *)tlApplyInner:(NSArray *)args { TLAtom *atom = (TLAtom *) [args objectAtIndex:1]; return [atom propertyKeys]; } @end