

#import <stdio.h>
#import <math.h>
#import "COWSExtendedMathLibrary.h"

@implementation COWSExtendedMathLibrary

#define ERRBFLEN 128

char *ext_needs1 = "ext_needs exactly one parameter";
char *ext_needs2 = "ext_needs exactly two parameters";

static id
COWSExtendedMathErr(id result, const char *fname, const char *errmes)
{
    char buf[ERRBFLEN];

    if (NULL == errmes)
        sprintf(buf, "%s: %s", fname, strerror(errno));
    else 
        sprintf(buf, "%s %s", fname, errmes);
    [result setString: buf];
    [result setError: YES];
    return result;
}


- math_exp: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:exp([arg doubleVal])];
        if (errno) {    // set by exp if error occurred
            result = COWSExtendedMathErr(result, "exp", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "exp", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_ldexp: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:ldexp([arg1 doubleVal], [arg2 intVal])];
        if (errno) {    // set by ldexp if error occurred
            result = COWSExtendedMathErr(result, "ldexp", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "ldexp", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}


- math_hypot: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:hypot([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by hypot if error occurred
            result = COWSExtendedMathErr(result, "hypot", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "hypot", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_cbrt: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:cbrt([arg doubleVal])];
        if (errno) {    // set by cbrt if error occurred
            result = COWSExtendedMathErr(result, "cbrt", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "cbrt", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_expm1: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:expm1([arg doubleVal])];
        if (errno) {    // set by expm1 if error occurred
            result = COWSExtendedMathErr(result, "expm1", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "expm1", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_log1p: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:log1p([arg doubleVal])];
        if (errno) {    // set by log1p if error occurred
            result = COWSExtendedMathErr(result, "log1p", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "log1p", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_lgamma: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:lgamma([arg doubleVal])];
        if (errno) {    // set by lgamma if error occurred
            result = COWSExtendedMathErr(result, "lgamma", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "lgamma", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_rint: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:rint([arg doubleVal])];
        if (errno) {    // set by rint if error occurred
            result = COWSExtendedMathErr(result, "rint", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "rint", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_erf: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:erf([arg doubleVal])];
        if (errno) {    // set by erf if error occurred
            result = COWSExtendedMathErr(result, "erf", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "erf", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_erfc: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:erfc([arg doubleVal])];
        if (errno) {    // set by erfc if error occurred
            result = COWSExtendedMathErr(result, "erfc", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "erfc", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_j0: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:j0([arg doubleVal])];
        if (errno) {    // set by j0 if error occurred
            result = COWSExtendedMathErr(result, "j0", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "j0", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_j1: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:j1([arg doubleVal])];
        if (errno) {    // set by j1 if error occurred
            result = COWSExtendedMathErr(result, "j1", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "j1", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_jn: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:jn([arg1 intVal], [arg2 doubleVal])];
        if (errno) {    // set by jn if error occurred
            result = COWSExtendedMathErr(result, "jn", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "jn", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_y0: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:y0([arg doubleVal])];
        if (errno) {    // set by y0 if error occurred
            result = COWSExtendedMathErr(result, "y0", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "y0", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_y1: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:y1([arg doubleVal])];
        if (errno) {    // set by y1 if error occurred
            result = COWSExtendedMathErr(result, "y1", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "y1", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_yn: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:yn([arg1 intVal], [arg2 doubleVal])];
        if (errno) {    // set by yn if error occurred
            result = COWSExtendedMathErr(result, "yn", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "yn", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_copysign: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:copysign([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by copysign if error occurred
            result = COWSExtendedMathErr(result, "copy-sign", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "copy-sign", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_drem: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:drem([arg1 doubleVal], [arg2 doubleVal])];
        if (errno) {    // set by drem if error occurred
            result = COWSExtendedMathErr(result, "drem", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "drem", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- math_logb: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg = [arg_list pop];

    if(arg && ![arg_list top]) {
      // arg_list should be empty after first parameter
        errno = 0;
        [result setDoubleVal:logb([arg doubleVal])];
        if (errno) {    // set by logb if error occurred
            result = COWSExtendedMathErr(result, "logb", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "logb", ext_needs1);
    }
    if (NULL != arg)
        [arg free];
    return result;
}

- math_scalb: arg_list {
    id result=[[COWSStringNode alloc] init];

    id arg1 = [arg_list pop];
    id arg2 = [arg_list pop];

    if(arg1 && arg2 && ![arg_list top]) {
      // arg_list should be empty after first 2 parameters
        errno = 0;
        [result setDoubleVal:scalb([arg1 doubleVal], [arg2 intVal])];
        if (errno) {    // set by scalb if error occurred
            result = COWSExtendedMathErr(result, "scalb", NULL);
        }
    }
    else {
        result = COWSExtendedMathErr(result, "scalb", ext_needs2);
    }
    if (NULL != arg1)
        [arg1 free];
    if (NULL != arg2)
        [arg2 free];
    return result;
}

- loadLibrary:sender {
    id result = [super loadLibrary:sender];

    if (![sender conformsTo:@protocol(LibraryControl)]) {
        puts ("MathLibrary error: "
              "Interpreter doesn't conform to LibraryControl!");
        return NULL;
    }

     [sender addLibraryFunction: "exp"
                        selector:@selector(math_exp:)
                        target:self];
    [sender addLibraryFunction: "ldexp"
                        selector:@selector(math_ldexp:)
                        target:self];
    [sender addLibraryFunction: "hypot"
                        selector:@selector(math_hypot:)
                        target:self];
    [sender addLibraryFunction: "cbrt"
                        selector:@selector(math_cbrt:)
                        target:self];
    [sender addLibraryFunction: "expm1"
                        selector:@selector(math_expm1:)
                        target:self];
    [sender addLibraryFunction: "log1p"
                        selector:@selector(math_log1p:)
                        target:self];
    [sender addLibraryFunction: "lgamma"
                        selector:@selector(math_lgamma:)
                        target:self];
    [sender addLibraryFunction: "rint"
                        selector:@selector(math_rint:)
                        target:self];
    [sender addLibraryFunction: "erf"
                        selector:@selector(math_erf:)
                        target:self];
    [sender addLibraryFunction: "erfc"
                        selector:@selector(math_erfc:)
                        target:self];
    [sender addLibraryFunction: "j0"
                        selector:@selector(math_j0:)
                        target:self];
    [sender addLibraryFunction: "j1"
                        selector:@selector(math_j1:)
                        target:self];
    [sender addLibraryFunction: "jn"
                        selector:@selector(math_jn:)
                        target:self];
    [sender addLibraryFunction: "y0"
                        selector:@selector(math_y0:)
                        target:self];
    [sender addLibraryFunction: "y1"
                        selector:@selector(math_y1:)
                        target:self];
    [sender addLibraryFunction: "yn"
                        selector:@selector(math_yn:)
                        target:self];
    [sender addLibraryFunction: "copy-sign"
                        selector:@selector(math_copysign:)
                        target:self];
    [sender addLibraryFunction: "drem"
                        selector:@selector(math_drem:)
                        target:self];
    [sender addLibraryFunction: "logb"
                        selector:@selector(math_logb:)
                        target:self];
    [sender addLibraryFunction: "scalb"
                        selector:@selector(math_scalb:)
                        target:self];
    
    return result;
}

@end
