kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/include/Yap/YapInterface.h

@@ -0,0 +1,283 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2012-2016, VU University Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+#ifndef YAP_INTERFACE_H_INCLUDED
+#define YAP_INTERFACE_H_INCLUDED
+
+#include <SWI-Prolog.h>
+#include <math.h>
+#include <gmp.h>
+
+#define YAP_UserCPredicate(name, func, arity) \
+	PL_register_foreign(name, arity, func, PL_FA_VARARGS)
+
+#define YAP_ARGS term_t YAP_ARG1, int _arity, control_t _ctx
+#define YAP_PASS_ARGS YAP_ARG1, _arity, _ctx
+#define YAP_ARG2 (YAP_ARG1+1)
+#define YAP_ARG3 (YAP_ARG1+2)
+#define YAP_ARG4 (YAP_ARG1+3)
+#define YAP_ARG5 (YAP_ARG1+4)
+#define YAP_ARG6 (YAP_ARG1+5)
+#define YAP_ARG7 (YAP_ARG1+6)
+#define YAP_ARG8 (YAP_ARG1+7)
+#define YAP_ARG9 (YAP_ARG1+8)
+
+typedef int64_t YAP_Int;
+typedef atom_t YAP_Atom;
+typedef functor_t YAP_Functor;
+typedef term_t YAP_Term;
+typedef foreign_t YAP_Rc;
+
+#define YAP_IsAtomTerm(t) PL_is_atom(t)
+#define YAP_IsIntTerm(t) PL_is_integer(t)
+#define YAP_IsFloatTerm(t) PL_is_float(t)
+#define YAP_IsPairTerm(t) (PL_is_list(t) && !PL_is_atom(t))
+#define YAP_IsVarTerm(t) PL_is_variable(t)
+#define YAP_IsNilTerm(t) PL_get_nil(t)
+#define YAP_IsNonVarTerm(t) (!PL_is_variable(t))
+#define YAP_IsApplTerm(t) PL_is_compound(t)
+#define YAP_Deref(t) (t)
+
+#define YAP_LookupAtom(s) PL_new_atom(s)
+#define YAP_ArityOfFunctor(f) PL_functor_arity(f)
+#define YAP_NameOfFunctor(f) PL_functor_name(f)
+#define YAP_MkFunctor(name, arity) PL_new_functor(name, arity)
+#define YAP_MkNilTerm(t) PL_put_nil(t)
+
+#define YAP_Unify(t1, t2) PL_unify(t1, t2)
+
+#define YAP_AllocSpaceFromYap(size) PL_malloc(size)
+#define YAP_FreeSpaceFromYap(ptr) PL_free(ptr)
+
+static inline atom_t
+YAP_AtomOfTerm(term_t t)
+{ atom_t a;
+
+  if ( PL_get_atom(t, &a) )
+    return a;
+
+  return (atom_t)0;
+}
+
+static inline const char *
+YAP_AtomName(atom_t a)
+{ const char *s;
+
+  if ( a && (s=PL_atom_nchars(a, NULL)) )
+    return s;
+
+  return NULL;
+}
+
+
+static inline YAP_Int
+YAP_IntOfTerm(term_t t)
+{ int64_t i;
+
+  if ( PL_get_int64(t, &i) )
+    return i;
+
+  return -1;
+}
+
+
+#ifndef NAN
+#define NAN 0.0
+#endif
+
+static inline double
+YAP_FloatOfTerm(term_t t)
+{ double f;
+
+  if ( PL_get_float(t, &f) )
+    return f;
+
+  return NAN;
+}
+
+
+static inline term_t
+YAP_MkVarTerm(void)
+{ return PL_new_term_ref();
+}
+
+
+static inline term_t
+YAP_MkIntTerm(YAP_Int i)
+{ term_t t = PL_new_term_ref();
+
+  if ( PL_put_int64(t, i) )
+    return t;
+
+  return (term_t)0;			/* stack overflow */
+}
+
+
+static inline term_t
+YAP_MkAtomTerm(atom_t a)
+{ term_t t = PL_new_term_ref();
+
+  PL_put_atom(t, a);
+
+  return t;
+}
+
+
+static inline term_t
+YAP_MkFloatTerm(double f)
+{ term_t t = PL_new_term_ref();
+
+  if ( PL_put_float(t, f) )
+    return t;
+
+  return (term_t)0;
+}
+
+
+static inline term_t
+YAP_MkPairTerm(term_t head, term_t tail)
+{ term_t t;
+
+  if ( (t = PL_new_term_ref()) &&
+       PL_cons_list(t, head, tail) )
+    return t;
+
+  return (term_t)0;
+}
+
+
+static inline term_t
+YAP_MkApplTerm(functor_t f, int arity, term_t *tv)
+{ term_t t = PL_new_term_ref();
+  term_t t0;
+
+  if ( arity == 1 )
+  { t0 = *tv;
+  } else
+  { int i;
+
+    t0 = PL_new_term_refs(arity);
+    for(i=0; i<arity; i++)
+      PL_put_term(t0+0, tv[i]);
+  }
+
+  if ( PL_cons_functor_v(t, f, t0) )
+    return t;
+
+  return (term_t)0;
+}
+
+
+/* NOTE: The arity is encoded in the functor.  We check consistency
+*/
+
+static inline term_t
+YAP_MkNewApplTerm(functor_t f, int arity)
+{ term_t t = PL_new_term_ref();
+
+  assert(PL_functor_arity(f) == arity);
+  if ( PL_put_functor(t, f) )
+    return t;
+  else
+    return (term_t)0;
+}
+
+
+/* NOTE: This is expensive in SWI-Prolog.  YAP term-references are
+   direct pointers and thus it merely returns a pointer to the
+   array of arguments.  In SWI-Prolog, term references are indirect
+   handles and thus we must allocate a handle for each argument.
+*/
+
+static inline term_t
+YAP_ArgsOfTerm(term_t t)
+{ atom_t name;
+  int arity, i, res;
+  term_t args;
+
+  if ( !(res = PL_get_name_arity( t, &name, &arity)) ||
+       !(args = PL_new_term_refs(arity)) ) /* Leaves an exception on failure */
+    return (term_t)0;
+
+  for (i=1; i<=arity; i++)
+    _PL_get_arg(i, t, args+i-1);
+
+  return args;
+}
+
+
+static inline functor_t
+YAP_FunctorOfTerm(term_t t)
+{ functor_t f;
+
+  if ( PL_get_functor(t, &f) )
+    return f;
+
+  return (functor_t)f;
+}
+
+
+static inline term_t
+YAP_HeadOfTerm(term_t t)
+{ term_t ht = PL_new_term_refs(2);
+
+  if ( PL_get_list(t, ht, ht+1) )
+    return ht;
+
+  return 0;
+}
+
+static inline term_t
+YAP_TailOfTerm(term_t t)
+{ term_t ht = PL_new_term_refs(2);
+
+  if ( PL_get_list(t, ht, ht+1) )
+    return ht+1;
+
+  return 0;
+}
+
+static inline term_t
+YAP_ArgOfTerm(int arg, term_t t)
+{ term_t a = PL_new_term_ref();
+
+  _PL_get_arg(arg, t, a);
+
+  return a;
+}
+
+
+
+
+#endif /*YAP_INTERFACE_H_INCLUDED*/

package/lib/swipl/include/sicstus/sicstus.h

@@ -0,0 +1,452 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2010-2024, VU University Amsterdam
+			      SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+This include file emulates <sicstus.h> for SWI-Prolog.
+
+This  version  was   written   to   get    the   Alpino   parser   suite
+(http://www.let.rug.nl/vannoord/alp/Alpino/) to run on SWI-Prolog. It is
+by no means complete and intended  as   a  `living document'. So, please
+contribute   your   changes.    See     also    library(qpforeign)   and
+library(dialect/sicstus).
+
+Most should be(come) fully compatible. Some  issues are hard to emulate.
+Please checks the notes for:
+
+	* SP_to_os()
+	* SP_from_os()
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+#ifndef SICSTUS_H_INCLUDED
+#define SICSTUS_H_INCLUDED
+#include <SWI-Prolog.h>
+#include <assert.h>
+
+typedef term_t SP_term_ref;
+typedef atom_t SP_atom;
+typedef predicate_t SP_pred_ref;
+
+#define SP_ERROR  -1
+#define SP_FAILURE 0
+#define SP_SUCCESS 1
+
+#define SP_WHEN_RESTORE 1		/* Note: these are not supported yet */
+#define SP_WHEN_SAVE 2
+
+#define SP_TYPE_ATOM     PL_ATOM
+#define SP_TYPE_COMPOUND PL_TERM
+#define SP_TYPE_FLOAT    PL_FLOAT
+#define SP_TYPE_INTEGER  PL_INTEGER
+#define SP_TYPE_VARIABLE PL_VARIABLE
+
+
+		 /*******************************
+		 *  READING AND WRITING TERMS	*
+		 *******************************/
+
+#define REP_SP PL_cvt_encoding()
+
+#define SP_new_term_ref() PL_new_nil_ref()
+
+#define SP_is_list(t) PL_is_list(t)
+
+#define SP_cons_list(l,h,t) PL_cons_list(l,h,t)
+
+#define SP_atom_from_string(s) PL_new_atom(s)
+#define SP_string_from_atom(a) PL_atom_chars(a)
+
+#define SP_put_variable(t) PL_put_variable(t)
+#define SP_put_atom(t,a) PL_put_atom(t,a)
+#define SP_put_integer(t,i) PL_put_integer(t,i)
+#define SP_put_float(t,f) PL_put_float(t,f)
+#define SP_put_list(t) PL_put_list(t)
+#define SP_put_term(t1,t2) PL_put_term(t1,t2)
+
+#define SP_get_float(t,f) PL_get_float(t,f)
+#define SP_get_functor(t,n,a) PL_get_name_arity(t,n,a)
+#define SP_get_list(l,h,t) PL_get_list(l,h,t)
+#define SP_get_string(t,s) PL_get_chars(t,(char**)(s),CVT_ATOM|REP_SP)
+#define SP_get_integer(t,pi) PL_get_long(t, pi)
+#define SP_get_arg(i,t,a) PL_get_arg(i,t,a)
+
+#define SP_unify(x,y) PL_unify(x,y)
+#define SP_term_type(t) PL_term_type(t)
+
+static __inline int
+SP_put_string(term_t t, const char *s)
+{ PL_put_variable(t);
+
+  return PL_unify_chars(t, PL_ATOM|REP_SP, (size_t)-1, s);
+}
+
+
+static __inline int
+SP_put_list_n_bytes(SP_term_ref list, SP_term_ref tail,
+		    size_t len, unsigned char const *buf)
+{ term_t t0 = PL_new_term_refs(2);
+  int rc = PL_unify_chars(t0, PL_CODE_LIST|PL_DIFF_LIST|REP_ISO_LATIN_1,
+			  len, (const char*)buf);
+
+  if ( rc )
+  { PL_put_term(list, t0);
+    rc = PL_unify(tail, t0+1);
+  }
+
+  return rc;
+}
+
+
+static __inline int
+SP_put_list_chars(SP_term_ref list, SP_term_ref tail, const char *s)
+{ term_t t0 = PL_new_term_refs(2);
+  int rc = PL_unify_chars(t0, PL_CODE_LIST|PL_DIFF_LIST|REP_SP,
+			  (size_t)-1, s);
+
+  if ( rc )
+  { PL_put_term(list, t0);
+    rc = PL_unify(tail, t0+1);
+  }
+
+  return rc;
+}
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+Copies into the byte array s the  initial elements of term, which should
+hold a list of integers in the range   [0,255],  so that at most n bytes
+are used. The number of bytes actually   written is assigned to *w. tail
+is set to the remainder of the list. The   array s must have room for at
+least n bytes.
+
+TBD: This implementation is a bit slow, but   it should do the trick for
+now.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+static __inline int
+SP_get_list_n_bytes(SP_term_ref term,
+		    SP_term_ref tail,
+		    size_t n,
+		    size_t *w,
+		    unsigned char *s)
+{ size_t written = 0;
+  term_t head = PL_new_term_ref();
+
+  PL_put_term(tail, term);
+  while( written < n && PL_get_list(tail, head, tail) )
+  { int i;
+
+    if ( PL_get_integer(head, &i) && i >= 0 && i <= 255 )
+    { s[written++] = i;
+    } else
+    { *w = written;
+      return SP_ERROR;			/* Is this ok? */
+    }
+  }
+
+  *w = written;
+  return SP_SUCCESS;
+}
+
+
+static __inline int
+SP_get_number_codes(SP_term_ref term, char const **s)
+{ char *tmp;
+
+  if ( PL_get_chars(term, &tmp, CVT_NUMBER) )
+  { *s = (const char*)tmp;
+    return true;
+  }
+
+  return false;
+}
+
+
+static __inline int
+SP_put_number_codes(SP_term_ref term, char const *s)
+{ term_t t = PL_new_term_ref();
+
+  if ( PL_chars_to_term(s, t) &&
+       PL_is_number(t) )
+  { PL_put_term(term, t);
+    return true;
+  }
+
+  return false;
+}
+
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+If native is zero, buf  consists  of   the  buf_size  bytes  of the twos
+complement representation of the integer. Less  significant bytes are at
+lower indices
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+static __inline int
+SP_put_integer_bytes(SP_term_ref term,
+		     void *buf, size_t buf_size,
+		     int native)
+{ if ( native )
+  { int64_t val;
+
+    switch(buf_size)
+    { case 1:
+	{ char *p = (char*)buf;
+	val = *p;
+	break;
+      }
+      case 2:
+	{ short *p = (short*)buf;
+	val = *p;
+	break;
+      }
+      case 4:
+	{ int *p = (int*)buf;
+	val = *p;
+	break;
+      }
+      case 8:
+	{ int64_t *p = (int64_t*)buf;
+	val = *p;
+	break;
+      }
+    default:
+      return false;
+    }
+
+    return PL_put_int64(term, val);
+  } else					/* see above */
+  {
+#ifdef __GNU_MP__
+    mpz_t mpz;
+    int rc;
+
+    mpz_init(mpz);
+    mpz_import(mpz,
+	       buf_size,			/* COUNT */
+	       1,				/* ORDER */
+	       1,				/* SIZE */
+	       0,				/* ENDIAN (native) */
+	       0,				/* NAILS */
+	       buf);				/* OP */
+    PL_put_variable(term);
+    rc = PL_unify_mpz(term, mpz);
+    mpz_clear(mpz);
+
+    return rc;
+#else
+    assert(0);
+#endif
+  }
+}
+
+
+
+static __inline int
+SP_cons_functor_array(SP_term_ref term, SP_atom name, int arity,
+		      SP_term_ref *arg)
+{ functor_t f = PL_new_functor(name, arity);
+  term_t argv;
+
+  if ( (argv=PL_new_term_refs(arity)) )
+  { int i;
+
+    for(i=0; i<arity; i++)
+    { if ( !PL_put_term(argv+i, arg[i]) )
+	return false;
+    }
+
+    return PL_cons_functor_v(term, f, argv);
+  }
+
+  return false;
+}
+
+
+static __inline int
+SP_cons_functor(SP_term_ref term, SP_atom name, int arity, ...)
+{ functor_t f = PL_new_functor(name, arity);
+  term_t argv;
+
+  if ( (argv=PL_new_term_refs(arity)) )
+  { int i;
+    va_list args;
+    int rc = true;
+
+    va_start(args, arity);
+    for(i=0; i<arity; i++)
+    { SP_term_ref a = va_arg(args, SP_term_ref);
+      if ( !PL_put_term(argv+i, a) )
+      { rc = false;
+	break;
+      }
+    }
+    va_end(args);
+
+    return rc && PL_cons_functor_v(term, f, argv);
+  }
+
+  return false;
+}
+
+
+
+		 /*******************************
+		 * RETURN CODES AND EXCEPTIONS	*
+		 *******************************/
+
+#define SP_raise_exception(t) do { PL_raise_exception(t); \
+				   SP_set_state(SP_ERROR); \
+				 } while(0)
+#define SP_fail()	      do { SP_set_state(SP_FAILURE); \
+				 } while(0)
+#define SP_WRAP_INIT() \
+	SP_set_state(SP_SUCCESS)
+#define SP_WRAP_CHECK_STATE() \
+	if ( SP_get_state() != SP_SUCCESS ) \
+	  return false
+
+
+		 /*******************************
+		 *	 C CALLING PROLOG	*
+		 *******************************/
+
+#define SP_predicate(name,arity,module) PL_predicate(name,arity,module)
+
+static __inline int
+SP_query(SP_pred_ref predicate, ...)
+{ atom_t name;
+  size_t i, arity;
+  module_t module;
+  fid_t fid;
+  qid_t qid;
+  term_t t0;
+  va_list args;
+
+  if ( !(fid = PL_open_foreign_frame()) )
+    return SP_ERROR;
+
+  PL_predicate_info(predicate, &name, &arity, &module);
+
+  if ( !(t0 = PL_new_term_refs(arity)) )
+  { PL_close_foreign_frame(fid);
+    return SP_ERROR;
+  }
+
+  va_start(args, predicate);
+  for(i=0; i<arity; i++)
+  { term_t a = va_arg(args, term_t);
+    PL_put_term(t0+i, a);
+  }
+  va_end(args);
+
+  if ( !(qid=PL_open_query(NULL, PL_Q_CATCH_EXCEPTION, predicate, t0)) )
+    return SP_ERROR;
+  if ( !PL_next_solution(qid) )
+  { term_t ex = PL_exception(qid);
+
+    PL_cut_query(qid);
+    PL_close_foreign_frame(fid);
+    if ( ex )
+      return SP_ERROR;
+    return SP_FAILURE;
+  }
+  PL_cut_query(qid);
+  PL_close_foreign_frame(fid);
+
+  return SP_SUCCESS;
+}
+
+
+static __inline int
+SP_query_cut_fail(SP_pred_ref predicate, ...)
+{ atom_t name;
+  size_t i, arity;
+  module_t module;
+  fid_t fid;
+  qid_t qid;
+  term_t t0;
+  va_list args;
+
+  if ( !(fid = PL_open_foreign_frame()) )
+    return SP_ERROR;
+
+  PL_predicate_info(predicate, &name, &arity, &module);
+
+  if ( !(t0 = PL_new_term_refs(arity)) )
+  { PL_close_foreign_frame(fid);
+    return SP_ERROR;
+  }
+
+  va_start(args, predicate);
+  for(i=0; i<arity; i++)
+  { term_t a = va_arg(args, term_t);
+    PL_put_term(t0+i, a);
+  }
+  va_end(args);
+
+  if ( !(qid=PL_open_query(NULL, PL_Q_CATCH_EXCEPTION, predicate, t0)) )
+    return SP_ERROR;
+  if ( !PL_next_solution(qid) )
+  { term_t ex = PL_exception(qid);
+
+    PL_cut_query(qid);
+    if ( ex )
+    { PL_close_foreign_frame(fid);
+      return SP_ERROR;
+    }
+    PL_discard_foreign_frame(fid);
+    return SP_FAILURE;
+  }
+  PL_cut_query(qid);
+  PL_discard_foreign_frame(fid);
+
+  return SP_SUCCESS;
+}
+
+
+#define SP_malloc(n) PL_malloc(n)
+#define SP_realloc(p,n) PL_realloc(p,n)
+#define SP_free(p) PL_free(p)
+
+
+/* These functions perform string-encoding conversion between Prolog and
+   the OS-native representation.  This is done using the conversion-flag
+   in SWI-Prolog's PL_get_chars() and PL_unify_chars() routines. I'm not
+   sure how we should deal with this.
+*/
+
+#define SP_to_os(s,c) (s)
+#define SP_from_os(s,c) (s)
+
+#endif /*SICSTUS_H_INCLUDED*/