diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

range builtins

Browse Source
This commit is contained in:
Vitor Santos Costa 2012-10-23 14:55:17 +01:00
parent d2da55463f
commit 139b06115e
5 changed files with 160 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
C/range.c Normal file
View File

@ -0,0 +1,128 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: range.c *
* comments: Arithmetic interval computation *
* *
* *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "eval.h"
static Int
p_in_range( USES_REGS1 ) {
Term t;
double i,j;
double d1;
double d2;
double d3;
t = Deref(ARG1);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(ARG4);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d1 = i-j;
t = Deref(ARG2);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(ARG5);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d2 = i-j;
t = Deref(ARG3);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(ARG6);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d3 = i-j;
t = Deref(ARG7);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(ARG8);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
return fabs(sqrt(d1*d1 + d2*d2 + d3*d3)-i) <= j;
}
static Int
p_in_range2( USES_REGS1 ) {
CELL *p1, *p2;
Term t;
double i,j;
double d1;
double d2;
double d3;
UInt arity;
p1 = RepAppl(Deref(ARG1));
arity = ArityOfFunctor((Functor)*p1);
p1 += arity-2;
p2 = RepAppl(Deref(ARG2))+(arity-2);;
t = Deref(p1[0]);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(p2[0]);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d1 = i-j;
t = Deref(p1[1]);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(p2[1]);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d2 = i-j;
t = Deref(p1[2]);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(p2[2]);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
d3 = i-j;
t = Deref(ARG3);
if (IsFloatTerm(t)) i = FloatOfTerm(t); else i = IntegerOfTerm(t);
t = Deref(ARG4);
if (IsFloatTerm(t)) j = FloatOfTerm(t); else j = IntegerOfTerm(t);
return fabs(sqrt(d1*d1 + d2*d2 + d3*d3)-i) <= j;
}
static Int
p_euc_dist( USES_REGS1 ) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
double d1 = (double)(IntegerOfTerm(ArgOfTerm(1,t1))-IntegerOfTerm(ArgOfTerm(1,t2)));
double d2 = (double)(IntegerOfTerm(ArgOfTerm(2,t1))-IntegerOfTerm(ArgOfTerm(2,t2)));
double d3 = (double)(IntegerOfTerm(ArgOfTerm(3,t1))-IntegerOfTerm(ArgOfTerm(3,t2)));
Int result = (Int)sqrt(d1*d1+d2*d2+d3*d3);
return(Yap_unify(ARG3,MkIntegerTerm(result)));
}
#if DEBUG
volatile int loop_counter = 0;
static Int
p_loop( USES_REGS1 ) {
while (loop_counter == 0);
return(TRUE);
}
#endif
void
Yap_InitRange(void)
{
Term cm = CurrentModule;
CurrentModule = RANGE_MODULE;
Yap_InitCPred("euclidean_distance", 3, p_euc_dist, SafePredFlag);
#ifdef DEBUG
Yap_InitCPred("loop", 0, p_loop, SafePredFlag);
#endif
Yap_InitCPred("in_range", 8, p_in_range, TestPredFlag|SafePredFlag);
Yap_InitCPred("in_range", 4, p_in_range2, TestPredFlag|SafePredFlag);
CurrentModule = cm;
}

3
H/Yapproto.h
View File

@ -320,6 +320,9 @@ void STD_PROTO(Yap_InitQLY,(void));
int STD_PROTO(Yap_Restore,(char *, char *));
void STD_PROTO(Yap_InitQLYR,(void));
/* range.c */
void Yap_InitRange(void);
/* save.c */
int STD_PROTO(Yap_SavedInfo,(char *,char *,CELL *,CELL *,CELL *));
int STD_PROTO(Yap_SavedStateRestore,(char *, char *));

4
Makefile.in
View File

@ -256,6 +256,7 @@ C_SOURCES= \
$(srcdir)/C/parser.c \
$(srcdir)/C/qlyr.c \
$(srcdir)/C/qlyw.c \
$(srcdir)/C/range.c \
$(srcdir)/C/save.c $(srcdir)/C/scanner.c \
$(srcdir)/C/sort.c $(srcdir)/C/stdpreds.c $(srcdir)/C/sysbits.c \
$(srcdir)/C/threads.c \
@ -366,7 +367,8 @@ ENGINE_OBJECTS = \
myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \
myddas_util.o myddas_statistics.o myddas_top_level.o \
myddas_wkb2prolog.o modules.o other.o \
parser.o qlyr.o qlyw.o save.o scanner.o sort.o stdpreds.o \
parser.o qlyr.o qlyw.o range.o \
save.o scanner.o sort.o stdpreds.o \
sysbits.o threads.o tracer.o \
udi.o rtree.o rtree_udi.o\
unify.o userpreds.o utilpreds.o \

1
library/Makefile.in
View File

@ -55,6 +55,7 @@ PROGRAMS= \
$(srcdir)/prandom.yap \
$(srcdir)/queues.yap \
$(srcdir)/random.yap \
$(srcdir)/range.yap \
$(srcdir)/r_session.yap \
$(srcdir)/rbtrees.yap \
$(srcdir)/regexp.yap \

25
library/range.yap Normal file
View File

@ -0,0 +1,25 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: terms.yap *
* Last rev: 5/12/99 *
* mods: *
* comments: Term manipulation operations *
* *
*************************************************************************/
:- module(range, [
euclidean_distance/3
in_range/4,
in_range/8
]).