2001-04-09 20:54:03 +01:00
|
|
|
/*************************************************************************
|
|
|
|
* *
|
|
|
|
* YAP Prolog *
|
|
|
|
* *
|
|
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
|
|
* *
|
|
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
|
|
* *
|
|
|
|
**************************************************************************
|
|
|
|
* *
|
|
|
|
* File: other.c *
|
|
|
|
* Last rev: Dec/90 *
|
|
|
|
* mods: *
|
|
|
|
* comments: extra routines *
|
|
|
|
* *
|
|
|
|
*************************************************************************/
|
|
|
|
#ifdef SCCS
|
|
|
|
static char SccsId[] = "%W% %G%";
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
|
#include "Yap.h"
|
|
|
|
#include "Yatom.h"
|
2009-10-23 14:22:17 +01:00
|
|
|
#include "YapHeap.h"
|
2006-05-19 14:48:11 +01:00
|
|
|
#if HAVE_STRING_H
|
|
|
|
#include <string.h>
|
|
|
|
#endif
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2002-11-18 18:18:05 +00:00
|
|
|
/* exile Yap_standard_regs here, otherwise WIN32 linkers may complain */
|
|
|
|
REGSTORE Yap_standard_regs;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2002-11-11 17:38:10 +00:00
|
|
|
#if PUSH_REGS
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
#ifdef THREADS
|
|
|
|
/* PushRegs always on */
|
|
|
|
|
2004-02-06 17:22:24 +00:00
|
|
|
pthread_key_t Yap_yaamregs_key;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2002-11-11 17:38:10 +00:00
|
|
|
#else
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
REGSTORE *Yap_regp;
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
#else /* !PUSH_REGS */
|
|
|
|
|
2002-11-18 18:18:05 +00:00
|
|
|
REGSTORE Yap_REGS;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
|
|
|
#endif
|
2001-04-09 20:54:03 +01:00
|
|
|
|
2002-05-14 19:24:34 +01:00
|
|
|
Term
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_MkNewPairTerm(void)
|
2002-05-14 19:24:34 +01:00
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2014-01-19 21:15:05 +00:00
|
|
|
register CELL *p = HR;
|
2002-05-14 19:24:34 +01:00
|
|
|
|
2014-01-19 21:15:05 +00:00
|
|
|
RESET_VARIABLE(HR);
|
|
|
|
RESET_VARIABLE(HR+1);
|
|
|
|
HR+=2;
|
2002-05-14 19:24:34 +01:00
|
|
|
return (AbsPair(p));
|
|
|
|
}
|
|
|
|
|
2002-11-11 17:38:10 +00:00
|
|
|
Term
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_MkApplTerm(Functor f, unsigned int n, register Term *a)
|
2001-04-09 20:54:03 +01:00
|
|
|
/* build compound term with functor f and n
|
|
|
|
* args a */
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2014-01-19 21:15:05 +00:00
|
|
|
CELL *t = HR;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
|
|
if (n == 0)
|
|
|
|
return (MkAtomTerm(NameOfFunctor(f)));
|
|
|
|
if (f == FunctorList)
|
2011-03-07 16:02:55 +00:00
|
|
|
return MkPairTerm(a[0], a[1]);
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR++ = (CELL) f;
|
2001-04-09 20:54:03 +01:00
|
|
|
while (n--)
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR++ = (CELL) * a++;
|
2001-04-09 20:54:03 +01:00
|
|
|
return (AbsAppl(t));
|
|
|
|
}
|
2002-05-06 16:33:05 +01:00
|
|
|
|
|
|
|
Term
|
2002-11-18 18:18:05 +00:00
|
|
|
Yap_MkNewApplTerm(Functor f, unsigned int n)
|
2002-05-06 16:33:05 +01:00
|
|
|
/* build compound term with functor f and n
|
|
|
|
* args a */
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2014-01-19 21:15:05 +00:00
|
|
|
CELL *t = HR;
|
2002-05-06 16:33:05 +01:00
|
|
|
|
|
|
|
if (n == 0)
|
|
|
|
return (MkAtomTerm(NameOfFunctor(f)));
|
|
|
|
if (f == FunctorList) {
|
2014-01-19 21:15:05 +00:00
|
|
|
RESET_VARIABLE(HR);
|
|
|
|
RESET_VARIABLE(HR+1);
|
|
|
|
HR+=2;
|
2002-05-06 16:33:05 +01:00
|
|
|
return (AbsPair(t));
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
*HR++ = (CELL) f;
|
2002-05-06 16:33:05 +01:00
|
|
|
while (n--) {
|
2014-01-19 21:15:05 +00:00
|
|
|
RESET_VARIABLE(HR);
|
|
|
|
HR++;
|
2002-05-06 16:33:05 +01:00
|
|
|
}
|
|
|
|
return (AbsAppl(t));
|
|
|
|
}
|
2006-05-19 14:48:11 +01:00
|
|
|
|
|
|
|
|
2010-07-19 14:39:52 +01:00
|
|
|
Term
|
|
|
|
Yap_Globalise(Term t)
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
CACHE_REGS
|
2010-07-19 14:39:52 +01:00
|
|
|
CELL *vt;
|
|
|
|
Term tn;
|
|
|
|
|
|
|
|
if (!IsVarTerm(t))
|
|
|
|
return t;
|
|
|
|
vt = VarOfTerm(t);
|
2014-01-19 21:15:05 +00:00
|
|
|
if (vt <= HR && vt > H0)
|
2010-07-19 14:39:52 +01:00
|
|
|
return t;
|
|
|
|
tn = MkVarTerm();
|
|
|
|
Yap_unify(t, tn);
|
|
|
|
return tn;
|
|
|
|
}
|