lisp.m

gistfile1.m

// clang -framework Foundation lisp.m

#import <Cocoa/Cocoa.h>
#import <objc/runtime.h>


@interface Node : NSObject
- (id)evaluate: (NSArray *)arguments;
- (id)eval;
@end

#undef TRUE

Node *LOG;
Node *IF;
Node *GT;
Node *TRUE;

#define S(symbol) Wrap(@ #symbol)
#define $(primitive) WrapPrimitive((__typeof__(primitive) []){ primitive }, @encode(__typeof__(primitive)))

Node *WrapPrimitive(void *ptr, const char *type);

@implementation Node

- (id)evaluate: (NSArray *)arguments
{
    return nil;
}

- (id)eval
{
    return [self evaluate: nil];
}

@end

@interface _NativeNode : Node
- (id)initWithBlock: (id (^)(NSArray *arguments))block;
@end

@implementation _NativeNode {
    id (^_block)(NSArray *);
}

+ (void)load
{
    @autoreleasepool {
        LOG = [[_NativeNode alloc] initWithBlock: ^(NSArray *arguments) {
            NSLog(@"%@", arguments);
            return (id)nil;
        }];
        IF = [[_NativeNode alloc] initWithBlock: ^(NSArray *arguments) {
            NSUInteger index = [[arguments objectAtIndex: 0] eval] ? 1 : 2;
            return [[arguments objectAtIndex: index] eval];
        }];
        GT = [[_NativeNode alloc] initWithBlock: ^(NSArray *arguments) {
            Node *a = [arguments objectAtIndex: 0];
            Node *b = [arguments objectAtIndex: 1];
            return [[a eval] intValue] > [[b eval] intValue] ? TRUE : nil;
        }];
        TRUE = $(YES);
    }
}

- (id)initWithBlock: (id (^)(NSArray *arguments))block
{
    if((self = [super init]))
    {
        _block = [block copy];
    }
    return self;
}

- (id)evaluate: (NSArray *)arguments
{
    return _block(arguments);
}

@end

@interface _WrapperNode : Node
- (id)initWithObject: (id)obj;
@end

@implementation _WrapperNode {
    id _obj;
}

- (id)initWithObject: (id)obj
{
    if((self = [super init]))
    {
        _obj = obj;
    }
    return self;
}

- (id)evaluate: (NSArray *)arguments
{
    return _obj;
}

- (NSString *)description
{
    return [NSString stringWithFormat: @"<%@ %p: %@>", [self class], self, _obj];
}

@end

@interface _CompoundNode : Node
- (id)initWithSubnodes: (NSArray *)subnodes;
@end

@implementation _CompoundNode {
    NSArray *_subnodes;
}

- (id)initWithSubnodes: (NSArray *)subnodes
{
    if((self = [super init]))
    {
        _subnodes = subnodes;
    }
    return self;
}

- (id)evaluate: (NSArray *)arguments
{
    return [[_subnodes objectAtIndex: 0] evaluate: [_subnodes subarrayWithRange: NSMakeRange(1, [_subnodes count] - 1)]];
}

@end

@interface Node (Sexp)
- (Node *) : (Node *)a;
- (Node *) : (Node *)a : (Node *)b;
- (Node *) : (Node *)a : (Node *)b : (Node *)c;
@end

@implementation Node (Sexp)

- (Node *) : (Node *)a
{
    return [[_CompoundNode alloc] initWithSubnodes: [NSArray arrayWithObjects: self, a, nil]];
}

- (Node *) : (Node *)a : (Node *)b
{
    return [[_CompoundNode alloc] initWithSubnodes: [NSArray arrayWithObjects: self, a, b, nil]];
}

- (Node *) : (Node *)a : (Node *)b : (Node *)c
{
    return [[_CompoundNode alloc] initWithSubnodes: [NSArray arrayWithObjects: self, a, b, c, nil]];
}

@end

Node *Wrap(id obj)
{
    return [[_WrapperNode alloc] initWithObject: obj];
}

Node *WrapPrimitive(void *ptr, const char *type)
{
    static char numeric[] = { _C_CHR, _C_UCHR, _C_SHT, _C_USHT, _C_INT, _C_UINT, _C_LNG, _C_ULNG, _C_LNG_LNG, _C_ULNG_LNG };
    
    
    NSValue *obj = nil;
    if(strchr(numeric, *type))
    {
        long long num = 0;
        
        NSUInteger typeSize;
        NSGetSizeAndAlignment(type, &typeSize, NULL);
        
        assert(typeSize <= sizeof(num));
        assert(__LITTLE_ENDIAN__);
        
        unsigned char *cursor = ptr;
        int shift = 0;
        while(typeSize --> 0)
        {
            num |= (unsigned long long)*cursor++ << shift;
            shift += CHAR_BIT;
        }
        
        if(isupper(*type))
            obj = [NSNumber numberWithUnsignedLongLong: num];
        else
            obj = [NSNumber numberWithLongLong: num];
    }
    else
    {
        obj = [NSValue valueWithBytes: ptr objCType: type];
    }
    return [[_WrapperNode alloc] initWithObject: obj];
}

int main(int argc, char **argv)
{
    @autoreleasepool {
        Node *node = [IF
                        :[GT : $(2) : $(3)]
                        :[LOG : S(greater)]
                        :[LOG : S(not_greater)]];
        [node evaluate: nil];
    }
}