From 139b06115e56f5b0ba868144cf0fe24b066a9f3b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 23 Oct 2012 14:55:17 +0100 Subject: [PATCH] range builtins --- C/range.c | 128 ++++++++++++++++++++++++++++++++++++++++++++ H/Yapproto.h | 3 ++ Makefile.in | 4 +- library/Makefile.in | 1 + library/range.yap | 25 +++++++++ 5 files changed, 160 insertions(+), 1 deletion(-) create mode 100644 C/range.c create mode 100644 library/range.yap diff --git a/C/range.c b/C/range.c new file mode 100644 index 000000000..e023479b7 --- /dev/null +++ b/C/range.c @@ -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; +} diff --git a/H/Yapproto.h b/H/Yapproto.h index b46c64fee..4695054c2 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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 *)); diff --git a/Makefile.in b/Makefile.in index eea0e6e68..3cb3562de 100755 --- a/Makefile.in +++ b/Makefile.in @@ -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 \ diff --git a/library/Makefile.in b/library/Makefile.in index a1263a36c..b9f9fc31b 100644 --- a/library/Makefile.in +++ b/library/Makefile.in @@ -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 \ diff --git a/library/range.yap b/library/range.yap new file mode 100644 index 000000000..46a406647 --- /dev/null +++ b/library/range.yap @@ -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 + ]). + + +