This is COWSStandardLibrary.m in view mode; [Download] [Up]
/*
Copyright (C) 1994 Sean Luke
COWSStandardLibrary.m
Version 1.0
Sean Luke
*/
#import "COWSStandardLibrary.h"
#import <stdio.h>
@implementation COWSStandardLibrary
- loadLibrary:sender
{
id returnval=[super loadLibrary:sender];
if (![sender conformsTo:@protocol(LibraryControl)])
{
printf ("StandardLibrary error: Interpreter cannot accept Library Control protocol!\n");
return NULL;
}
[sender addLibraryFunction:"="
selector:@selector(COWSfunc_equal:)
target:self];
[sender addLibraryFunction:">"
selector:@selector(COWSfunc_greater:)
target:self];
[sender addLibraryFunction:"<"
selector:@selector(COWSfunc_lesser:)
target:self];
[sender addLibraryFunction:"+"
selector:@selector(COWSfunc_add:)
target:self];
[sender addLibraryFunction:"-"
selector:@selector(COWSfunc_subtract:)
target:self];
[sender addLibraryFunction:"*"
selector:@selector(COWSfunc_multiply:)
target:self];
[sender addLibraryFunction:"/"
selector:@selector(COWSfunc_divide:)
target:self];
[sender addLibraryFunction:"print"
selector:@selector(COWSfunc_print:)
target:self];
[sender addLibraryFunction:"and"
selector:@selector(COWSfunc_and:)
target:self];
[sender addLibraryFunction:"or"
selector:@selector(COWSfunc_or:)
target:self];
[sender addLibraryFunction:"not"
selector:@selector(COWSfunc_not:)
target:self];
[sender addLibraryFunction:"concatenate"
selector:@selector(COWSfunc_concatenate:)
target:self];
[sender addLibraryFunction:"quote"
selector:@selector(COWSfunc_quote:)
target:self];
[sender addLibraryFunction:"is"
selector:@selector(COWSfunc_is:)
target:self];
[sender addLibraryFunction:"do"
selector:@selector(COWSfunc_do:)
target:self];
[sender addLibraryFunction:"do-first"
selector:@selector(COWSfunc_dofirst:)
target:self];
[sender addLibraryFunction:"error"
selector:@selector(COWSfunc_error:)
target:self];
return returnval;
}
- COWSfunc_equal:arg_list // numerically compares the first
// value against all the other values.
// if they are equal, returns t.
// returns f if there are no values,
// or in any other situation.
{
double first;
BOOL success=YES;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=[current doubleVal];
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (first!=[current doubleVal])
{
success=NO;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
return return_val;
}
- COWSfunc_greater:arg_list // numerically compares the first
// value against all the other values.
// if it is greater, returns t.
// returns f if there are no values,
// or in any other situation.
{
double first;
BOOL success=YES;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=[current doubleVal];
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (first<=[current doubleVal])
{
success=NO;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
return return_val;
}
- COWSfunc_lesser:arg_list // numerically compares the first
// value against all the other values.
// if it is smaller, returns t.
// returns f if there are no values,
// or in any other situation.
{
double first;
BOOL success=YES;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=[current doubleVal];
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (first>=[current doubleVal])
{
success=NO;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
return return_val;
}
- COWSfunc_is:arg_list // string-compares the first
// value against all the other values.
// if it the same, returns t.
// returns f if there are no values,
// or in any other situation.
{
char* first;
BOOL success=NO;
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL) // no args
{
[return_val setBooleanVal:NO];
return return_val;
}
else
{
current=[arg_list pop];
first=newstr([current string]);
[current free];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if (!strcmp(first,[current string]))
{
success=YES;
[current free];
break;
}
[current free];
}
if (success)
{
[return_val setBooleanVal:YES];
}
else
{
[return_val setBooleanVal:NO];
}
free(first);
return return_val;
}
- COWSfunc_print:arg_list // prints each argument
// returns first item
{
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]!=NULL)
{
[return_val copyValue:[arg_list top]];
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
printf("%s\n",[current string]);
[current free];
}
return return_val;
}
- COWSfunc_do:arg_list // returns last item
{
id return_val=[[COWSStringNode alloc] init];
id current;
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
[return_val copyValue:current];
// pretty inefficient
[current free];
}
return return_val;
}
- COWSfunc_dofirst:arg_list // returns first item
{
id return_val=[[COWSStringNode alloc] init];
id current=[arg_list top];
if (current!=NULL)
{
[return_val copyValue:current];
}
return return_val;
}
- COWSfunc_not:arg_list // NOTs first item
{
id return_val=[[COWSStringNode alloc] init];
id current=[arg_list top];
if (current!=NULL)
{
if ([current booleanVal]) // string is true
{
[return_val setBooleanVal:NO];
}
else
{
[return_val setBooleanVal:YES];
}
}
return return_val;
}
- COWSfunc_and:arg_list // ANDs items
{
id return_val=[[COWSStringNode alloc] init];
id current;
BOOL result=NO;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=([current booleanVal]);
[current free];
}
else
{
[return_val setString:"or error: nothing to OR against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=result&&([current booleanVal]);
[current free];
}
else
{
[return_val setString:"or error: nothing to OR with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=result&&([current booleanVal]);
[current free];
}
[return_val setBooleanVal: (result ? YES : NO)];
return return_val;
}
- COWSfunc_or:arg_list // ORs items
{
id return_val=[[COWSStringNode alloc] init];
id current;
BOOL result=NO;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=([current booleanVal]);
[current free];
}
else
{
[return_val setString:"or error: nothing to OR against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=result||([current booleanVal]);
[current free];
}
else
{
[return_val setString:"or error: nothing to OR with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=result||([current booleanVal]);
[current free];
}
[return_val setBooleanVal: (result ? YES : NO)];
return return_val;
}
- COWSfunc_add:arg_list // adds items
{
id return_val=[[COWSStringNode alloc] init];
id current;
double result;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=[current doubleVal];
[current free];
}
else
{
[return_val setString:"+ error: nothing to add against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result+=[current doubleVal];
[current free];
}
else
{
[return_val setString:"+ error: nothing to add with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
result+=[current doubleVal];
[current free];
}
[return_val setDoubleVal:result];
return return_val;
}
- COWSfunc_multiply:arg_list // Multiplies items
{
id return_val=[[COWSStringNode alloc] init];
id current;
double result;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=[current doubleVal];
[current free];
}
else
{
[return_val setString:"* error: nothing to multiply against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result*=[current doubleVal];
[current free];
}
else
{
[return_val setString:"* error: nothing to multiply with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
result*=[current doubleVal];
[current free];
}
[return_val setDoubleVal:result];
return return_val;
}
- COWSfunc_subtract:arg_list // Subtracts items
{
id return_val=[[COWSStringNode alloc] init];
id current;
double result;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=[current doubleVal];
[current free];
}
else
{
[return_val setString:"- error: nothing to subtract against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result-=[current doubleVal];
[current free];
}
else
{
[return_val setString:"- error: nothing to subtract with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
result-=[current doubleVal];
[current free];
}
[return_val setDoubleVal:result];
return return_val;
}
- COWSfunc_divide:arg_list // divides items
{
id return_val=[[COWSStringNode alloc] init];
id current;
double result;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
result=[current doubleVal];
[current free];
}
else
{
[return_val setString:"/ error: nothing to divide against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
if ([current doubleVal]==0)
{
[return_val setString:"/ error: zero divide."];
[return_val setError:YES];
[current free];
return return_val;
}
result/=[current doubleVal];
[current free];
}
else
{
[return_val setString:"/ error: nothing to divide with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
current=[arg_list pop];
if ([current doubleVal]==0)
{
[return_val setString:"/ error: zero divide."];
[return_val setError:YES];
[current free];
return return_val;
}
result/=[current doubleVal];
[current free];
}
[return_val setDoubleVal:result];
return return_val;
}
- COWSfunc_concatenate:arg_list
{
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]!=NULL)
{
current=[arg_list pop];
[return_val setString:[current string]];
[current free];
}
else
{
[return_val setString:"concatenate error: nothing to concatenate against."];
[return_val setError:YES];
return return_val;
}
if ([arg_list top]!=NULL)
{
int length;
current=[arg_list pop];
length=strlen([current string])+strlen([return_val string]);
if (1) // just something to get a block...
{
char buf[length+1];
strcpy(buf,[return_val string]);
strcat(buf,[current string]);
buf[length]='\0';
[return_val setString:buf];
}
[current free];
}
else
{
[return_val setString:"concatenate error: nothing to concatenate with."];
[return_val setError:YES];
return return_val;
}
while ([arg_list top]!=NULL)
{
int length;
current=[arg_list pop];
length=strlen([current string])+strlen([return_val string]);
if (1) // just something to get a block...
{
char buf[length+1];
strcpy(buf,[return_val string]);
strcat(buf,[current string]);
buf[length]='\0';
[return_val setString:buf];
}
[current free];
}
return return_val;
}
- COWSfunc_quote:arg_list // returns a double-quote
{
id return_val=[[COWSStringNode alloc] init];
[return_val setString: "\""];
return return_val;
}
- COWSfunc_error:arg_list // prints each argument
// returns first item
{
id return_val=[[COWSStringNode alloc] init];
id current;
if ([arg_list top]==NULL)
{
[return_val setBooleanVal:NO];
}
else
{
current=[arg_list pop];
[return_val copyValue:current];
[current free];
}
[return_val setError:YES];
return return_val;
}
@endThese are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.