/*
 * Copyright © 2017 Keith Packard <keithp@keithp.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 */

#include "ao_lisp.h"
#include <math.h>

static void float_mark(void *addr)
{
	(void) addr;
}

static int float_size(void *addr)
{
	if (!addr)
		return 0;
	return sizeof (struct ao_lisp_float);
}

static void float_move(void *addr)
{
	(void) addr;
}

const struct ao_lisp_type ao_lisp_float_type = {
	.mark = float_mark,
	.size = float_size,
	.move = float_move,
	.name = "float",
};

void
ao_lisp_float_write(ao_poly p)
{
	struct ao_lisp_float *f = ao_lisp_poly_float(p);
	float	v = f->value;

	if (isnanf(v))
		printf("+nan.0");
	else if (isinff(v)) {
		if (v < 0)
			printf("-");
		else
			printf("+");
		printf("inf.0");
	} else
		printf ("%g", f->value);
}

float
ao_lisp_poly_number(ao_poly p)
{
	switch (ao_lisp_poly_base_type(p)) {
	case AO_LISP_INT:
		return ao_lisp_poly_int(p);
	case AO_LISP_OTHER:
		switch (ao_lisp_other_type(ao_lisp_poly_other(p))) {
		case AO_LISP_BIGINT:
			return ao_lisp_bigint_int(ao_lisp_poly_bigint(p)->value);
		case AO_LISP_FLOAT:
			return ao_lisp_poly_float(p)->value;
		}
	}
	return NAN;
}

ao_poly
ao_lisp_float_get(float value)
{
	struct ao_lisp_float	*f;

	f = ao_lisp_alloc(sizeof (struct ao_lisp_float));
	f->type = AO_LISP_FLOAT;
	f->value = value;
	return ao_lisp_float_poly(f);
}

ao_poly
ao_lisp_do_inexactp(struct ao_lisp_cons *cons)
{
	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
		return AO_LISP_NIL;
	if (ao_lisp_poly_type(ao_lisp_arg(cons, 0)) == AO_LISP_FLOAT)
		return _ao_lisp_bool_true;
	return _ao_lisp_bool_false;
}

ao_poly
ao_lisp_do_finitep(struct ao_lisp_cons *cons)
{
	ao_poly	value;
	float	f;

	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
		return AO_LISP_NIL;
	value = ao_lisp_arg(cons, 0);
	switch (ao_lisp_poly_type(value)) {
	case AO_LISP_INT:
	case AO_LISP_BIGINT:
		return _ao_lisp_bool_true;
	case AO_LISP_FLOAT:
		f = ao_lisp_poly_float(value)->value;
		if (!isnan(f) && !isinf(f))
			return _ao_lisp_bool_true;
	}
	return _ao_lisp_bool_false;
}

ao_poly
ao_lisp_do_infinitep(struct ao_lisp_cons *cons)
{
	ao_poly	value;
	float	f;

	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
		return AO_LISP_NIL;
	value = ao_lisp_arg(cons, 0);
	switch (ao_lisp_poly_type(value)) {
	case AO_LISP_FLOAT:
		f = ao_lisp_poly_float(value)->value;
		if (isinf(f))
			return _ao_lisp_bool_true;
	}
	return _ao_lisp_bool_false;
}

ao_poly
ao_lisp_do_sqrt(struct ao_lisp_cons *cons)
{
	ao_poly	value;

	if (!ao_lisp_check_argc(_ao_lisp_atom_sqrt, cons, 1, 1))
		return AO_LISP_NIL;
	value = ao_lisp_arg(cons, 0);
	if (!ao_lisp_number_typep(ao_lisp_poly_type(value)))
		return ao_lisp_error(AO_LISP_INVALID, "%s: non-numeric", ao_lisp_poly_atom(_ao_lisp_atom_sqrt)->name);
	return ao_lisp_float_get(sqrtf(ao_lisp_poly_number(value)));
}