gscheme/SchemeTypes.m

#import "SchemeTypes.h"

@implementation NSMutableArray (Wrap)

- (void)addObjWRP:(id)anObject
{
    [anObject retain];
    [self addObject:anObject];
    return;
}

- (void)replaceObjWRPAtIndex:(unsigned)index withObject:(id)anObject
{
    [anObject retain];
    [self replaceObjectAtIndex:index withObject:anObject];
    return;
}

- (void)prependObjWRP:(id)anObject
{
    [anObject retain];
    [self insertObject:anObject atIndex:0];
    return;
}

@end

@implementation NSMutableDictionary (Wrap)

- (void)setObjWRP:(id)anObject forKey:(id)aKey
{
    [anObject retain];
    [self setObject:anObject forKey:aKey];
    return;
}

@end

@implementation SCMType

static int allocatedAfterGC = 0;
static NSMutableSet *scmobjects = nil;
static NSMutableSet *scmmarkables = nil;
static int currentMark = -1;
static int totalAllocated = 0;


+ (int)allocatedAfterGC
{
    return allocatedAfterGC;
}

+ (int)totalAllocated
{
    return totalAllocated;
}

+ (int)nextMark
{
    currentMark++;
    return currentMark;
}

+ addToMarkables:(id)item
{
    NSValue *entry = 
        [NSValue valueWithBytes:&item objCType:@encode(id)];

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
        [scmmarkables retain];
    }

    [scmmarkables addObject:entry];

    return self;
}

+ removeFromMarkables:(id)item
{
    NSValue *entry = 
        [NSValue valueWithBytes:&item objCType:@encode(id)];

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
        [scmmarkables retain];
    }

    [scmmarkables removeObject:entry];

    return self;
}

+ currentMarkForMarkables
{
    NSEnumerator *enumerator;
    NSValue *curval;
    id markable;

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
    }
    enumerator = [scmmarkables objectEnumerator];

    while((curval = (NSValue *)[enumerator nextObject])!=nil){
        [curval getValue:&markable];
        if(MARKABLE(markable)){
            [markable setMarkToCurrent];
        }
    }

    return self;
}

+ runGC
{
    NSMutableSet *nextobjects = [NSMutableSet setWithCapacity:1];
    NSEnumerator *enumerator = [scmobjects objectEnumerator];
    // NSValue *curval;
    SCMType *current;
    
    while((current = (SCMType *)[enumerator nextObject])!=nil){
        // [curval getValue:&current];
        if([current mark]!=currentMark){
            [current free];
        }
        else{
            [nextobjects addObject:current]; // curval];
        }
    }

    [scmobjects release];

    scmobjects = nextobjects;
    [scmobjects retain];

    allocatedAfterGC = totalAllocated = [scmobjects count];
}

+ alloc
{
    id inst = [super alloc];
    /* NSValue *entry = 
       [NSValue valueWithBytes:&inst objCType:@encode(id)]; */

    if(scmobjects==nil){
        scmobjects = [NSMutableSet setWithCapacity:1];
        [scmobjects retain];
    }

    [scmobjects addObject:inst]; // entry];
    totalAllocated++;

    return [inst setMark:-1];
}


- (int)mark
{
    return mark;
}

- setMark:(int)newMark
{
    mark = newMark;
    return self;
}

- setMarkToCurrent
{
    mark = currentMark;
    return self;
}


- (void)free
{
    int count = [self retainCount];

    while(count>2){ // count>1 (leave one release for the set)
        count--;
        [self release];
    }

    [super release];
}
@end

@implementation Pair
    
+ (int)length:(Pair *)list
{
    return (list==(Pair *)[NSNull null] ? 
            0 : 1+[self length:[list cdr]]);
}

+ newCar:(id)carval Cdr:(id)cdrval
{
    return [[super alloc] initCar:carval Cdr:cdrval];
}

- initCar:(id)carval Cdr:(id)cdrval
{
    car = carval; [car retain];
    cdr = cdrval; [cdr retain];

    return self;
}


- car
{
    return car;
}

- cdr
{
    return cdr;
}

- setcar:(id)carval
{
    car = carval; [car retain];
    return self;
}

- setcdr:(id)cdrval
{
    cdr = cdrval; [cdr retain];
    return self;
}

- setMarkToCurrent
{
    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];
    if(MARKABLE(car)){
        [car setMarkToCurrent];
    }
    if(MARKABLE(cdr)){
        [cdr setMarkToCurrent];
    }
    
    return self;
}


@end

@implementation Vector

+ newFromList:(Pair *)list
{
    return [[super alloc]
               initWithList:list];
}

+ newWithItem:(id)item count:(int)cval
{
    return [[super alloc]
               initWithItem:item count:cval];
}


- initWithList:(Pair *)list
{
    Pair *current = list;
    int index = 0, length = [Pair length:list];

    count = length;
    data = NSZoneMalloc([self zone], length*sizeof(id));

    while(isPair(current)){
        data[index] = [current car]; [data[index++] retain];
        current = [current cdr];
    }

    return self;
}

- initWithItem:(id)item count:(int)cval
{
    count = cval;
    data = NSZoneMalloc([self zone], cval*sizeof(id));

    while(cval--){
        data[cval] = item; [item retain];
    }

    return self;
}


- (id *)entries
{
    return data;
}

- (unsigned)count
{
    return count;
}

- setMarkToCurrent
{
    int index;

    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];

    for(index=0; index<count; index++){
        id obj = data[index];
        if(MARKABLE(obj)){
            [obj setMarkToCurrent];
        }
    }

    return self;
}


- (void)free
{
    NSZoneFree([self zone], data);
    [super free];
}

@end

@implementation Closure

+ newArgs:(id)argsval Body:(id)codes Env:(id)envval
{
    return [[super alloc]
               initArgs:argsval Body:codes Env:envval];
}

- initArgs:(id)argsval Body:(id)codes Env:(id)envval
{
    [super init];
    args = argsval; [args retain];
    body = codes;   [body retain];
    env  = envval;  [env retain];

    return self;
}

- args
{
    return args;
}

- body
{
    return body;
}

- env
{
    return env;
}

- setMarkToCurrent
{
    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];
    if(MARKABLE(args)){
        [args setMarkToCurrent];
    }
    if(MARKABLE(body)){
        [body setMarkToCurrent];
    }
    if(MARKABLE(env)){
        [env setMarkToCurrent];
    }
    
    return self;
}

@end

@implementation Thunk

+ newArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
{
    return [[super alloc] 
               initArgp:argpval Envp:envpval Codep:codepval];
}

- initArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
{
    argp = argpval;
    envp = envpval;
    codep = codepval;
    return self;
}

- (int)argp
{
    return argp;
}

- setArgp:(int)argpval
{
    argp = argpval;
    return self;
}

- (int)envp
{
    return envp;
}

- setEnvp:(int)envpval
{
    envp = envpval;
    return self;
}

- (int)codep
{
    return codep;
}

- setCodep:(int)codepval
{
    codep = codepval;
    return self;
}

@end



@implementation Environment

+ newParent:(Environment *)par Data:(NSMutableDictionary *)entries
{
    return [[super alloc]
               initParent:par Data:entries];
}

- initParent:(Environment *)par Data:(NSMutableDictionary *)entries
{
    [super init];

    parent = par;
    [parent retain];
    
    data = entries; // [entries mutableCopy]; 
    [data retain];

    return self;
}

- (int)chainLength
{
    return (parent==nil ? 1 : 1+[parent chainLength]);
}

- (NSMutableDictionary *)lookup:(NSString *)sym
{
    if([data objectForKey:sym]!=nil){
        return data;
    }

    return (parent==nil ? nil : [parent lookup:sym]);
}

- (Environment *)parent
{
    return parent;
}

- (NSMutableDictionary *)data
{
    return data;
}

- setMarkToCurrent
{
    NSEnumerator *enumerator = [data objectEnumerator];
    id item;
  
    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];
    while((item = [enumerator nextObject])!=nil){
        if(MARKABLE(item)){
            [item setMarkToCurrent];
        }
    }
    
    if(MARKABLE(parent)){
        [parent setMarkToCurrent];
    }
    
    return self;
}

#define GSI_MAP_NOCLEAN 1

#include <base/GSIMap.h>

@interface GSMutableDictionary : NSDictionary
{
@public
  GSIMapTable_t map;
}
@end

typedef struct { 
    @defs(GSMutableDictionary)
} *GSMDictPtr;

- (void)free
{
    GSIMapEmptyMap(&(((GSMDictPtr)data)->map));
    while([data retainCount]>1){
        [data release];
    }

    [super free];
}

@end


@implementation Triple

+ newTag:(int)tagval
{
    return [[super alloc] 
               initTag:tagval
               Arg1:nil Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval IntArg1:(int)arg1;
{
    NSNumber *num = [NSNumber numberWithInt:arg1];
    return [[super alloc] 
               initTag:tagval
               Arg1:num Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:arg2 Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:arg2 Arg3:arg3];
}


- initTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
{
    tag = tagval;

    items[0] = arg1; [arg1 retain];
    items[1] = arg2; [arg2 retain];
    items[2] = arg3; [arg3 retain];

    return self;
}

- (int)tag
{
    return tag;
}

- (int)intarg1
{
    return [items[0] intValue];
}

- setIntArg1:(int)val
{
    items[0] = [NSNumber numberWithInt:val];
    return self;
}
    
- arg1
{
    return items[0];
}

- arg2
{
    return items[1];
}

- arg3
{
    return items[2];
}

- setMarkToCurrent
{
    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];
    if(MARKABLE(items[0])){
        [items[0] setMarkToCurrent];
    }
    if(MARKABLE(items[1])){
        [items[1] setMarkToCurrent];
    }
    if(MARKABLE(items[2])){
        [items[2] setMarkToCurrent];
    }
    
    return self;
}

@end

@implementation Boolean

- initSCMBoolean:(BOOL)val
{
    [super init];
    value = val;
    return self;
}

- (BOOL)boolVal
{
    return value;
}

@end

@implementation Char

- initSCMChar:(char)val
{
    [super init];
    value = val;
    return self;
}

- (char)charVal
{
    return value;
}

@end

@implementation Int

- initSCMInt:(long int)val
{
    [super init];
    value = val;
    return self;
}

- (long int)intVal
{
    return value;
}

- (double)doubleVal
{
    return (double)value;
}

@end

@implementation Double

- initSCMDouble:(double)val
{
    [super init];
    value = val;
    return self;
}

- (double)doubleVal
{
    return value;
}

@end

@implementation Symbol

- initSCMSymbol:(char *)val
{
    [super init];
    value = [NSString stringWithCString:val];
    [value retain];
    return self;
}

- (NSString *)symVal
{
    return value;
}

- (void)free
{
    [value release];
    [super free];
}

@end

@implementation String

- initSCMString:(char *)val
{
    char *cp, *buf, *from, *to;
    int len = strlen(val);

    [super init];

    cp = strdup(val); from = cp+1; cp[len-1] = 0;
    buf = to = malloc(len-1);

    while(*from){
        if(*from == '\\'){
            from++;
        }
        *to++ = *from++;
    }
    *to = 0;

    value = [NSString stringWithCString:buf];
    [value retain];

    free(buf);
    free(cp);

    return self;
}

- (NSString *)strVal
{
    return value;
}

- (void)free
{
    [value release];
    [super free];
}

@end

@implementation ByteCodes

+ new
{
    id inst = [super alloc];
    [inst initWithMutableArray:[NSMutableArray arrayWithCapacity:1]];
    return inst;
}

- initWithMutableArray:(NSMutableArray *)theData
{
    [super init];
    data = theData;
    [data retain];

    return self;
}

- prependTriple:(Triple *)theTriple
{
    [data prependObjWRP:theTriple];
    return self;
}

- addTriple:(Triple *)theTriple
{
    [data addObjWRP:theTriple];
    return self;
}

- appendByteCodes:(ByteCodes *)codes
{
    [data addObjectsFromArray:[codes codes]];
    return self;
}


- (NSMutableArray *)codes
{
    return data;
}

- setMarkToCurrent
{
    int index, count = [data count];

    if([self mark]==currentMark){
        return;
    }

    [super setMarkToCurrent];

    for(index=0; index<count; index++){
        id obj = [data objectAtIndex:index];
        if(MARKABLE(obj)){
            [obj setMarkToCurrent];
        }
    }

    return self;
}

@interface GSMutableArray : NSMutableArray
{
@public
  id            *_contents_array;
  unsigned      _count;
  unsigned      _capacity;
  int           _grow_factor;
}
@end

typedef struct { 
    @defs(GSMutableArray)
} *GSMArrayPtr;

- (void)free
{
    ((GSMArrayPtr)data)->_count = 0;
    while([data retainCount]>1){
        [data release];
    }

    [super free];
}

@end