range builtins

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;
+}

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 *));

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 \

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 \

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
+		 ]).
+
+
+