mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 22:01:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

Split out 1+, 1-, conjugate, negate

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-11-02 18:28:23 +01:00
parent 2f463fb9ee
commit 70a045f667
8 changed files with 280 additions and 164 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/Makefile.in
View file

@ -54,6 +54,8 @@ OBJS = main.o symbol.o package.o list.o\
numbers/exp.o numbers/expt.o numbers/log.o \
numbers/sqrt.o numbers/abs.o \
numbers/zerop.o numbers/plusp.o numbers/minusp.o \
numbers/negate.o numbers/conjugate.o \
numbers/one_plus.o numbers/one_minus.o \
typespec.o assignment.o \
predicate.o number.o\
num_pred.o num_comp.o num_arith.o num_co.o\

160
src/c/num_arith.d
View file

@ -525,65 +525,6 @@ ecl_minus(cl_object x, cl_object y)
}
}
cl_object
cl_conjugate(cl_object c)
{
switch (type_of(c)) {
case t_complex:
c = ecl_make_complex(c->complex.real,
ecl_negate(c->complex.imag));
case t_fixnum:
case t_bignum:
case t_ratio:
case t_singlefloat:
case t_doublefloat:
#ifdef ECL_LONG_FLOAT
case t_longfloat:
#endif
break;
default:
FEwrong_type_only_arg(@[conjugate], c, @[number]);
}
@(return c)
}
cl_object
ecl_negate(cl_object x)
{
cl_object z, z1;
switch (type_of(x)) {
case t_fixnum:
return ecl_make_integer(-fix(x));
case t_bignum:
return _ecl_big_negate(x);
case t_ratio:
z1 = ecl_negate(x->ratio.num);
z = ecl_alloc_object(t_ratio);
z->ratio.num = z1;
z->ratio.den = x->ratio.den;
return z;
case t_singlefloat:
z = ecl_alloc_object(t_singlefloat);
sf(z) = -sf(x);
return z;
case t_doublefloat:
z = ecl_alloc_object(t_doublefloat);
df(z) = -df(x);
return z;
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return ecl_make_longfloat(-ecl_long_float(x));
#endif
case t_complex:
z = ecl_negate(x->complex.real);
z1 = ecl_negate(x->complex.imag);
return ecl_make_complex(z, z1);
default:
FEwrong_type_only_arg(@[-], x, @[number]);
}
}
/* (/ ) */
@(defun / (num &rest nums)
@
@ -816,107 +757,6 @@ ecl_gcd(cl_object x, cl_object y)
return _ecl_big_gcd(x, y);
}
/* (1+ x) */
cl_object
@1+(cl_object x)
{
/* INV: type check is in ecl_one_plus() */
@(return ecl_one_plus(x))
}
cl_object
ecl_one_plus(cl_object x)
{
cl_object z;
switch (type_of(x)) {
case t_fixnum:
if (x == MAKE_FIXNUM(MOST_POSITIVE_FIXNUM))
return ecl_make_integer(MOST_POSITIVE_FIXNUM+1);
return (cl_object)((cl_fixnum)x + ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG));
case t_bignum:
return(ecl_plus(x, MAKE_FIXNUM(1)));
case t_ratio:
z = ecl_plus(x->ratio.num, x->ratio.den);
return ecl_make_ratio(z, x->ratio.den);
case t_singlefloat:
z = ecl_alloc_object(t_singlefloat);
sf(z) = sf(x) + 1.0;
return(z);
case t_doublefloat:
z = ecl_alloc_object(t_doublefloat);
df(z) = df(x) + 1.0;
return(z);
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return ecl_make_longfloat(1.0 + ecl_long_float(x));
#endif
case t_complex:
z = ecl_one_plus(x->complex.real);
return ecl_make_complex(z, x->complex.imag);
default:
FEwrong_type_only_arg(@[1+], x, @[number]);
}
}
/* (1- x) */
cl_object
@1-(cl_object x)
{ /* INV: type check is in ecl_one_minus() */
@(return ecl_one_minus(x))
}
cl_object
ecl_one_minus(cl_object x)
{
cl_object z;
switch (type_of(x)) {
case t_fixnum:
if (x == MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM))
return ecl_make_integer(MOST_NEGATIVE_FIXNUM-1);
return (cl_object)((cl_fixnum)x - ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG));
case t_bignum:
return ecl_minus(x, MAKE_FIXNUM(1));
case t_ratio:
z = ecl_minus(x->ratio.num, x->ratio.den);
return ecl_make_ratio(z, x->ratio.den);
case t_singlefloat:
z = ecl_alloc_object(t_singlefloat);
sf(z) = sf(x) - 1.0;
return(z);
case t_doublefloat:
z = ecl_alloc_object(t_doublefloat);
df(z) = df(x) - 1.0;
return(z);
#ifdef ECL_LONG_FLOAT
case t_longfloat:
return ecl_make_longfloat(ecl_long_float(x) - 1.0);
#endif
case t_complex:
z = ecl_one_minus(x->complex.real);
return ecl_make_complex(z, x->complex.imag);
default:
FEwrong_type_only_arg(@[1-], x, @[number]);
}
}
@(defun lcm (&rest nums)
cl_object lcm;
@

8
src/c/numbers/abs.d
View file

@ -93,7 +93,7 @@ ecl_abs_complex(cl_object x)
}
}
MATH_DEF_DISPATCH1(abs, @[abs], @[number],
ecl_abs_fixnum, ecl_abs_bignum, ecl_abs_rational,
ecl_abs_single_float, ecl_abs_double_float, ecl_abs_long_float,
ecl_abs_complex);
MATH_DEF_DISPATCH1_NE(abs, @[abs], @[number],
ecl_abs_fixnum, ecl_abs_bignum, ecl_abs_rational,
ecl_abs_single_float, ecl_abs_double_float, ecl_abs_long_float,
ecl_abs_complex);

43
src/c/numbers/conjugate.d Normal file
View file

@ -0,0 +1,43 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
conjugate.d -- Trascendental functions: conjugateine
*/
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <ecl/impl/math_dispatch.h>
cl_object
cl_conjugate(cl_object x)
{
@(return ecl_conjugate(x));
}
static cl_object
ecl_conjugate_real(cl_object x)
{
return x;
}
static cl_object
ecl_conjugate_complex(cl_object x)
{
return ecl_make_complex(x->complex.real, ecl_negate(x->complex.imag));
}
MATH_DEF_DISPATCH1_NE(conjugate, @[conjugate], @[number],
ecl_conjugate_real, ecl_conjugate_real, ecl_conjugate_real,
ecl_conjugate_real, ecl_conjugate_real,
ecl_conjugate_real,
ecl_conjugate_complex);

70
src/c/numbers/negate.d Normal file
View file

@ -0,0 +1,70 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
negate.d -- Trascendental functions: negateine
*/
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <ecl/impl/math_dispatch.h>
static cl_object
ecl_negate_fix(cl_object x)
{
return ecl_make_integer(-fix(x));
}
static cl_object
ecl_negate_big(cl_object x)
{
return _ecl_big_negate(x);
}
static cl_object
ecl_negate_ratio(cl_object x)
{
return ecl_make_ratio(ecl_negate(x->ratio.num), x->ratio.den);
}
static cl_object
ecl_negate_single_float(cl_object x)
{
return ecl_make_singlefloat(-sf(x));
}
static cl_object
ecl_negate_double_float(cl_object x)
{
return ecl_make_doublefloat(-df(x));
}
#ifdef ECL_LONG_FLOAT
static cl_object
ecl_negate_long_float(cl_object x)
{
return ecl_make_longfloat(-ecl_long_float(x));
}
#endif
static cl_object
ecl_negate_complex(cl_object x)
{
return ecl_make_complex(ecl_negate(x->complex.real),
ecl_negate(x->complex.imag));
}
MATH_DEF_DISPATCH1_NE(negate, @[-], @[number],
ecl_negate_fix, ecl_negate_big, ecl_negate_ratio,
ecl_negate_single_float, ecl_negate_double_float,
ecl_negate_long_float,
ecl_negate_complex);

80
src/c/numbers/one_minus.d Normal file
View file

@ -0,0 +1,80 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
one_minus.d -- Implementation of CL:1-
*/
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <ecl/impl/math_dispatch.h>
static cl_object
ecl_one_minus_fix(cl_object x)
{
if (x == MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM))
return ecl_make_integer(MOST_NEGATIVE_FIXNUM-1);
return (cl_object)((cl_fixnum)x - ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG));
}
static cl_object
ecl_one_minus_big(cl_object x)
{
return ecl_minus(x, MAKE_FIXNUM(1));
}
static cl_object
ecl_one_minus_ratio(cl_object x)
{
return ecl_make_ratio(ecl_minus(x->ratio.num,x->ratio.den), x->ratio.den);
}
static cl_object
ecl_one_minus_single_float(cl_object x)
{
return ecl_make_singlefloat(ecl_single_float(x) - 1);
}
static cl_object
ecl_one_minus_double_float(cl_object x)
{
return ecl_make_doublefloat(ecl_double_float(x) - 1);
}
#ifdef ECL_LONG_FLOAT
static cl_object
ecl_one_minus_long_float(cl_object x)
{
return ecl_make_longfloat(ecl_long_float(x) - 1);
}
#endif
static cl_object
ecl_one_minus_complex(cl_object x)
{
return ecl_make_complex(ecl_one_minus(x->complex.real),
x->complex.imag);
}
MATH_DEF_DISPATCH1_NE(one_minus, @[1-], @[number],
ecl_one_minus_fix, ecl_one_minus_big, ecl_one_minus_ratio,
ecl_one_minus_single_float, ecl_one_minus_double_float,
ecl_one_minus_long_float,
ecl_one_minus_complex);
/* (1- x) */
cl_object
@1-(cl_object x)
{ /* INV: type check is in ecl_one_minus() */
@(return ecl_one_minus(x))
}

80
src/c/numbers/one_plus.d Normal file
View file

@ -0,0 +1,80 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
one_plus.d -- Implementation of CL:1+
*/
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
#include <ecl/impl/math_dispatch.h>
static cl_object
ecl_one_plus_fix(cl_object x)
{
if (x == MAKE_FIXNUM(MOST_POSITIVE_FIXNUM))
return ecl_make_integer(MOST_POSITIVE_FIXNUM+1);
return (cl_object)((cl_fixnum)x + ((cl_fixnum)MAKE_FIXNUM(1) - FIXNUM_TAG));
}
static cl_object
ecl_one_plus_big(cl_object x)
{
return ecl_plus(x, MAKE_FIXNUM(1));
}
static cl_object
ecl_one_plus_ratio(cl_object x)
{
return ecl_make_ratio(ecl_plus(x->ratio.num,x->ratio.den), x->ratio.den);
}
static cl_object
ecl_one_plus_single_float(cl_object x)
{
return ecl_make_singlefloat(ecl_single_float(x) + 1);
}
static cl_object
ecl_one_plus_double_float(cl_object x)
{
return ecl_make_doublefloat(ecl_double_float(x) + 1);
}
#ifdef ECL_LONG_FLOAT
static cl_object
ecl_one_plus_long_float(cl_object x)
{
return ecl_make_longfloat(ecl_long_float(x) + 1);
}
#endif
static cl_object
ecl_one_plus_complex(cl_object x)
{
return ecl_make_complex(ecl_one_plus(x->complex.real),
x->complex.imag);
}
MATH_DEF_DISPATCH1_NE(one_plus, @[1+], @[number],
ecl_one_plus_fix, ecl_one_plus_big, ecl_one_plus_ratio,
ecl_one_plus_single_float, ecl_one_plus_double_float,
ecl_one_plus_long_float,
ecl_one_plus_complex);
/* (1+ x) */
cl_object
@1+(cl_object x)
{
/* INV: type check is in ecl_one_plus() */
@(return ecl_one_plus(x))
}

1
src/h/external.h
View file

@ -1016,6 +1016,7 @@ extern ECL_API cl_object ecl_integer_divide(cl_object x, cl_object y);
extern ECL_API cl_object ecl_gcd(cl_object x, cl_object y);
extern ECL_API cl_object ecl_one_plus(cl_object x);
extern ECL_API cl_object ecl_one_minus(cl_object x);
extern ECL_API cl_object ecl_conjugate(cl_object x);
/* number.c */