#import "Primitive.h"
#import "VScheme.h"
#import "SchemeDelegate.h"

inline BOOL isBoolean(id item)
{
    return [item isKindOfClass:[Boolean class]];
}

inline BOOL isChar(id item)
{
    return [item isKindOfClass:[Char class]];
}

inline BOOL isInt(id item)
{
    return [item isKindOfClass:[Int class]];
}

inline BOOL isDouble(id item)
{
    return [item isKindOfClass:[Double class]];
}

inline BOOL isSymbol(id item)
{
    return [item isKindOfClass:[Symbol class]];
}

inline BOOL isString(id item)
{
    return [item isKindOfClass:[String class]];
}

inline BOOL isPair(id item)
{
    return [item isKindOfClass:[Pair class]];
}

inline BOOL isVector(id item)
{
    return [item isKindOfClass:[Vector class]];
}

inline BOOL isTriple(id item)
{
    return [item isKindOfClass:[Triple class]];
}

inline BOOL isPrimitive(id item)
{
    return [item isKindOfClass:[Primitive class]];
}

inline BOOL isEval(id item)
{
    return [item isKindOfClass:[PRMEval class]];
}

inline BOOL isClosure(id item)
{
    return [item isKindOfClass:[Closure class]];
}

inline BOOL isThunk(id item)
{
    return [item isKindOfClass:[Thunk class]];
}

BOOL isFalse(id item)
{
    if(item==[NSNull null]){
        return YES;
    }

    if([item isKindOfClass:[Boolean class]]){
        return ([item boolVal]==YES ? NO : YES);
    }

    return NO;
}

BOOL isEqual(id itema, id itemb)
{
    if([itema class]!=[itemb class]){
        return NO;
    }

    if(isChar(itema)){
        return ([itema charVal]==[itemb charVal] ? YES : NO);
    }
    else if(isInt(itema)){
        return ([itema intVal]==[itemb intVal] ? YES : NO);
    }
    else if(isDouble(itema)){
        return ([itema doubleVal]==[itemb doubleVal] ? YES : NO);
    }
    else if(isBoolean(itema)){
        return ([itema boolVal]==[itemb boolVal] ? YES : NO);
    }
    else if(isString(itema)){
        return [[itema strVal] isEqual:[itemb strVal]];
    }
    else if(isSymbol(itema)){
        return [[itema symVal] isEqual:[itemb symVal]];
    }

    return (itema==itemb ? YES : NO);
}


@implementation Primitive

- init
{
    [super init];

    value = [NSNull null];
    errmsg = nil;

    return self;
}


- (NUMTYPE)checkArgsNumeric:(NSMutableArray *)args offset:(int)offs
{
    int pos;
    NUMTYPE res = NT_INTEGERS;

    for(pos=offs; pos<[args count]; pos++){
        id arg = [args objectAtIndex:pos];
        if(isInt(arg)==NO){
            if(isDouble(arg)==NO){
                return NT_OTHER;
            }
            res = NT_DOUBLE;
        }
    }

    return res;
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
  [self notImplemented: _cmd];
  return NO;
}

- (NSString *)primName
{
  [self notImplemented: _cmd];
  return @"_not_implemented";
}

- value
{
    return value;
}

- errmsg
{
    if([errmsg isKindOfClass:[NSConstantString class]]==NO){
	[errmsg autorelease];
    }
    return errmsg;
}

@end

@implementation PRMVectorPred

- (NSString *)primName
{
    return @"vector?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;

    if(offs+1!=[args count]){
        errmsg = @"vector? takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    value = [[Boolean alloc] initSCMBoolean:isVector(item)];
    return YES;
}

@end

@implementation PRMPairPred

- (NSString *)primName
{
    return @"pair?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;

    if(offs+1!=[args count]){
        errmsg = @"pair? takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    value = [[Boolean alloc] initSCMBoolean:isPair(item)];
    return YES;
}

@end

@implementation PRMNullPred

- (NSString *)primName
{
    return @"null?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+1!=[args count]){
        errmsg = @"null? takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    value = [[Boolean alloc] 
                initSCMBoolean:(item==[NSNull null] ? YES : NO)];
    return YES;
}

@end

@implementation PRMZeroPred

- (NSString *)primName
{
    return @"zero?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    id item;
    BOOL res = NO;

    
    if(offs+1!=[args count]){
        errmsg = @"zero? takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    if(nt==NT_OTHER){
        errmsg = @"Argument to zero? must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        if(![item intVal]){
            res = YES;
        }
    }
    else{
        if([item doubleVal]==(double)0.0){
            res = YES;
        }
    }

    value = [[Boolean alloc] initSCMBoolean:res];
    return YES;
}

@end

@implementation PRMNumberPred

- (NSString *)primName
{
    return @"number?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    id item;
    BOOL res = NO;

    
    if(offs+1!=[args count]){
        errmsg = @"number? takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    res = (nt!=NT_OTHER ? YES : NO);

    value = [[Boolean alloc] initSCMBoolean:res];
    return YES;
}

@end

@implementation PRMEqPred

- (NSString *)primName
{
    return @"eq?";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id itema, itemb;
    BOOL res = NO;
    
    if(offs+2!=[args count]){
        errmsg = @"eq? takes two arguments";
        return NO;
    }

    itema = [args objectAtIndex:offs];
    itemb = [args objectAtIndex:offs+1];

    value = [[Boolean alloc] initSCMBoolean:isEqual(itema, itemb)];
    return YES;
}

@end

@implementation PRMNot

- (NSString *)primName
{
    return @"not";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+1!=[args count]){
        errmsg = @"not takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    value = [[Boolean alloc] initSCMBoolean:isFalse(item)];
    return YES;
}

@end

@implementation PRMNumEqual

- (NSString *)primName
{
    return @"=";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int icur, ires = 0; double dcur, dres = 0;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    BOOL res = YES;

    if(nt==NT_OTHER){
        errmsg = @"Arguments to = must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        ires = [[args objectAtIndex:offs] intVal];
        for(pos=offs+1; pos<[args count]; pos++){
            icur = [[args objectAtIndex:pos] intVal];
            if(!(ires==icur)){
                res = NO;
                break;
            }
            ires = icur;
        }
    }
    else{
        dres = [[args objectAtIndex:offs] doubleVal];
        for(pos=offs+1; pos<[args count]; pos++){
            dcur = [[args objectAtIndex:pos] doubleVal];
            if(!(dres==dcur)){
                res = NO;
                break;
            }
            dres = dcur;
        }
    }

    value = [[Boolean alloc] initSCMBoolean:res];
    return YES;
}

@end

@implementation PRMNumLT

- (NSString *)primName
{
    return @"<";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int icur, ires = 0; double dcur, dres = 0;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    BOOL res = YES;

    if(nt==NT_OTHER){
        errmsg = @"Arguments to < must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        ires = [[args objectAtIndex:offs] intVal];
        for(pos=offs+1; pos<[args count]; pos++){
            icur = [[args objectAtIndex:pos] intVal];
            if(!(ires<icur)){
                res = NO;
                break;
            }
            ires = icur;
        }
    }
    else{
        dres = [[args objectAtIndex:offs] doubleVal];
        for(pos=offs+1; pos<[args count]; pos++){
            dcur = [[args objectAtIndex:pos] doubleVal];
            if(!(dres<dcur)){
                res = NO;
                break;
            }
            dres = dcur;
        }
    }

    value = [[Boolean alloc] initSCMBoolean:res];
    return YES;
}

@end

@implementation PRMNumGT

- (NSString *)primName
{
    return @">";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int icur, ires = 0; double dcur, dres = 0;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    BOOL res = YES;

    if(nt==NT_OTHER){
        errmsg = @"Arguments to > must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        ires = [[args objectAtIndex:offs] intVal];
        for(pos=offs+1; pos<[args count]; pos++){
            icur = [[args objectAtIndex:pos] intVal];
            if(!(ires>icur)){
                res = NO;
                break;
            }
            ires = icur;
        }
    }
    else{
        dres = [[args objectAtIndex:offs] doubleVal];
        for(pos=offs+1; pos<[args count]; pos++){
            dcur = [[args objectAtIndex:pos] doubleVal];
            if(!(dres>dcur)){
                res = NO;
                break;
            }
            dres = dcur;
        }
    }

    value = [[Boolean alloc] initSCMBoolean:res];
    return YES;
}

@end

@implementation PRMPlus

- (NSString *)primName
{
    return @"+";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int ires = 0; double dres = 0;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];

    if(nt==NT_OTHER){
        errmsg = @"Arguments to + must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        for(pos=offs; pos<[args count]; pos++){
            ires += [[args objectAtIndex:pos] intVal];
        }

        value = [[Int alloc] initSCMInt:ires];
        return YES;
    }
    
    for(pos=offs; pos<[args count]; pos++){
        dres += [[args objectAtIndex:pos] doubleVal];
    }
    
    value = [[Double alloc] initSCMDouble:dres];
    return YES;
}

@end

@implementation PRMTimes

- (NSString *)primName
{
    return @"*";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int ires = 1; double dres = 1;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];

    if(nt==NT_OTHER){
        errmsg = @"Arguments to * must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        for(pos=offs; pos<[args count]; pos++){
            ires *= [[args objectAtIndex:pos] intVal];
        }

        value = [[Int alloc] initSCMInt:ires];
        return YES;
    }
    
    for(pos=offs; pos<[args count]; pos++){
        dres *= [[args objectAtIndex:pos] doubleVal];
    }
    
    value = [[Double alloc] initSCMDouble:dres];
    return YES;
}

@end

@implementation PRMMinus

- (NSString *)primName
{
    return @"-";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int ires = 1; double dres = 1;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];

    if(offs==[args count]){
        errmsg = @"- needs at least one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to - must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        ires = [[args objectAtIndex:offs] intVal];
        if(offs+1==[args count]){
            ires = -ires;
        }
        else{
            for(pos=offs+1; pos<[args count]; pos++){
                ires -= [[args objectAtIndex:pos] intVal];
            }
        }
        value = [[Int alloc] initSCMInt:ires];
        return YES;
    }
    
    dres = [[args objectAtIndex:offs] doubleVal];
    if(offs+1==[args count]){
        dres = -dres;
    }
    else{
        for(pos=offs+1; pos<[args count]; pos++){
            dres -= [[args objectAtIndex:pos] doubleVal];
        }
    }
    value = [[Double alloc] initSCMDouble:dres];
    return YES;
}

@end

@implementation PRMDivide

- (NSString *)primName
{
    return @"/";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    int ires = 1; double dres = 1;
    int pos = offs;
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];

    if(offs==[args count]){
        errmsg = @"/ needs at least one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to / must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
        ires = [[args objectAtIndex:offs] intVal];
        if(offs+1==[args count]){
            if(ires!=1){
                errmsg = @"no integer fractions";
                return NO;
            }
        }
        else{
            for(pos=offs+1; pos<[args count]; pos++){
                ires /= [[args objectAtIndex:pos] intVal];
            }
        }
        value = [[Int alloc] initSCMInt:ires];
        return YES;
    }
    
    dres = [[args objectAtIndex:offs] doubleVal];
    if(offs+1==[args count]){
        dres = ((double)1.0)/dres;
    }
    else{
        for(pos=offs+1; pos<[args count]; pos++){
            dres /= [[args objectAtIndex:pos] doubleVal];
        }
    }
    value = [[Double alloc] initSCMDouble:dres];
    return YES;
}

@end

@implementation PRMRandom

- (NSString *)primName
{
    return @"random";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];

    if(offs+1!=[args count]){
        errmsg = @"random takes exactly one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"argument to random must be numeric";
        return NO;
    }

    if(nt==NT_INTEGERS){
	int v = [[args objectAtIndex:offs] intVal];
	value = [[Int alloc] initSCMInt:(lrand48() % v)];
    }
    else{
	double v = [[args objectAtIndex:offs] doubleVal];
	value = [[Double alloc] initSCMDouble:(drand48() * v)];
    }

    return YES;
}

@end

@implementation PRMQuotient

- (NSString *)primName
{
    return @"quotient";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    int a, b;

    if(offs+2!=[args count]){
        errmsg = @"quotient takes exactly two arguments";
        return NO;
    }

    if(nt!=NT_INTEGERS){
        errmsg = @"Arguments to quotient must be integers";
        return NO;
    }

    a = [[args objectAtIndex:offs] intVal];
    b = [[args objectAtIndex:offs+1] intVal];

    if(!b){
        errmsg = @"divide by zero error in quotient";
        return NO;
    }

    value = [[Int alloc] initSCMInt:(a/b)];
    return YES;
}

@end

@implementation PRMRemainder

- (NSString *)primName
{
    return @"remainder";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    int a, b;

    if(offs+2!=[args count]){
        errmsg = @"remainder takes exactly two arguments";
        return NO;
    }

    if(nt!=NT_INTEGERS){
        errmsg = @"Arguments to remainder must be integers";
        return NO;
    }

    a = [[args objectAtIndex:offs] intVal];
    b = [[args objectAtIndex:offs+1] intVal];

    if(!b){
        errmsg = @"divide by zero error in remainder";
        return NO;
    }

    value = [[Int alloc] initSCMInt:(a%b)];
    return YES;
}

@end

@implementation PRMList

- (NSString *)primName
{
    return @"list";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id res = [NSNull null];
    int pos;
    
    for(pos=[args count]-1; pos>=offs; pos--){
        res = [Pair newCar:[args objectAtIndex:pos] Cdr:res];
    }

    value = res;
    return YES;
}

@end

@implementation PRMCons

- (NSString *)primName
{
    return @"cons";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+2!=[args count]){
        errmsg = @"cons takes exactly two arguments";
        return NO;
    }

    value = [Pair 
                newCar:[args objectAtIndex:offs] 
                Cdr:[args objectAtIndex:offs+1]];
    return YES;
}

@end

@implementation PRMCar

- (NSString *)primName
{
    return @"car";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+1!=[args count]){
        errmsg = @"car takes exactly one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];
    if(isPair(item)==NO){
        errmsg = @"argument to car must be a pair";
        return NO;
    }

    value = [item car];
    return YES;
}

@end

@implementation PRMCdr

- (NSString *)primName
{
    return @"cdr";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+1!=[args count]){
        errmsg = @"cdr takes exactly one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];
    if(isPair(item)==NO){
        errmsg = @"argument to cdr must be a pair";
        return NO;
    }

    value = [item cdr];
    return YES;
}

@end

@implementation PRMSetCar

- (NSString *)primName
{
    return @"set-car!";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+2!=[args count]){
        errmsg = @"set-car! takes two arguments";
        return NO;
    }

    item = [args objectAtIndex:offs];
    if(isPair(item)==NO){
        errmsg = @"argument to set-car! must be a pair";
        return NO;
    }

    [item setcar:[args objectAtIndex:(offs+1)]];

    value = [item car];
    return YES;
}

@end

@implementation PRMSetCdr

- (NSString *)primName
{
    return @"set-cdr!";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs+2!=[args count]){
        errmsg = @"set-cdr! takes two arguments";
        return NO;
    }

    item = [args objectAtIndex:offs];
    if(isPair(item)==NO){
        errmsg = @"argument to set-cdr! must be a pair";
        return NO;
    }

    [item setcdr:[args objectAtIndex:(offs+1)]];

    value = [item cdr];
    return YES;
}

@end

@implementation PRMDisplay

- (NSString *)primName
{
    return @"display";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    NSString *res;

    if(offs+1!=[args count]){
        errmsg = @"display takes one argument";
        return NO;
    }

    item = [args objectAtIndex:offs];

    if(isString(item)){
        res = [NSString
                  stringWithFormat:@"%@", [item strVal]];
    }
    else if(isChar(item)){
        res = [NSString
                  stringWithFormat:@"%c", [item charVal]];
    }
    else{
        res = [VScheme valToString:item];
    }
    [vm appendToOutput:res];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMNewline

- (NSString *)primName
{
    return @"newline";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id item;
    
    if(offs!=[args count]){
        errmsg = @"newline takes no arguments";
        return NO;
    }

    [vm appendToOutput:@"\n"];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawMove
- (NSString *)primName
{
    return @"draw-move";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+2!=[args count]){
        errmsg = @"draw-move takes two arguments";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to draw-move must be numeric";
        return NO;
    }

    inst.what = DRAW_MOVE;
    inst.data.coord.x = [[args objectAtIndex:offs] doubleVal];
    inst.data.coord.y = [[args objectAtIndex:offs+1] doubleVal];

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawLine
- (NSString *)primName
{
    return @"draw-line";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+2!=[args count]){
        errmsg = @"draw-line takes two arguments";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to draw-line must be numeric";
        return NO;
    }

    inst.what = DRAW_LINE;
    inst.data.coord.x = [[args objectAtIndex:offs] doubleVal];
    inst.data.coord.y = [[args objectAtIndex:offs+1] doubleVal];

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawColor
- (NSString *)primName
{
    return @"draw-color";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+3!=[args count]){
        errmsg = @"draw-color takes three arguments";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to draw-color must be numeric";
        return NO;
    }

    inst.what = DRAW_COLOR;
    inst.data.color[0] = [[args objectAtIndex:offs] doubleVal];
    inst.data.color[1] = [[args objectAtIndex:offs+1] doubleVal];
    inst.data.color[2] = [[args objectAtIndex:offs+2] doubleVal];

    if(inst.data.color[0]<(float)0 || 
       inst.data.color[0]>(float)255){
        errmsg = @"red color component out of range (0..255)";
        return NO;
    }
    if(inst.data.color[1]<(float)0 || 
       inst.data.color[1]>(float)255){
        errmsg = @"green color component out of range (0..255)";
        return NO;
    }
    if(inst.data.color[2]<(float)0 || 
       inst.data.color[2]>(float)255){
        errmsg = @"blue color component out of range (0..255)";
        return NO;
    }

    inst.data.color[0]/=(float)255;
    inst.data.color[1]/=(float)255;
    inst.data.color[2]/=(float)255;

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawCircle
- (NSString *)primName
{
    return @"draw-circle";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+1!=[args count]){
        errmsg = @"draw-circle takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to draw-circle must be numeric";
        return NO;
    }

    inst.what = DRAW_CIRCLE;
    inst.data.radius = [[args objectAtIndex:offs] doubleVal];

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMFillCircle
- (NSString *)primName
{
    return @"fill-circle";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+1!=[args count]){
        errmsg = @"fill-circle takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to fill-circle must be numeric";
        return NO;
    }

    inst.what = FILL_CIRCLE;
    inst.data.radius = [[args objectAtIndex:offs] doubleVal];

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawRect
- (NSString *)primName
{
    return @"draw-rect";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+2!=[args count]){
        errmsg = @"draw-rect takes two arguments";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Arguments to draw-rect must be numeric";
        return NO;
    }

    inst.what = DRAW_RECT;
    inst.data.size = 
	NSMakeSize([[args objectAtIndex:offs] doubleVal],
		   [[args objectAtIndex:offs+1] doubleVal]);

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMFillRect
- (NSString *)primName
{
    return @"fill-rect";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    DrawInst inst;

    if(offs+2!=[args count]){
        errmsg = @"fill-rect takes two arguments";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to fill-rect must be numeric";
        return NO;
    }

    inst.what = FILL_RECT;
    inst.data.size = 
	NSMakeSize([[args objectAtIndex:offs] doubleVal],
		   [[args objectAtIndex:offs+1] doubleVal]);

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawFont
- (NSString *)primName
{
    return @"draw-font";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    DrawInst inst;

    if(offs+2!=[args count]){
        errmsg = @"draw-font takes two arguments";
        return NO;
    }

    String *fontName = [args objectAtIndex:offs];
    if(isString(fontName)==NO){
        errmsg = @"draw-font: font name must be a string";
        return NO;
    }

    NSString *fontNameStr = [fontName strVal];
    if([[[NSFontManager sharedFontManager]
	    availableFonts] containsObject:fontNameStr]==NO){
        errmsg = 
	    [[NSString alloc]
		initWithFormat:@"draw-font: no such font (%@)", fontNameStr];
        return NO;
    }

    id size = [args objectAtIndex:offs+1];
    if(isInt(size)==NO && isDouble(size)==NO){
        errmsg = @"draw-font: size must be a number";
        return NO;
    }

    float sizeVal = (float)[size doubleVal];
    NSFont *font = [NSFont fontWithName:fontNameStr size:sizeVal];
    [font retain];

    inst.what = DRAW_FONT;
    inst.data.font = font;

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMDrawString
- (NSString *)primName
{
    return @"draw-string";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    DrawInst inst;

    if(offs+1!=[args count]){
        errmsg = @"draw-string takes one argument";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"draw-string: string required";
        return NO;
    }

    NSString *string = [NSString stringWithString:[str strVal]];
    [string retain];

    inst.what = DRAW_STRING;
    inst.data.string = string;

    [vm recordImgInst:inst];

    value = [NSNull null];
    return YES;
}

@end


@implementation PRMDrawShow
- (NSString *)primName
{
    return @"draw-show";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs!=[args count]){
        errmsg = @"draw-show takes no argument";
        return NO;
    }

    [vm produceImage];
    [vm clearImage];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMSin
- (NSString *)primName
{
    return @"sin";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res;

    if(offs+1!=[args count]){
        errmsg = @"sin takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to sin must be numeric";
        return NO;
    }

    res = sin([[args objectAtIndex:offs] doubleVal]);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMCos
- (NSString *)primName
{
    return @"cos";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res;

    if(offs+1!=[args count]){
        errmsg = @"cos takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to cos must be numeric";
        return NO;
    }

    res = cos([[args objectAtIndex:offs] doubleVal]);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMTan
- (NSString *)primName
{
    return @"tan";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res;

    if(offs+1!=[args count]){
        errmsg = @"tan takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to tan must be numeric";
        return NO;
    }

    res = tan([[args objectAtIndex:offs] doubleVal]);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMExp
- (NSString *)primName
{
    return @"exp";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res;

    if(offs+1!=[args count]){
        errmsg = @"exp takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to exp must be numeric";
        return NO;
    }

    res = exp([[args objectAtIndex:offs] doubleVal]);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMLog
- (NSString *)primName
{
    return @"log";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double v, res;

    if(offs+1!=[args count]){
        errmsg = @"log takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to log must be numeric";
        return NO;
    }

    v = [[args objectAtIndex:offs] doubleVal];
    if(v<=0.0){
        errmsg = @"Argument to log must be positive";
        return NO;
    }

    res = log(v);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMATan
- (NSString *)primName
{
    return @"atan";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res, v;

    if(offs+1!=[args count]){
        errmsg = @"atan takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to atan must be numeric";
        return NO;
    }

    v = [[args objectAtIndex:offs] doubleVal];
    res = atan(v);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMASin
- (NSString *)primName
{
    return @"asin";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res, v;

    if(offs+1!=[args count]){
        errmsg = @"asin takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to asin must be numeric";
        return NO;
    }

    v = [[args objectAtIndex:offs] doubleVal];
    if(v<(double)-1.0 || (double)1.0<v){
        errmsg = @"Argument to asin out of range";
        return NO;
    }

    res = asin(v);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMACos
- (NSString *)primName
{
    return @"acos";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double res, v;

    if(offs+1!=[args count]){
        errmsg = @"acos takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to acos must be numeric";
        return NO;
    }

    v = [[args objectAtIndex:offs] doubleVal];
    if(v<(double)-1.0 || (double)1.0<v){
        errmsg = @"Argument to acos out of range";
        return NO;
    }

    res = acos(v);
    value = [[Double alloc] initSCMDouble:res];
    return YES;
}

@end

@implementation PRMSqrt
- (NSString *)primName
{
    return @"sqrt";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NUMTYPE nt = [self checkArgsNumeric:args offset:offs];
    double v, res; int ires;
    id item;

    if(offs+1!=[args count]){
        errmsg = @"sqrt takes one argument";
        return NO;
    }

    if(nt==NT_OTHER){
        errmsg = @"Argument to sqrt must be numeric";
        return NO;
    }

    item = [args objectAtIndex:offs]; v = [item doubleVal];

    if(v<0){
        errmsg = @"Argument to sqrt must not be negative";
        return NO;
    }

    res  = sqrt([item doubleVal]); 
    ires = (int)res;

    if(nt==NT_INTEGERS && ires*ires==[item intVal]){
        value = [[Int alloc] initSCMInt:ires];
    }
    else{
        value = [[Double alloc] initSCMDouble:res];
    }

    return YES;
}

@end

@implementation PRMMakeVector
- (NSString *)primName
{
    return @"make-vector";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id filler;
    id count;
    int cval;

    if(offs+1==[args count]){
        filler = [NSNull null];
    }
    else if(offs+2==[args count]){
        filler = [args objectAtIndex:offs+1];
    }
    else{
        errmsg = @"make-vector takes one or two arguments";
        return NO;
    }

    count = [args objectAtIndex:offs];

    if(isInt(count)==NO){
        errmsg = @"make-vector: integer required";
        return NO;
    }

    cval = [count intVal];

    if(cval<0){
        errmsg = @"make-vector: non-negative integer required";
        return NO;
    }

    value = [Vector newWithItem:filler count:cval];

    return YES;
}


@end

@implementation PRMListToVector
- (NSString *)primName
{
    return @"list->vector";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id list;

    if(offs+1!=[args count]){
        errmsg = @"list->vector takes one argument";
        return NO;
    }

    list = [args objectAtIndex:offs];

    if(isPair(list)==NO && list!=[NSNull null]){
        errmsg = @"list->vector: list required";
        return NO;
    }

    value = [Vector newFromList:list];

    return YES;
}


@end

@implementation PRMVectorToList
- (NSString *)primName
{
    return @"vector->list";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    Vector *vect;
    Pair *result;
    id *data;
    int index;

    if(offs+1!=[args count]){
        errmsg = @"vector->list takes one argument";
        return NO;
    }

    vect = [args objectAtIndex:offs];

    if(isVector(vect)==NO){
        errmsg = @"vector->list: vector required";
        return NO;
    }

    data = [vect entries];

    for(index=[vect count]-1, result=(Pair *)[NSNull null];
        index>=0; index--){
        result = 
            [Pair newCar:data[index] Cdr:result];
    }

    value = result;

    return YES;
}

@end

@implementation PRMVectorLength
- (NSString *)primName
{
    return @"vector-length";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    Vector *vect;

    if(offs+1!=[args count]){
        errmsg = @"vector-length takes one argument";
        return NO;
    }

    vect = [args objectAtIndex:offs];

    if(isVector(vect)==NO){
        errmsg = @"vector-length: vector required";
        return NO;
    }

    value = [[Int alloc] initSCMInt:[vect count]];

    return YES;
}

@end

@implementation PRMVectorRef
- (NSString *)primName
{
    return @"vector-ref";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id *data;
    Vector *vect;
    int count, index;
    Int *ind;

    if(offs+2!=[args count]){
        errmsg = @"vector-ref takes two arguments";
        return NO;
    }

    vect = [args objectAtIndex:offs];
    if(isVector(vect)==NO){
        errmsg = @"vector-ref: vector required";
        return NO;
    }

    data = [vect entries]; count = [vect count];

    ind = [args objectAtIndex:offs+1];
    if(isInt(ind)==NO){
        errmsg = @"vector-ref: integer required";
        return NO;
    }

    index = [ind intVal];
    if(index<0 || index>=count){
        errmsg = @"vector-ref: index out of bounds";
        return NO;
    }

    value = data[index];

    return YES;
}

@end

@implementation PRMVectorSet
- (NSString *)primName
{
    return @"vector-set!";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id *data;
    Vector *vect;
    int count, index;
    Int *ind;
    id obj;

    if(offs+3!=[args count]){
        errmsg = @"vector-set! takes three arguments";
        return NO;
    }

    vect = [args objectAtIndex:offs];
    if(isVector(vect)==NO){
        errmsg = @"vector-set!: vector required";
        return NO;
    }

    data = [vect entries]; count = [vect count];

    ind = [args objectAtIndex:offs+1];
    if(isInt(ind)==NO){
        errmsg = @"vector-set!: integer required";
        return NO;
    }

    index = [ind intVal];
    if(index<0 || index>=count){
        errmsg = @"vector-set!: index out of bounds";
        return NO;
    }

    obj = [args objectAtIndex:offs+2];

    data[index] = obj; [obj retain];

    value = obj;

    return YES;
}

@end

@implementation PRMVectorFill
- (NSString *)primName
{
    return @"vector-fill!";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id *data;
    Vector *vect;
    int count, index;
    id obj;

    if(offs+2!=[args count]){
        errmsg = @"vector-fill! takes two arguments";
        return NO;
    }

    vect = [args objectAtIndex:offs];
    if(isVector(vect)==NO){
        errmsg = @"vector-fill!: vector required";
        return NO;
    }

    data = [vect entries]; count = [vect count];

    obj = [args objectAtIndex:offs+1];
    for(index=0; index<count; index++){
        data[index] = obj; [obj retain];
    }

    value = obj;

    return YES;
}

@end

@implementation PRMSymToStr
- (NSString *)primName
{
    return @"symbol->string";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"symbol->string takes one argument";
        return NO;
    }

    Symbol *sym = [args objectAtIndex:offs];
    if(isSymbol(sym)==NO){
        errmsg = @"symbol->string: symbol required";
        return NO;
    }

    value = [[String alloc] 
		initSCMString:(char *)[[sym symVal] cString]];
    return YES;
}

@end


@implementation PRMStrToSym
- (NSString *)primName
{
    return @"string->symbol";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"string->symbol takes one argument";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"string->symbol: string required";
        return NO;
    }

    value = [[Symbol alloc] 
		initSCMSymbol:(char *)[[str strVal] cString]];
    return YES;
}

@end

@implementation PRMStringSize
- (NSString *)primName
{
    return @"string-size";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+3!=[args count]){
        errmsg = @"string-size takes three arguments";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"string-size: string required";
        return NO;
    }

    String *fontName = [args objectAtIndex:offs+1];
    if(isString(fontName)==NO){
        errmsg = @"string-size: font name must be a string";
        return NO;
    }

    NSString *fontNameStr = [fontName strVal];
    if([[[NSFontManager sharedFontManager]
	    availableFonts] containsObject:fontNameStr]==NO){
        errmsg = 
	    [[NSString alloc]
		initWithFormat:@"string-size: no such font (%@)", fontNameStr];
        return NO;
    }

    id size = [args objectAtIndex:offs+2];
    if(isInt(size)==NO && isDouble(size)==NO){
        errmsg = @"string-size: size must be a number";
        return NO;
    }

    float sizeVal = (float)[size doubleVal];
    NSFont *font = [NSFont fontWithName:fontNameStr size:sizeVal];

    NSDictionary *attr = 
	[NSDictionary dictionaryWithObjectsAndKeys:font, NSFontAttributeName, nil];
    NSSize result = [[str strVal] sizeWithAttributes:attr];

    value = 
	[Pair 
	    newCar:[[Double alloc] initSCMDouble:result.width]
	    Cdr:[[Double alloc] initSCMDouble:result.height]];
    return YES;
}

@end

@implementation PRMStringLength
- (NSString *)primName
{
    return @"string-length";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"string-length takes three arguments";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"string-length: string required";
        return NO;
    }

    value = [[Int alloc] initSCMInt:[[str strVal] length]];
    return YES;
}

@end

@implementation PRMCharToInt
- (NSString *)primName
{
    return @"char->integer";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"char->integer takes one argument";
        return NO;
    }

    Char *ch = [args objectAtIndex:offs];
    if(isChar(ch)==NO){
        errmsg = @"char->integer: character required";
        return NO;
    }

    value = [[Int alloc] 
		initSCMInt:(long int)[ch charVal]];
    return YES;
}

@end

@implementation PRMIntToChar
- (NSString *)primName
{
    return @"integer->char";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"integer->char takes one argument";
        return NO;
    }

    Int *i = [args objectAtIndex:offs];
    if(isInt(i)==NO){
        errmsg = @"integer->char: character required";
        return NO;
    }

    value = [[Char alloc] 
		initSCMChar:(char)[i intVal]];
    return YES;
}

@end


@implementation PRMStringRef
- (NSString *)primName
{
    return @"string-ref";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+2!=[args count]){
        errmsg = @"string-ref takes two argument";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"string-ref: string required";
        return NO;
    }

    Int *i = [args objectAtIndex:offs+1];
    if(isInt(i)==NO){
        errmsg = @"string-ref: integer position required";
        return NO;
    }
    int pos = [i intVal];

    NSString *theStr = [str strVal];
    if(pos>=[theStr length]){
        errmsg = @"string-ref: index out of range";
        return NO;
    }

    value = [[Char alloc] initSCMChar:[theStr characterAtIndex:pos]];
    return YES;
}

@end

@implementation PRMListToStr
- (NSString *)primName
{
    return @"list->string";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"list->string takes one argument";
        return NO;
    }

    Pair *p = [args objectAtIndex:offs];
    if(isPair(p)==NO && [NSNull null]!=(id)p){
        errmsg = @"list->string: pair required";
        return NO;
    }
    
    int cpos = 0, cmax = 0;
    while(isPair(p)){
	if(isChar([p car])==NO){
	    errmsg = @"list->string: character required";
	    return NO;
	}
	p = [p cdr];
	cmax++;
    }

    char buf[cmax+1];
    p = [args objectAtIndex:offs];

    while(isPair(p)){
	Char *ch = [p car];
	buf[cpos++] = [ch charVal];

	p = [p cdr];
    }
    buf[cpos] = 0;

    value = [[String alloc] initSCMString:buf];
    return YES;
}

@end

@implementation PRMStrToList
- (NSString *)primName
{
    return @"string->list";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count]){
        errmsg = @"string->list takes one argument";
        return NO;
    }

    String *str = [args objectAtIndex:offs];
    if(isString(str)==NO){
        errmsg = @"string->list: string required";
        return NO;
    }

    NSString *theStr = [str strVal];

    id result = [NSNull null];
    int cmax = [theStr length], cpos;

    cpos = cmax-1;
    while(cpos>=0){
	char c = [theStr characterAtIndex:cpos];
	result = 
	    [Pair 
                newCar:[[Char alloc] initSCMChar:c]
                Cdr:result];
	cpos--;
    }

    value = result;
    return YES;
}

@end

@implementation PRMStringAppend
- (NSString *)primName
{
    return @"string-append";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    NSString *result = @"";

    int cpos = offs, cmax = [args count];
    while(cpos<cmax){
	String *str = [args objectAtIndex:cpos];
	if(isString(str)==NO){
	    errmsg = @"string-append: string required";
	    return NO;
	}
	
	result = [result stringByAppendingString:[str strVal]];
	cpos++;
    }

    value = [[String alloc] initSCMString:(char *)[result cString]];
    return YES;
}

@end

@implementation PRMMakeString
- (NSString *)primName
{
    return @"make-string";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count] && offs+2!=[args count]){
        errmsg = @"make-string takes one or two arguments";
        return NO;
    }

    Int *i = [args objectAtIndex:offs];
    if(isInt(i)==NO){
        errmsg = @"make-string: integer required";
        return NO;
    }
    int pos = 0, count = [i intVal];

    char fill = ' ';
    if(offs+2==[args count]){
	Char *ch = [args objectAtIndex:offs+1];
	if(isChar(ch)==NO){
	    errmsg = @"make-string: character required";
	    return NO;
	}
	fill = [ch charVal];
    }

    char buf[count+1];
    while(pos<count){
	buf[pos++] = fill;
    }
    buf[pos] = 0;

    value = [[String alloc] initSCMString:buf];
    return YES;
}

@end

@implementation PRMNumberToStr
- (NSString *)primName
{
    return @"number->string";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs+1!=[args count] && offs+2!=[args count]){
        errmsg = @"number->string takes one or two arguments";
        return NO;
    }

    id n = [args objectAtIndex:offs];
    if(isInt(n)==NO && isDouble(n)==NO){
        errmsg = @"number->string: int or double required";
        return NO;
    }

    if(isDouble(n)){
	NSNumber *num = [NSNumber numberWithDouble:[n doubleVal]];
	value = [[String alloc] initSCMString:(char *)[[num description] cString]];
	return YES;
    }

    int radix = 10;
    if(offs+2==[args count]){
	Int *r = [args objectAtIndex:offs+1];
	if(isInt(r)==NO){
	    errmsg = @"number->string: radix must be an integer";
	    return NO;
	}
	radix = [r intVal];
	if(radix<2 || radix>36){
	    errmsg = @"number->string: radix must be >= 2 and <= 36";
	    return NO;
	}
    }

    int number = [n intVal];
    if(radix==10 || !number){
	NSNumber *num = [NSNumber numberWithInt:number];
	value = [[String alloc] initSCMString:(char *)[[num description] cString]];
	return YES;
    }

    int sign = 1;
    if(number<0){
	sign = -1;
	number = -number;
    }

    NSString *result = @"";
    while(number>0){
	int digit = number % radix;
	result = 
	    [[NSString stringWithFormat:@"%c", 
		       (digit<10 ? '0' + digit : 'A' + digit-10)]
		stringByAppendingString:result];
	number /= radix;
    }

    if(sign==-1){
	result = [NSString stringWithFormat:@"-%@", result];
    }

    value = [[String alloc] initSCMString:(char *)[result cString]];
    return YES;
}

@end

@implementation PRMFormat
- (NSString *)primName
{
    return @"format";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    if(offs==[args count]){
        errmsg = @"format needs at least one argument";
        return NO;
    }

    String *fmt = [args objectAtIndex:offs++];
    if(isString(fmt)==NO){
        errmsg = @"format: string required";
        return NO;
    }
    const char *fmtStr = [[fmt strVal] cString];

    NSString *result = @"";
    while(*fmtStr){
	NSString *item;

	if(fmtStr[0]=='~'){
	    if(fmtStr[1]){
		switch(fmtStr[1]){
		    case 'a':
		    case 's':
			if(offs==[args count]){
			    errmsg = @"format: ran out of arguments";
			    return NO;
			}

			id cur = [args objectAtIndex:offs++];
			if(isString(cur)){
			    item = [NSString stringWithFormat:@"%@", [cur strVal]];
			}
			else if(isChar(cur)){
			    item = [NSString stringWithFormat:@"%c", [cur charVal]];
			}
			else{
			    item = [VScheme valToString:cur];
			}
			break;
		    case '%':
			item = @"\n";
			break;
		    case '~':
			item = @"~";
		}
		fmtStr++;
	    }
	}
	else{
	    item = [NSString stringWithCString:fmtStr length:1];
	}

	result = [result stringByAppendingString:item];

	fmtStr++;
    }
    
    value = [[String alloc] initSCMString:(char *)[result cString]];
    return YES;
}

@end

@implementation PRMBrowseEnvironment
- (NSString *)primName
{
    return @"browse-environment";
}

- (BOOL)evalVM:(id)vm Args:(NSMutableArray *)args offset:(int)offs
{
    id win;

    if(offs!=[args count]){
        errmsg = @"browse-environment takes no arguments";
        return NO;
    }

    win = [[EnvWindow alloc] initWithEnv:[[vm envStack] lastObject]];
    [[vm delegate] envWindow:win];

    value = [NSNull null];
    return YES;
}

@end

@implementation PRMEval
- (NSString *)primName
{
    return @"eval";
}

@end