Ratio arithmetic separated out into its own files.
This commit is contained in:
parent
a5e1d3ccd8
commit
ad9b1cd7f8
|
@ -13,7 +13,6 @@
|
||||||
|
|
||||||
#include "conspage.h"
|
#include "conspage.h"
|
||||||
#include "consspaceobject.h"
|
#include "consspaceobject.h"
|
||||||
#include "read.h"
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* return the numeric value of this cell, as a C primitive double, not
|
* return the numeric value of this cell, as a C primitive double, not
|
||||||
|
@ -41,7 +40,9 @@ struct cons_pointer make_integer( long int value ) {
|
||||||
struct cons_space_object *cell = &pointer2cell( result );
|
struct cons_space_object *cell = &pointer2cell( result );
|
||||||
cell->payload.integer.value = value;
|
cell->payload.integer.value = value;
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
dump_object( stderr, result );
|
dump_object( stderr, result );
|
||||||
|
#endif
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
|
@ -21,6 +21,7 @@
|
||||||
#include "intern.h"
|
#include "intern.h"
|
||||||
#include "lispops.h"
|
#include "lispops.h"
|
||||||
#include "print.h"
|
#include "print.h"
|
||||||
|
#include "ratio.h"
|
||||||
#include "read.h"
|
#include "read.h"
|
||||||
#include "real.h"
|
#include "real.h"
|
||||||
#include "stack.h"
|
#include "stack.h"
|
||||||
|
@ -113,123 +114,6 @@ long int to_long_int( struct cons_pointer arg ) {
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
long int greatest_common_divisor( long int m, long int n ) {
|
|
||||||
int o;
|
|
||||||
while ( m ) {
|
|
||||||
o = m;
|
|
||||||
m = n % m;
|
|
||||||
n = o;
|
|
||||||
}
|
|
||||||
|
|
||||||
return o;
|
|
||||||
}
|
|
||||||
|
|
||||||
long int least_common_multiple( long int m, long int n ) {
|
|
||||||
return m / greatest_common_divisor( m, n ) * n;
|
|
||||||
}
|
|
||||||
|
|
||||||
struct cons_pointer simplify_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer arg ) {
|
|
||||||
struct cons_pointer result = arg;
|
|
||||||
long int ddrv =
|
|
||||||
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
|
|
||||||
payload.integer.value, drrv =
|
|
||||||
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
|
|
||||||
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
|
|
||||||
|
|
||||||
if ( gcd > 1 ) {
|
|
||||||
if ( drrv / gcd == 1 ) {
|
|
||||||
result = make_integer( ddrv / gcd );
|
|
||||||
} else {
|
|
||||||
result =
|
|
||||||
make_ratio( frame, make_integer( ddrv / gcd ),
|
|
||||||
make_integer( drrv / gcd ) );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/**
|
|
||||||
* return a cons_pointer indicating a number which is the sum of
|
|
||||||
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
|
||||||
* this is going to break horribly.
|
|
||||||
*/
|
|
||||||
struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer arg1,
|
|
||||||
struct cons_pointer arg2 ) {
|
|
||||||
fputws( L"add_ratio_ratio( arg1 = ", stderr );
|
|
||||||
print( stderr, arg1 );
|
|
||||||
fputws( L"; arg2 = ", stderr );
|
|
||||||
print( stderr, arg2 );
|
|
||||||
|
|
||||||
struct cons_pointer r, result;
|
|
||||||
struct cons_space_object cell1 = pointer2cell( arg1 );
|
|
||||||
struct cons_space_object cell2 = pointer2cell( arg2 );
|
|
||||||
long int dd1v =
|
|
||||||
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
|
|
||||||
dd2v =
|
|
||||||
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
|
|
||||||
dr1v =
|
|
||||||
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
|
|
||||||
dr2v =
|
|
||||||
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
|
|
||||||
lcm = least_common_multiple( dr1v, dr2v ),
|
|
||||||
m1 = lcm / dr1v, m2 = lcm / dr2v;
|
|
||||||
|
|
||||||
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
|
|
||||||
|
|
||||||
if ( dr1v == dr2v ) {
|
|
||||||
r = make_ratio( frame,
|
|
||||||
make_integer( dd1v + dd2v ),
|
|
||||||
cell1.payload.ratio.divisor );
|
|
||||||
} else {
|
|
||||||
struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
|
|
||||||
dr1vm = make_integer( dr1v * m1 ),
|
|
||||||
dd2vm = make_integer( dd2v * m2 ),
|
|
||||||
dr2vm = make_integer( dr2v * m2 ),
|
|
||||||
r1 = make_ratio( frame, dd1vm, dr1vm ),
|
|
||||||
r2 = make_ratio( frame, dd2vm, dr2vm );
|
|
||||||
|
|
||||||
r = add_ratio_ratio( frame, r1, r2 );
|
|
||||||
|
|
||||||
/* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
|
|
||||||
* never incremented except when making r1 and r2, decrementing
|
|
||||||
* r1 and r2 should be enought to garbage collect them. */
|
|
||||||
dec_ref( r1 );
|
|
||||||
dec_ref( r2 );
|
|
||||||
}
|
|
||||||
|
|
||||||
result = simplify_ratio( frame, r );
|
|
||||||
if ( !eq( r, result ) ) {
|
|
||||||
dec_ref( r );
|
|
||||||
}
|
|
||||||
|
|
||||||
fputws( L" => ", stderr );
|
|
||||||
print( stderr, result );
|
|
||||||
fputws( L"\n", stderr );
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/**
|
|
||||||
* return a cons_pointer indicating a number which is the sum of
|
|
||||||
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
|
||||||
* this is going to break horribly.
|
|
||||||
*/
|
|
||||||
struct cons_pointer add_integer_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer intarg,
|
|
||||||
struct cons_pointer ratarg ) {
|
|
||||||
struct cons_pointer one = make_integer( 1 ),
|
|
||||||
ratio = make_ratio( frame, intarg, one ),
|
|
||||||
result = add_ratio_ratio( frame, ratio, ratarg );
|
|
||||||
|
|
||||||
dec_ref( one );
|
|
||||||
dec_ref( ratio );
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* return a cons_pointer indicating a number which is the sum of
|
* return a cons_pointer indicating a number which is the sum of
|
||||||
|
@ -358,58 +242,6 @@ struct cons_pointer lisp_add( struct stack_frame
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct cons_pointer multiply_ratio_ratio( struct
|
|
||||||
stack_frame
|
|
||||||
*frame, struct
|
|
||||||
cons_pointer arg1, struct
|
|
||||||
cons_pointer arg2 ) {
|
|
||||||
fputws( L"multiply_ratio_ratio( arg1 = ", stderr );
|
|
||||||
print( stderr, arg1 );
|
|
||||||
fputws( L"; arg2 = ", stderr );
|
|
||||||
print( stderr, arg2 );
|
|
||||||
|
|
||||||
struct cons_pointer result;
|
|
||||||
struct cons_space_object cell1 = pointer2cell( arg1 );
|
|
||||||
struct cons_space_object cell2 = pointer2cell( arg2 );
|
|
||||||
long int dd1v =
|
|
||||||
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
|
|
||||||
dd2v =
|
|
||||||
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
|
|
||||||
dr1v =
|
|
||||||
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
|
|
||||||
dr2v =
|
|
||||||
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
|
|
||||||
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
|
|
||||||
|
|
||||||
struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
|
|
||||||
make_integer( drrv ) );
|
|
||||||
result = simplify_ratio( frame, unsimplified );
|
|
||||||
|
|
||||||
if ( !eq( unsimplified, result ) ) {
|
|
||||||
dec_ref( unsimplified );
|
|
||||||
}
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
/**
|
|
||||||
* return a cons_pointer indicating a number which is the sum of
|
|
||||||
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
|
||||||
* this is going to break horribly.
|
|
||||||
*/
|
|
||||||
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer intarg,
|
|
||||||
struct cons_pointer ratarg ) {
|
|
||||||
struct cons_pointer one = make_integer( 1 ),
|
|
||||||
ratio = make_ratio( frame, intarg, one ),
|
|
||||||
result = multiply_ratio_ratio( frame, ratio, ratarg );
|
|
||||||
|
|
||||||
dec_ref( one );
|
|
||||||
dec_ref( ratio );
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* return a cons_pointer indicating a number which is the product of
|
* return a cons_pointer indicating a number which is the product of
|
||||||
|
@ -543,6 +375,10 @@ struct cons_pointer lisp_multiply( struct
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the
|
||||||
|
* inverse of the number indicated by `arg`.
|
||||||
|
*/
|
||||||
struct cons_pointer inverse( struct stack_frame *frame,
|
struct cons_pointer inverse( struct stack_frame *frame,
|
||||||
struct cons_pointer arg ) {
|
struct cons_pointer arg ) {
|
||||||
struct cons_pointer result = NIL;
|
struct cons_pointer result = NIL;
|
||||||
|
@ -577,17 +413,6 @@ struct cons_pointer inverse( struct stack_frame *frame,
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer arg1,
|
|
||||||
struct cons_pointer arg2 ) {
|
|
||||||
struct cons_pointer i = inverse( frame, arg2 ),
|
|
||||||
result = add_ratio_ratio( frame, arg1, i );
|
|
||||||
|
|
||||||
dec_ref( i );
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Subtract one number from another.
|
* Subtract one number from another.
|
||||||
* @param env the evaluation environment - ignored;
|
* @param env the evaluation environment - ignored;
|
||||||
|
@ -683,26 +508,6 @@ struct cons_pointer lisp_subtract( struct
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
|
||||||
* return a cons_pointer to a ratio which represents the value of the ratio
|
|
||||||
* indicated by `arg1` divided by the ratio indicated by `arg2`. If either
|
|
||||||
* of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT.
|
|
||||||
*/
|
|
||||||
struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer arg1,
|
|
||||||
struct cons_pointer arg2 ) {
|
|
||||||
struct cons_pointer i = make_ratio( frame,
|
|
||||||
pointer2cell( arg2 ).payload.
|
|
||||||
ratio.divisor,
|
|
||||||
pointer2cell( arg2 ).payload.
|
|
||||||
ratio.dividend ), result =
|
|
||||||
multiply_ratio_ratio( frame, arg1, i );
|
|
||||||
|
|
||||||
dec_ref( i );
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Divide one number by another.
|
* Divide one number by another.
|
||||||
* @param env the evaluation environment - ignored;
|
* @param env the evaluation environment - ignored;
|
||||||
|
|
330
src/arith/ratio.c
Normal file
330
src/arith/ratio.c
Normal file
|
@ -0,0 +1,330 @@
|
||||||
|
/*
|
||||||
|
* ratio.c
|
||||||
|
*
|
||||||
|
* functions for rational number cells.
|
||||||
|
*
|
||||||
|
* (c) 2017 Simon Brooke <simon@journeyman.cc>
|
||||||
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#define _GNU_SOURCE
|
||||||
|
#include <math.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
|
#include "conspage.h"
|
||||||
|
#include "consspaceobject.h"
|
||||||
|
#include "equal.h"
|
||||||
|
#include "integer.h"
|
||||||
|
#include "lispops.h"
|
||||||
|
#include "print.h"
|
||||||
|
#include "ratio.h"
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
|
* declared in peano.c, can't include piano.h here because
|
||||||
|
* circularity. TODO: refactor.
|
||||||
|
*/
|
||||||
|
struct cons_pointer inverse( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg );
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return, as a long int, the greatest common divisor of `m` and `n`,
|
||||||
|
*/
|
||||||
|
long int greatest_common_divisor( long int m, long int n ) {
|
||||||
|
int o;
|
||||||
|
while ( m ) {
|
||||||
|
o = m;
|
||||||
|
m = n % m;
|
||||||
|
n = o;
|
||||||
|
}
|
||||||
|
|
||||||
|
return o;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return, as a long int, the least common multiple of `m` and `n`,
|
||||||
|
*/
|
||||||
|
long int least_common_multiple( long int m, long int n ) {
|
||||||
|
return m / greatest_common_divisor( m, n ) * n;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is of the
|
||||||
|
* same value as the ratio indicated by `arg`, but which may
|
||||||
|
* be in a simplified representation. If `arg` isn't a ratio,
|
||||||
|
* will throw exception.
|
||||||
|
*/
|
||||||
|
struct cons_pointer simplify_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg ) {
|
||||||
|
struct cons_pointer result = arg;
|
||||||
|
|
||||||
|
if (ratiop(arg)) {
|
||||||
|
long int ddrv =
|
||||||
|
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
|
||||||
|
payload.integer.value, drrv =
|
||||||
|
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
|
||||||
|
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
|
||||||
|
|
||||||
|
if ( gcd > 1 ) {
|
||||||
|
if ( drrv / gcd == 1 ) {
|
||||||
|
result = make_integer( ddrv / gcd );
|
||||||
|
} else {
|
||||||
|
result =
|
||||||
|
make_ratio( frame, make_integer( ddrv / gcd ),
|
||||||
|
make_integer( drrv / gcd ) );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
result = lisp_throw(
|
||||||
|
c_string_to_lisp_string( "Shouldn't happen: bad arg to simplify_ratio" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the sum of
|
||||||
|
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
||||||
|
* this is going to break horribly.
|
||||||
|
*/
|
||||||
|
struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) {
|
||||||
|
struct cons_pointer r, result;
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
fputws( L"add_ratio_ratio( arg1 = ", stderr );
|
||||||
|
print( stderr, arg1 );
|
||||||
|
fputws( L"; arg2 = ", stderr );
|
||||||
|
print( stderr, arg2 );
|
||||||
|
fputws( L")\n", stderr);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if ( ratiop(arg1) && ratiop(arg2)) {
|
||||||
|
struct cons_space_object cell1 = pointer2cell( arg1 );
|
||||||
|
struct cons_space_object cell2 = pointer2cell( arg2 );
|
||||||
|
long int dd1v =
|
||||||
|
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
|
||||||
|
dd2v =
|
||||||
|
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
|
||||||
|
dr1v =
|
||||||
|
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
|
||||||
|
dr2v =
|
||||||
|
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
|
||||||
|
lcm = least_common_multiple( dr1v, dr2v ),
|
||||||
|
m1 = lcm / dr1v, m2 = lcm / dr2v;
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
|
||||||
|
#endif
|
||||||
|
|
||||||
|
if ( dr1v == dr2v ) {
|
||||||
|
r = make_ratio( frame,
|
||||||
|
make_integer( dd1v + dd2v ),
|
||||||
|
cell1.payload.ratio.divisor );
|
||||||
|
} else {
|
||||||
|
struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
|
||||||
|
dr1vm = make_integer( dr1v * m1 ),
|
||||||
|
dd2vm = make_integer( dd2v * m2 ),
|
||||||
|
dr2vm = make_integer( dr2v * m2 ),
|
||||||
|
r1 = make_ratio( frame, dd1vm, dr1vm ),
|
||||||
|
r2 = make_ratio( frame, dd2vm, dr2vm );
|
||||||
|
|
||||||
|
r = add_ratio_ratio( frame, r1, r2 );
|
||||||
|
|
||||||
|
/* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
|
||||||
|
* never incremented except when making r1 and r2, decrementing
|
||||||
|
* r1 and r2 should be enought to garbage collect them. */
|
||||||
|
dec_ref( r1 );
|
||||||
|
dec_ref( r2 );
|
||||||
|
}
|
||||||
|
|
||||||
|
result = simplify_ratio( frame, r );
|
||||||
|
if ( !eq( r, result ) ) {
|
||||||
|
dec_ref( r );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
result = lisp_throw(
|
||||||
|
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_ratio_ratio" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
fputws( L" => ", stderr );
|
||||||
|
print( stderr, result );
|
||||||
|
fputws( L"\n", stderr );
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the sum of
|
||||||
|
* the intger indicated by `intarg` and the ratio indicated by
|
||||||
|
* `ratarg`. If you pass other types, this is going to break horribly.
|
||||||
|
*/
|
||||||
|
struct cons_pointer add_integer_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer intarg,
|
||||||
|
struct cons_pointer ratarg ) {
|
||||||
|
struct cons_pointer result;
|
||||||
|
|
||||||
|
if (integerp(intarg) && ratiop(ratarg)) {
|
||||||
|
struct cons_pointer one = make_integer( 1 ),
|
||||||
|
ratio = make_ratio( frame, intarg, one );
|
||||||
|
|
||||||
|
result = add_ratio_ratio( frame, ratio, ratarg );
|
||||||
|
|
||||||
|
dec_ref( one );
|
||||||
|
dec_ref( ratio );
|
||||||
|
} else {
|
||||||
|
result = lisp_throw(
|
||||||
|
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_integer_ratio" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer to a ratio which represents the value of the ratio
|
||||||
|
* indicated by `arg1` divided by the ratio indicated by `arg2`. If either
|
||||||
|
* of these aren't RTIO cells, something horrid will happen and it is YOUR FAULT.
|
||||||
|
*/
|
||||||
|
struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) {
|
||||||
|
struct cons_pointer i = make_ratio( frame,
|
||||||
|
pointer2cell( arg2 ).payload.
|
||||||
|
ratio.divisor,
|
||||||
|
pointer2cell( arg2 ).payload.
|
||||||
|
ratio.dividend ), result =
|
||||||
|
multiply_ratio_ratio( frame, arg1, i );
|
||||||
|
|
||||||
|
dec_ref( i );
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the product of
|
||||||
|
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
||||||
|
* this is going to break horribly.
|
||||||
|
*/
|
||||||
|
struct cons_pointer multiply_ratio_ratio( struct
|
||||||
|
stack_frame
|
||||||
|
*frame, struct
|
||||||
|
cons_pointer arg1, struct
|
||||||
|
cons_pointer arg2 ) {
|
||||||
|
struct cons_pointer result;
|
||||||
|
|
||||||
|
#ifdef DEBUG
|
||||||
|
fputws( L"multiply_ratio_ratio( arg1 = ", stderr );
|
||||||
|
print( stderr, arg1 );
|
||||||
|
fputws( L"; arg2 = ", stderr );
|
||||||
|
print( stderr, arg2 );
|
||||||
|
fputws( L")\n", stderr);
|
||||||
|
#endif
|
||||||
|
if ( ratiop(arg1) && ratiop(arg2)) {
|
||||||
|
struct cons_space_object cell1 = pointer2cell( arg1 );
|
||||||
|
struct cons_space_object cell2 = pointer2cell( arg2 );
|
||||||
|
long int dd1v =
|
||||||
|
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
|
||||||
|
dd2v =
|
||||||
|
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
|
||||||
|
dr1v =
|
||||||
|
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
|
||||||
|
dr2v =
|
||||||
|
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
|
||||||
|
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
|
||||||
|
|
||||||
|
struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
|
||||||
|
make_integer( drrv ) );
|
||||||
|
result = simplify_ratio( frame, unsimplified );
|
||||||
|
|
||||||
|
if ( !eq( unsimplified, result ) ) {
|
||||||
|
dec_ref( unsimplified );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
result = lisp_throw(
|
||||||
|
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the product of
|
||||||
|
* the intger indicated by `intarg` and the ratio indicated by
|
||||||
|
* `ratarg`. If you pass other types, this is going to break horribly.
|
||||||
|
*/
|
||||||
|
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer intarg,
|
||||||
|
struct cons_pointer ratarg ) {
|
||||||
|
struct cons_pointer result;
|
||||||
|
|
||||||
|
if (integerp(intarg) && ratiop(ratarg)) {
|
||||||
|
struct cons_pointer one = make_integer( 1 ),
|
||||||
|
ratio = make_ratio( frame, intarg, one );
|
||||||
|
result = multiply_ratio_ratio( frame, ratio, ratarg );
|
||||||
|
|
||||||
|
dec_ref( one );
|
||||||
|
dec_ref( ratio );
|
||||||
|
} else {
|
||||||
|
result = lisp_throw(
|
||||||
|
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* return a cons_pointer indicating a number which is the difference of
|
||||||
|
* the ratios indicated by `arg1` and `arg2`. If you pass non-ratios,
|
||||||
|
* this is going to break horribly.
|
||||||
|
*/
|
||||||
|
struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) {
|
||||||
|
struct cons_pointer i = inverse( frame, arg2 ),
|
||||||
|
result = add_ratio_ratio( frame, arg1, i );
|
||||||
|
|
||||||
|
dec_ref( i );
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Construct a ratio frame from these two pointers, expected to be integers
|
||||||
|
* or (later) bignums, in the context of this stack_frame.
|
||||||
|
*/
|
||||||
|
struct cons_pointer make_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer dividend,
|
||||||
|
struct cons_pointer divisor ) {
|
||||||
|
struct cons_pointer result;
|
||||||
|
if ( integerp( dividend ) && integerp( divisor ) ) {
|
||||||
|
inc_ref( dividend );
|
||||||
|
inc_ref( divisor );
|
||||||
|
result = allocate_cell( RATIOTAG );
|
||||||
|
struct cons_space_object *cell = &pointer2cell( result );
|
||||||
|
cell->payload.ratio.dividend = dividend;
|
||||||
|
cell->payload.ratio.divisor = divisor;
|
||||||
|
} else {
|
||||||
|
result =
|
||||||
|
lisp_throw( c_string_to_lisp_string
|
||||||
|
( "Dividend and divisor of a ratio must be integers" ),
|
||||||
|
frame );
|
||||||
|
}
|
||||||
|
#ifdef DEBUG
|
||||||
|
dump_object( stderr, result );
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
48
src/arith/ratio.h
Normal file
48
src/arith/ratio.h
Normal file
|
@ -0,0 +1,48 @@
|
||||||
|
/**
|
||||||
|
* ratio.h
|
||||||
|
*
|
||||||
|
* functions for rational number cells.
|
||||||
|
*
|
||||||
|
*
|
||||||
|
* (c) 2017 Simon Brooke <simon@journeyman.cc>
|
||||||
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef __ratio_h
|
||||||
|
#define __ratio_h
|
||||||
|
|
||||||
|
struct cons_pointer simplify_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg ) ;
|
||||||
|
|
||||||
|
struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) ;
|
||||||
|
|
||||||
|
struct cons_pointer add_integer_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer intarg,
|
||||||
|
struct cons_pointer ratarg ) ;
|
||||||
|
|
||||||
|
struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) ;
|
||||||
|
|
||||||
|
struct cons_pointer multiply_ratio_ratio( struct
|
||||||
|
stack_frame
|
||||||
|
*frame, struct
|
||||||
|
cons_pointer arg1, struct
|
||||||
|
cons_pointer arg2 ) ;
|
||||||
|
|
||||||
|
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer intarg,
|
||||||
|
struct cons_pointer ratarg ) ;
|
||||||
|
|
||||||
|
struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer arg1,
|
||||||
|
struct cons_pointer arg2 ) ;
|
||||||
|
|
||||||
|
struct cons_pointer make_ratio( struct stack_frame *frame,
|
||||||
|
struct cons_pointer dividend,
|
||||||
|
struct cons_pointer divisor ) ;
|
||||||
|
|
||||||
|
|
||||||
|
#endif
|
|
@ -12,7 +12,7 @@
|
||||||
#include "read.h"
|
#include "read.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Allocate a real number cell representing this value and return a cons
|
* Allocate a real number cell representing this value and return a cons
|
||||||
* pointer to it.
|
* pointer to it.
|
||||||
* @param value the value to wrap;
|
* @param value the value to wrap;
|
||||||
* @return a real number cell wrapping this value.
|
* @return a real number cell wrapping this value.
|
||||||
|
@ -22,5 +22,9 @@ struct cons_pointer make_real( long double value ) {
|
||||||
struct cons_space_object *cell = &pointer2cell( result );
|
struct cons_space_object *cell = &pointer2cell( result );
|
||||||
cell->payload.real.value = value;
|
cell->payload.real.value = value;
|
||||||
|
|
||||||
return result;
|
#ifdef DEBUG
|
||||||
|
dump_object( stderr, result );
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return result;
|
||||||
}
|
}
|
||||||
|
|
|
@ -247,31 +247,6 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
|
||||||
return pointer;
|
return pointer;
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
|
||||||
* Construct a ratio frame from these two pointers, expected to be integers
|
|
||||||
* or (later) bignums, in the context of this stack_frame.
|
|
||||||
*/
|
|
||||||
struct cons_pointer make_ratio( struct stack_frame *frame,
|
|
||||||
struct cons_pointer dividend,
|
|
||||||
struct cons_pointer divisor ) {
|
|
||||||
struct cons_pointer result;
|
|
||||||
if ( integerp( dividend ) && integerp( divisor ) ) {
|
|
||||||
inc_ref( dividend );
|
|
||||||
inc_ref( divisor );
|
|
||||||
result = allocate_cell( RATIOTAG );
|
|
||||||
struct cons_space_object *cell = &pointer2cell( result );
|
|
||||||
cell->payload.ratio.dividend = dividend;
|
|
||||||
cell->payload.ratio.divisor = divisor;
|
|
||||||
} else {
|
|
||||||
result =
|
|
||||||
make_exception( c_string_to_lisp_string
|
|
||||||
( "Dividend and divisor of a ratio must be integers" ),
|
|
||||||
frame );
|
|
||||||
}
|
|
||||||
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Construct a string from this character (which later will be UTF) and
|
* Construct a string from this character (which later will be UTF) and
|
||||||
* this tail. A string is implemented as a flat list of cells each of which
|
* this tail. A string is implemented as a flat list of cells each of which
|
||||||
|
|
|
@ -129,8 +129,7 @@ lisp_oblist( struct stack_frame *frame, struct cons_pointer env ) {
|
||||||
* used to construct the body for `lambda` and `nlambda` expressions.
|
* used to construct the body for `lambda` and `nlambda` expressions.
|
||||||
*/
|
*/
|
||||||
struct cons_pointer compose_body( struct stack_frame *frame ) {
|
struct cons_pointer compose_body( struct stack_frame *frame ) {
|
||||||
struct cons_pointer body =
|
struct cons_pointer body = frame->more;
|
||||||
!nilp( frame->arg[args_in_frame - 1] ) ? frame->more : NIL;
|
|
||||||
|
|
||||||
for ( int i = args_in_frame - 1; i > 0; i-- ) {
|
for ( int i = args_in_frame - 1; i > 0; i-- ) {
|
||||||
if ( !nilp( body ) ) {
|
if ( !nilp( body ) ) {
|
||||||
|
|
|
@ -22,6 +22,7 @@
|
||||||
#include "intern.h"
|
#include "intern.h"
|
||||||
#include "lispops.h"
|
#include "lispops.h"
|
||||||
#include "print.h"
|
#include "print.h"
|
||||||
|
#include "ratio.h"
|
||||||
#include "read.h"
|
#include "read.h"
|
||||||
#include "real.h"
|
#include "real.h"
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue