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

Merge /home/vsc/yap

Browse Source
This commit is contained in:
Vítor Santos Costa 2018-11-06 16:50:42 +00:00
commit 54e16f6f19
32 changed files with 4515 additions and 4880 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
C/absmi.c
View File

@ -957,15 +957,14 @@ static void undef_goal(USES_REGS1) {
} else { } else {
d0 = AbsAppl(HR); d0 = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred; *HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR, *imax = HR+pe->ArityOfPE; CELL *ip=HR;
HR = imax; UInt imax = pe->ArityOfPE;
BEGP(pt1); HR += imax;
pt1 = XREGS + 1; UInt i = 1;
for (; ip < imax; ip++) { for (; i <= imax; ip++, i++) {
BEGD(d1); BEGD(d1);
BEGP(pt0); BEGP(pt0);
pt0 = pt1++; d1 = XREGS[i];
d1 = *pt0;
deref_head(d1, undef_unk); deref_head(d1, undef_unk);
undef_nonvar: undef_nonvar:
/* just copy it to the heap */ /* just copy it to the heap */
@ -973,19 +972,17 @@ static void undef_goal(USES_REGS1) {
continue; continue;
derefa_body(d1, pt0, undef_unk, undef_nonvar); derefa_body(d1, pt0, undef_unk, undef_nonvar);
if (pt0 <= HR) { if (pt0 < HR) {
/* variable is safe */ /* variable is safe */
*ip = (CELL)pt0; *ip = (CELL)pt0;
} else { } else {
/* bind it, in case it is a local variable */ /* bind it, in case it is a local variable */
d1 = Unsigned(ip);
RESET_VARIABLE(ip); RESET_VARIABLE(ip);
Bind_Local(pt0, d1); Bind_Local(pt0, Unsigned(ip));
} }
ENDP(pt0); ENDP(pt0);
ENDD(d1); ENDD(d1);
} }
ENDP(pt1);
} }
ARG1 = AbsPair(HR); ARG1 = AbsPair(HR);
HR[1] = d0; HR[1] = d0;

918
C/utilpreds.c
View File

File diff suppressed because it is too large Load Diff

21
CXX/yapi.hh
View File

@ -13,7 +13,7 @@
#include <vector> #include <vector>
extern "C" { extern "C" {
#include "config.h" #include "YapConfig.h"
} }
#if HAVE_GMPXX_H #if HAVE_GMPXX_H
@ -41,17 +41,14 @@ extern "C"{
extern "C" { extern "C" {
#include <stdlib.h> #include <stdlib.h>
// Bad export from Python // Bad export from Python
#include <config.h> #include <YapConfig.h>
#include <stddef.h> #include <stddef.h>
#if YAP_PYTHON #if YAP_PYTHON
#include <Python.h> #include <Python.h>
@ -102,22 +99,19 @@ X_API extern void YAP_UserCPredicate(const char *, YAP_UserCPred,
X_API extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, X_API extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred,
YAP_Arity, YAP_Term); YAP_Arity, YAP_Term);
X_API extern void YAP_UserBackCPredicate(const char *name, X_API extern void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init,
YAP_UserCPred init, YAP_UserCPred cont, YAP_Arity arity,
YAP_UserCPred cont, YAP_Arity extra);
YAP_Arity arity, YAP_Arity extra);
X_API extern void YAP_UserBackCutCPredicate(const char *name, X_API extern void YAP_UserBackCutCPredicate(const char *name,
YAP_UserCPred init, YAP_UserCPred init,
YAP_UserCPred cont, YAP_UserCPred cont,
YAP_UserCPred cut, YAP_UserCPred cut, YAP_Arity arity,
YAP_Arity arity, YAP_Arity extra); YAP_Arity extra);
X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp); X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp);
extern YAP_Term YAP_MkcharPTerm(char *s); extern YAP_Term YAP_MkcharPTerm(char *s);
} }
class YAPEngine; class YAPEngine;
@ -130,7 +124,6 @@ class YAPModule;
class YAPError; class YAPError;
class YAPPredicate; class YAPPredicate;
#include "yapa.hh" #include "yapa.hh"
#include "yapie.hh" #include "yapie.hh"

4
H/YapHandles.h
View File

@ -218,9 +218,9 @@ INLINE_ONLY yhandle_t Yap_InitHandle__(Term t USES_REGS) {
ensure_slots(1 PASS_REGS); ensure_slots(1 PASS_REGS);
if (t==0) { if (t==0) {
t = MkVarTerm(); t = MkVarTerm();
} else if (IsVarTerm(t) ) { } else if (IsVarTerm(t) && VarOfTerm(t) > HR ) {
Term tg = MkVarTerm(); Term tg = MkVarTerm();
Bind_Global( VarOfTerm(t), tg); Bind_Local(VarOfTerm(t), tg);
} }
LOCAL_HandleBase[old_slots] = t; LOCAL_HandleBase[old_slots] = t;
LOCAL_CurHandle++; LOCAL_CurHandle++;

12
H/udi_private.h
View File

@ -1,4 +1,4 @@
#include "config.h" #include "YapConfig.h"
#include "udi.h" #include "udi.h"
#include "utarray.h" #include "utarray.h"
#include "uthash.h" #include "uthash.h"
@ -19,8 +19,7 @@ UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL };
* All the info we need to enter user indexed code * All the info we need to enter user indexed code
* stored in a uthash * stored in a uthash
*/ */
struct udi_info struct udi_info {
{
PredEntry *p; // predicate (need to identify asserts) PredEntry *p; // predicate (need to identify asserts)
UT_array *clauselist; // clause list used on returns UT_array *clauselist; // clause list used on returns
UT_array *args; // indexed args UT_array *args; // indexed args
@ -44,18 +43,15 @@ static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk);
/* single indexing helpers (no intersection needed just create clauselist) */ /* single indexing helpers (no intersection needed just create clauselist) */
#include "clause_list.h" #include "clause_list.h"
struct si_callback_h struct si_callback_h {
{
clause_list_t cl; clause_list_t cl;
UT_array *clauselist; UT_array *clauselist;
void *pred; void *pred;
}; };
typedef struct si_callback_h *si_callback_h_t; typedef struct si_callback_h *si_callback_h_t;
static inline int si_callback(void *key, void *data, void *arg) static inline int si_callback(void *key, void *data, void *arg) {
{
si_callback_h_t c = (si_callback_h_t)arg; si_callback_h_t c = (si_callback_h_t)arg;
yamop **cl = (yamop **)utarray_eltptr(c->clauselist, ((YAP_Int)data) - 1); yamop **cl = (yamop **)utarray_eltptr(c->clauselist, ((YAP_Int)data) - 1);
return Yap_ClauseListExtend(c->cl, *cl, c->pred); return Yap_ClauseListExtend(c->cl, *cl, c->pred);
} }

9
console/yap.c
View File

@ -8,16 +8,14 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: Yap.C * * File: Yap.C * Last Rev:
* Last Rev: * ** Mods: * Comments: Yap's Main File *
* Mods: *
* Comments: Yap's Main File *
* * * *
*************************************************************************/ *************************************************************************/
/* static char SccsId[] = "X 4.3.3"; */ /* static char SccsId[] = "X 4.3.3"; */
#include "YapConfig.h"
#include "YapInterface.h" #include "YapInterface.h"
#include "config.h"
#include "cut_c.h" #include "cut_c.h"
@ -113,7 +111,6 @@ static bool exec_top_level(int BootMode, YAP_init_args *iap) {
} }
return true; return true;
// YAP_Exit(EXIT_SUCCESS); // YAP_Exit(EXIT_SUCCESS);
} }
// FILE *debugf; // FILE *debugf;

4
include/SWI-Prolog.h
View File

@ -19,7 +19,7 @@ extern "C" {
//=== includes =============================================================== //=== includes ===============================================================
#ifdef YAP_KERNEL #ifdef YAP_KERNEL
#include "config.h" #include "YapConfig.h"
#ifdef __cplusplus #ifdef __cplusplus
} }
@ -40,8 +40,8 @@ extern "C" {
#include "YapInterface.h" #include "YapInterface.h"
#else #else
#if _YAP_NOT_INSTALLED_ #if _YAP_NOT_INSTALLED_
#include <YapConfig.h>
#include <YapInterface.h> #include <YapInterface.h>
#include <config.h>
#else #else
#include <Yap/YapInterface.h> #include <Yap/YapInterface.h>
#endif #endif

2
include/YapInterface.h
View File

@ -31,6 +31,8 @@ The following routines export the YAP internals and architecture.
#define _yap_c_interface_h 1 #define _yap_c_interface_h 1
#include "YapConfig.h"
#define __YAP_PROLOG__ 1 #define __YAP_PROLOG__ 1
#ifndef YAPVERSION #ifndef YAPVERSION

2
library/matrix/matrix.c
View File

@ -13,8 +13,8 @@
* * * *
*************************************************************************/ *************************************************************************/
#include "YapConfig.h"
#include "YapInterface.h" #include "YapInterface.h"
#include "config.h"
#include <math.h> #include <math.h>
#if defined(__MINGW32__) || _MSC_VER #if defined(__MINGW32__) || _MSC_VER
#include <windows.h> #include <windows.h>

29
library/random/yap_random.c
View File

@ -8,14 +8,11 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: random.c * * File: random.c * Last rev:
* Last rev: * ** mods: * comments: regular expression interpreter *
* mods: *
* comments: regular expression interpreter *
* * * *
*************************************************************************/ *************************************************************************/
#include "config.h"
#include "YapInterface.h" #include "YapInterface.h"
#include <math.h> #include <math.h>
#if defined(__MINGW32__) || _MSC_VER #if defined(__MINGW32__) || _MSC_VER
@ -26,9 +23,7 @@ X_API void init_random( void );
static short a1 = 27314, b1 = 9213, c1 = 17773; static short a1 = 27314, b1 = 9213, c1 = 17773;
static YAP_Bool static YAP_Bool p_random(void) {
p_random(void)
{
double fli; double fli;
long int t1, t2, t3; long int t1, t2, t3;
@ -42,26 +37,20 @@ p_random(void)
return (YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli - (int)(fli)))); return (YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli - (int)(fli))));
} }
static YAP_Bool static YAP_Bool p_setrand(void) {
p_setrand(void)
{
a1 = YAP_IntOfTerm(YAP_ARG1); a1 = YAP_IntOfTerm(YAP_ARG1);
b1 = YAP_IntOfTerm(YAP_ARG2); b1 = YAP_IntOfTerm(YAP_ARG2);
c1 = YAP_IntOfTerm(YAP_ARG3); c1 = YAP_IntOfTerm(YAP_ARG3);
return (TRUE); return (TRUE);
} }
static YAP_Bool static YAP_Bool p_getrand(void) {
p_getrand(void)
{
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(a1)) && return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2, YAP_MkIntTerm(b1)) && YAP_Unify(YAP_ARG2, YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(c1))); YAP_Unify(YAP_ARG3, YAP_MkIntTerm(c1)));
} }
X_API void X_API void init_random(void) {
init_random(void)
{
YAP_UserCPredicate("random", p_random, 1); YAP_UserCPredicate("random", p_random, 1);
YAP_UserCPredicate("setrand", p_setrand, 3); YAP_UserCPredicate("setrand", p_setrand, 3);
YAP_UserCPredicate("getrand", p_getrand, 3); YAP_UserCPredicate("getrand", p_getrand, 3);
@ -71,10 +60,8 @@ init_random(void)
int WINAPI win_random(HANDLE, DWORD, LPVOID); int WINAPI win_random(HANDLE, DWORD, LPVOID);
int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved) int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved) {
{ switch (reason) {
switch (reason)
{
case DLL_PROCESS_ATTACH: case DLL_PROCESS_ATTACH:
break; break;
case DLL_PROCESS_DETACH: case DLL_PROCESS_DETACH:

2
library/regex/regcomp.c
View File

@ -50,7 +50,7 @@ static char sccsid[] = "@(#)regcomp.c 8.5 (Berkeley) 3/20/94";
#endif /* LIBC_SCCS and not lint */ #endif /* LIBC_SCCS and not lint */
#include "YapInterface.h" #include "YapInterface.h"
#include "config.h"
#if HAVE_SYS_TYPES_H #if HAVE_SYS_TYPES_H
#include <sys/types.h> #include <sys/types.h>
#endif #endif

5
library/regex/regexec.c
View File

@ -48,11 +48,10 @@ static char sccsid[] = "@(#)regexec.c 8.3 (Berkeley) 3/20/94";
* macros that code uses. This lets the same code operate on two different * macros that code uses. This lets the same code operate on two different
* representations for state sets. * representations for state sets.
*/ */
#include "config.h" #include "YapInterface.h"
#ifndef HAVE_REGEXEC #ifndef HAVE_REGEXEC
#include "YapInterface.h"
#if HAVE_SYS_TYPES_H #if HAVE_SYS_TYPES_H
#include <sys/types.h> #include <sys/types.h>
#endif #endif
@ -68,8 +67,8 @@ static char sccsid[] = "@(#)regexec.c 8.3 (Berkeley) 3/20/94";
#include <limits.h> #include <limits.h>
#endif #endif
#include "utils.h"
#include "regex2.h" #include "regex2.h"
#include "utils.h"
#include "yapregex.h" #include "yapregex.h"
#if used #if used

1
library/regex/regexp.c
View File

@ -22,7 +22,6 @@
* *
*/ */
#include "config.h"
#if HAVE_SYS_TYPES_H #if HAVE_SYS_TYPES_H
#include <sys/types.h> #include <sys/types.h>
#endif #endif

2
library/regex/yapregex.h
View File

@ -40,6 +40,8 @@
#ifndef _REGEX_H_ #ifndef _REGEX_H_
#define _REGEX_H_ #define _REGEX_H_
#include "YapInterface.h"
/* types */ /* types */
typedef int regoff_t; typedef int regoff_t;

3
library/system/sys.c
View File

@ -14,7 +14,6 @@
*************************************************************************/ *************************************************************************/
#include "YapInterface.h" #include "YapInterface.h"
#include "config.h"
#include <stdlib.h> #include <stdlib.h>
@ -312,7 +311,6 @@ static YAP_Bool rename_file(void) {
return (TRUE); return (TRUE);
} }
static YAP_Bool read_link(void) { static YAP_Bool read_link(void) {
char *s1 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); char *s1 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_READLINK #if HAVE_READLINK
@ -321,7 +319,6 @@ static YAP_Bool rename_file(void) {
if (readlink(s1, buf, MAXPATHLEN) < 0) if (readlink(s1, buf, MAXPATHLEN) < 0)
return false; return false;
/* return an error number */ /* return an error number */
if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom(buf)))) { if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom(buf)))) {
return false; return false;

360
library/tries/core_tries.c
View File

@ -5,19 +5,14 @@
version: $ID$ version: $ID$
*********************************************/ *********************************************/
/* -------------------------- */ /* -------------------------- */
/* Includes */ /* Includes */
/* -------------------------- */ /* -------------------------- */
#include <YapInterface.h> #include "core_tries.h"
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include "core_tries.h"
/* -------------------------- */ /* -------------------------- */
/* Local Procedures */ /* Local Procedures */
@ -32,18 +27,19 @@ static TrNode copy_child_nodes(TrNode parent_dest, TrNode node_source);
static void traverse_and_add(TrNode parent_dest, TrNode parent_source); static void traverse_and_add(TrNode parent_dest, TrNode parent_source);
static void traverse_and_join(TrNode parent_dest, TrNode parent_source); static void traverse_and_join(TrNode parent_dest, TrNode parent_source);
static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source); static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source);
static YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2); static YAP_Int traverse_and_count_common_entries(TrNode parent1,
TrNode parent2);
static YAP_Int traverse_and_count_entries(TrNode node); static YAP_Int traverse_and_count_entries(TrNode node);
static void traverse_and_get_usage(TrNode node, YAP_Int depth); static void traverse_and_get_usage(TrNode node, YAP_Int depth);
static void traverse_and_save(TrNode node, FILE *file, int float_block); static void traverse_and_save(TrNode node, FILE *file, int float_block);
static void traverse_and_load(TrNode parent, FILE *file); static void traverse_and_load(TrNode parent, FILE *file);
static void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode); static void traverse_and_print(TrNode node, int *arity, char *str,
int str_index, int mode);
static YAP_Term trie_to_list(TrNode node); static YAP_Term trie_to_list(TrNode node);
static YAP_Term trie_to_list_node(TrNode node); static YAP_Term trie_to_list_node(TrNode node);
static YAP_Term trie_to_list_floats(TrNode node); static YAP_Term trie_to_list_floats(TrNode node);
/* -------------------------- */ /* -------------------------- */
/* Local Variables */ /* Local Variables */
/* -------------------------- */ /* -------------------------- */
@ -51,7 +47,8 @@ static YAP_Term trie_to_list_floats(TrNode node);
static TrEngine CURRENT_TRIE_ENGINE; static TrEngine CURRENT_TRIE_ENGINE;
static YAP_Int USAGE_ENTRIES, USAGE_NODES, USAGE_VIRTUAL_NODES; static YAP_Int USAGE_ENTRIES, USAGE_NODES, USAGE_VIRTUAL_NODES;
static YAP_Int CURRENT_AUXILIARY_TERM_STACK_SIZE, CURRENT_TRIE_MODE, CURRENT_LOAD_VERSION, CURRENT_DEPTH, CURRENT_INDEX; static YAP_Int CURRENT_AUXILIARY_TERM_STACK_SIZE, CURRENT_TRIE_MODE,
CURRENT_LOAD_VERSION, CURRENT_DEPTH, CURRENT_INDEX;
static YAP_Term *AUXILIARY_TERM_STACK; static YAP_Term *AUXILIARY_TERM_STACK;
YAP_Term *stack_args, *stack_args_base, *stack_vars, *stack_vars_base; YAP_Term *stack_args, *stack_args_base, *stack_vars, *stack_vars_base;
static YAP_Functor FunctorComma; static YAP_Functor FunctorComma;
@ -64,13 +61,11 @@ static void (*DATA_DESTRUCT_FUNCTION)(TrNode);
static YAP_Int TRIE_DISABLE_HASH_TABLE = 0; static YAP_Int TRIE_DISABLE_HASH_TABLE = 0;
/* -------------------------- */ /* -------------------------- */
/* Inline Procedures */ /* Inline Procedures */
/* -------------------------- */ /* -------------------------- */
static static TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
TrNode child; TrNode child;
CURRENT_DEPTH++; CURRENT_DEPTH++;
@ -87,17 +82,23 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
child = *bucket; child = *bucket;
count = 0; count = 0;
while (child) { while (child) {
if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) if ((TrNode_entry(child) == t) ||
(((TrNode_entry(child) == PairEndTermTag) ||
(TrNode_entry(child) == PairEndEmptyTag)) &&
((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL)))
return child; return child;
count++; count++;
child = TrNode_next(child); child = TrNode_next(child);
} while (child); }
while (child)
;
TrHash_num_nodes(hash)++; TrHash_num_nodes(hash)++;
new_trie_node(child, t, parent, NULL, *bucket, AS_TR_NODE_NEXT(bucket)); new_trie_node(child, t, parent, NULL, *bucket, AS_TR_NODE_NEXT(bucket));
if (*bucket) if (*bucket)
TrNode_previous(*bucket) = child; TrNode_previous(*bucket) = child;
*bucket = child; *bucket = child;
if (count > MAX_NODES_PER_BUCKET && TrHash_num_nodes(hash) > TrHash_num_buckets(hash)) { if (count > MAX_NODES_PER_BUCKET &&
TrHash_num_nodes(hash) > TrHash_num_buckets(hash)) {
/* expand trie hash */ /* expand trie hash */
TrNode chain, next, *first_bucket, *new_bucket; TrNode chain, next, *first_bucket, *new_bucket;
int seed; int seed;
@ -110,7 +111,8 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
if (*--bucket) { if (*--bucket) {
chain = *bucket; chain = *bucket;
do { do {
new_bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), seed)); new_bucket =
TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), seed));
next = TrNode_next(chain); next = TrNode_next(chain);
TrNode_next(chain) = *new_bucket; TrNode_next(chain) = *new_bucket;
TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket); TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket);
@ -126,21 +128,26 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
} else { } else {
int count = 0; int count = 0;
do { do {
if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) if ((TrNode_entry(child) == t) ||
(((TrNode_entry(child) == PairEndTermTag) ||
(TrNode_entry(child) == PairEndEmptyTag)) &&
((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL)))
return child; return child;
count++; count++;
child = TrNode_next(child); child = TrNode_next(child);
} while (child); } while (child);
new_trie_node(child, t, parent, NULL, TrNode_child(parent), NULL); new_trie_node(child, t, parent, NULL, TrNode_child(parent), NULL);
TrNode_previous(TrNode_child(parent)) = child; TrNode_previous(TrNode_child(parent)) = child;
if ((++count > MAX_NODES_PER_TRIE_LEVEL) && (TRIE_DISABLE_HASH_TABLE == 0)) { if ((++count > MAX_NODES_PER_TRIE_LEVEL) &&
(TRIE_DISABLE_HASH_TABLE == 0)) {
/* alloc a new trie hash */ /* alloc a new trie hash */
TrHash hash; TrHash hash;
TrNode chain, next, *bucket; TrNode chain, next, *bucket;
new_trie_hash(hash, count, BASE_HASH_BUCKETS); new_trie_hash(hash, count, BASE_HASH_BUCKETS);
chain = child; chain = child;
do { do {
bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), BASE_HASH_BUCKETS - 1)); bucket = TrHash_bucket(
hash, HASH_TERM(TrNode_entry(chain), BASE_HASH_BUCKETS - 1));
next = TrNode_next(chain); next = TrNode_next(chain);
TrNode_next(chain) = *bucket; TrNode_next(chain) = *bucket;
TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket); TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket);
@ -156,9 +163,7 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) {
return child; return child;
} }
static TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) {
static
TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) {
TrNode child; TrNode child;
CURRENT_DEPTH++; CURRENT_DEPTH++;
@ -180,9 +185,7 @@ TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) {
return child; return child;
} }
static TrNode trie_node_check(TrNode parent, YAP_Term t) {
static
TrNode trie_node_check(TrNode parent, YAP_Term t) {
TrNode child; TrNode child;
child = TrNode_child(parent); child = TrNode_child(parent);
@ -203,18 +206,15 @@ TrNode trie_node_check(TrNode parent, YAP_Term t) {
return NULL; return NULL;
} }
static YAP_Term trie_to_list_create_simple(const char *atom_name, TrNode node) {
static
YAP_Term trie_to_list_create_simple(const char *atom_name, TrNode node) {
YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom(atom_name), 1); YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom(atom_name), 1);
YAP_Term child = trie_to_list(TrNode_child(node)); YAP_Term child = trie_to_list(TrNode_child(node));
return YAP_MkApplTerm(f, 1, &child); return YAP_MkApplTerm(f, 1, &child);
} }
static YAP_Term trie_to_list_create_simple_end(const char *atom_name,
static TrNode node) {
YAP_Term trie_to_list_create_simple_end(const char *atom_name, TrNode node) {
YAP_Atom atom = YAP_LookupAtom(atom_name); YAP_Atom atom = YAP_LookupAtom(atom_name);
if (IS_LEAF_TRIE_NODE(node)) { if (IS_LEAF_TRIE_NODE(node)) {
@ -226,9 +226,8 @@ YAP_Term trie_to_list_create_simple_end(const char *atom_name, TrNode node) {
} }
} }
static YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node,
static YAP_Term operand) {
YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node, YAP_Term operand) {
YAP_Atom atom = YAP_LookupAtom(atom_name); YAP_Atom atom = YAP_LookupAtom(atom_name);
if (IS_LEAF_TRIE_NODE(node)) { if (IS_LEAF_TRIE_NODE(node)) {
@ -236,14 +235,11 @@ YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node, YAP_Term op
return YAP_MkApplTerm(f, 1, &operand); return YAP_MkApplTerm(f, 1, &operand);
} else { } else {
YAP_Functor f = YAP_MkFunctor(atom, 2); YAP_Functor f = YAP_MkFunctor(atom, 2);
YAP_Term args[2] = { YAP_Term args[2] = {operand, trie_to_list(TrNode_child(node))};
operand, trie_to_list(TrNode_child(node))
};
return YAP_MkApplTerm(f, 2, args); return YAP_MkApplTerm(f, 2, args);
} }
} }
/* -------------------------- */ /* -------------------------- */
/* API */ /* API */
/* -------------------------- */ /* -------------------------- */
@ -253,7 +249,8 @@ TrEngine core_trie_init_module(void) {
TrEngine engine; TrEngine engine;
if (init_once) { if (init_once) {
new_struct(AUXILIARY_TERM_STACK, YAP_Term, BASE_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term)); new_struct(AUXILIARY_TERM_STACK, YAP_Term,
BASE_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term));
CURRENT_AUXILIARY_TERM_STACK_SIZE = BASE_AUXILIARY_TERM_STACK_SIZE; CURRENT_AUXILIARY_TERM_STACK_SIZE = BASE_AUXILIARY_TERM_STACK_SIZE;
CURRENT_TRIE_MODE = TRIE_MODE_STANDARD; CURRENT_TRIE_MODE = TRIE_MODE_STANDARD;
FunctorComma = YAP_MkFunctor(YAP_LookupAtom(","), 2); FunctorComma = YAP_MkFunctor(YAP_LookupAtom(","), 2);
@ -263,13 +260,12 @@ TrEngine core_trie_init_module(void) {
return engine; return engine;
} }
TrNode core_trie_open(TrEngine engine) { TrNode core_trie_open(TrEngine engine) {
TrNode node; TrNode node;
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
new_trie_node(node, 0, NULL, NULL, TrEngine_trie(engine), AS_TR_NODE_NEXT(&TrEngine_trie(engine))); new_trie_node(node, 0, NULL, NULL, TrEngine_trie(engine),
AS_TR_NODE_NEXT(&TrEngine_trie(engine)));
if (TrEngine_trie(engine)) if (TrEngine_trie(engine))
TrNode_previous(TrEngine_trie(engine)) = node; TrNode_previous(TrEngine_trie(engine)) = node;
TrEngine_trie(engine) = node; TrEngine_trie(engine) = node;
@ -277,9 +273,8 @@ TrNode core_trie_open(TrEngine engine) {
return node; return node;
} }
void core_trie_close(TrEngine engine, TrNode node,
void (*destruct_function)(TrNode)) {
void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
DATA_DESTRUCT_FUNCTION = destruct_function; DATA_DESTRUCT_FUNCTION = destruct_function;
if (TrNode_child(node)) if (TrNode_child(node))
@ -294,34 +289,26 @@ void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrN
return; return;
} }
void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)) { void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)) {
while (TrEngine_trie(engine)) while (TrEngine_trie(engine))
core_trie_close(engine, TrEngine_trie(engine), destruct_function); core_trie_close(engine, TrEngine_trie(engine), destruct_function);
return; return;
} }
void core_trie_set_mode(YAP_Int mode) { void core_trie_set_mode(YAP_Int mode) {
CURRENT_TRIE_MODE = mode; CURRENT_TRIE_MODE = mode;
return; return;
} }
YAP_Int core_trie_get_mode(void) { return CURRENT_TRIE_MODE; }
TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry,
YAP_Int core_trie_get_mode(void) { YAP_Int *depth) {
return CURRENT_TRIE_MODE;
}
TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int *depth) {
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
CURRENT_DEPTH = 0; CURRENT_DEPTH = 0;
stack_args_base = stack_args = AUXILIARY_TERM_STACK; stack_args_base = stack_args = AUXILIARY_TERM_STACK;
stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; stack_vars_base = stack_vars =
AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
node = put_entry(node, entry); node = put_entry(node, entry);
if (!IS_LEAF_TRIE_NODE(node)) { if (!IS_LEAF_TRIE_NODE(node)) {
MARK_AS_LEAF_TRIE_NODE(node); MARK_AS_LEAF_TRIE_NODE(node);
@ -337,13 +324,12 @@ TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int
return node; return node;
} }
TrNode core_trie_check_entry(TrNode node, YAP_Term entry) { TrNode core_trie_check_entry(TrNode node, YAP_Term entry) {
if (!TrNode_child(node)) if (!TrNode_child(node))
return NULL; return NULL;
stack_args_base = stack_args = AUXILIARY_TERM_STACK; stack_args_base = stack_args = AUXILIARY_TERM_STACK;
stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; stack_vars_base = stack_vars =
AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
node = check_entry(node, entry); node = check_entry(node, entry);
/* reset var terms */ /* reset var terms */
while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) { while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) {
@ -353,18 +339,16 @@ TrNode core_trie_check_entry(TrNode node, YAP_Term entry) {
return node; return node;
} }
YAP_Term core_trie_get_entry(TrNode node) { YAP_Term core_trie_get_entry(TrNode node) {
CURRENT_INDEX = -1; CURRENT_INDEX = -1;
stack_vars_base = stack_vars = AUXILIARY_TERM_STACK; stack_vars_base = stack_vars = AUXILIARY_TERM_STACK;
stack_args_base = stack_args = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; stack_args_base = stack_args =
AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1;
return get_entry(node, stack_args, &node); return get_entry(node, stack_args, &node);
} }
void core_trie_remove_entry(TrEngine engine, TrNode node,
void (*destruct_function)(TrNode)) {
void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
DATA_DESTRUCT_FUNCTION = destruct_function; DATA_DESTRUCT_FUNCTION = destruct_function;
if (DATA_DESTRUCT_FUNCTION) if (DATA_DESTRUCT_FUNCTION)
@ -374,9 +358,8 @@ void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_functi
return; return;
} }
void core_trie_remove_subtree(TrEngine engine, TrNode node,
void (*destruct_function)(TrNode)) {
void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) {
TrNode parent; TrNode parent;
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
@ -387,18 +370,17 @@ void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_func
return; return;
} }
void core_trie_add(TrNode node_dest, TrNode node_source,
void (*add_function)(TrNode, TrNode)) {
void core_trie_add(TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode)) {
DATA_ADD_FUNCTION = add_function; DATA_ADD_FUNCTION = add_function;
if (TrNode_child(node_dest) && TrNode_child(node_source)) if (TrNode_child(node_dest) && TrNode_child(node_source))
traverse_and_add(node_dest, node_source); traverse_and_add(node_dest, node_source);
return; return;
} }
void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source,
void (*add_function)(TrNode, TrNode),
void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*copy_function)(TrNode, TrNode)) { void (*copy_function)(TrNode, TrNode)) {
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
DATA_ADD_FUNCTION = add_function; DATA_ADD_FUNCTION = add_function;
DATA_COPY_FUNCTION = copy_function; DATA_COPY_FUNCTION = copy_function;
@ -406,13 +388,14 @@ void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void
if (TrNode_child(node_source)) if (TrNode_child(node_source))
traverse_and_join(node_dest, node_source); traverse_and_join(node_dest, node_source);
} else if (TrNode_child(node_source)) } else if (TrNode_child(node_source))
TrNode_child(node_dest) = copy_child_nodes(node_dest, TrNode_child(node_source)); TrNode_child(node_dest) =
copy_child_nodes(node_dest, TrNode_child(node_source));
return; return;
} }
void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source,
void (*add_function)(TrNode, TrNode),
void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*destruct_function)(TrNode)) { void (*destruct_function)(TrNode)) {
CURRENT_TRIE_ENGINE = engine; CURRENT_TRIE_ENGINE = engine;
DATA_ADD_FUNCTION = add_function; DATA_ADD_FUNCTION = add_function;
DATA_DESTRUCT_FUNCTION = destruct_function; DATA_DESTRUCT_FUNCTION = destruct_function;
@ -427,8 +410,6 @@ void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source,
return; return;
} }
YAP_Int core_trie_count_join(TrNode node1, TrNode node2) { YAP_Int core_trie_count_join(TrNode node1, TrNode node2) {
YAP_Int count = 0; YAP_Int count = 0;
@ -443,8 +424,6 @@ YAP_Int core_trie_count_join(TrNode node1, TrNode node2) {
return count; return count;
} }
YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) { YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) {
YAP_Int count = 0; YAP_Int count = 0;
@ -454,9 +433,8 @@ YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) {
return count; return count;
} }
void core_trie_save(TrNode node, FILE *file,
void (*save_function)(TrNode, FILE *)) {
void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE *)) {
CURRENT_INDEX = -1; CURRENT_INDEX = -1;
DATA_SAVE_FUNCTION = save_function; DATA_SAVE_FUNCTION = save_function;
if (TrNode_child(node)) { if (TrNode_child(node)) {
@ -468,9 +446,8 @@ void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE
return; return;
} }
TrNode core_trie_load(TrEngine engine, FILE *file,
void (*load_function)(TrNode, YAP_Int, FILE *)) {
TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, YAP_Int, FILE *)) {
TrNode node; TrNode node;
char version[15]; char version[15];
fpos_t curpos; fpos_t curpos;
@ -519,13 +496,13 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode,
DATA_LOAD_FUNCTION = load_function; DATA_LOAD_FUNCTION = load_function;
node = core_trie_open(engine); node = core_trie_open(engine);
traverse_and_load(node, file); traverse_and_load(node, file);
if (n) n = 0; // just added to remove the warning of not used! if (n)
n = 0; // just added to remove the warning of not used!
return node; return node;
} }
void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries,
YAP_Int *entries, YAP_Int *nodes) {
void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) {
*memory = TrEngine_memory(engine); *memory = TrEngine_memory(engine);
*tries = TrEngine_tries(engine); *tries = TrEngine_tries(engine);
*entries = TrEngine_entries(engine); *entries = TrEngine_entries(engine);
@ -533,9 +510,8 @@ void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *
return; return;
} }
void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries,
YAP_Int *entries, YAP_Int *nodes) {
void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) {
*memory = TrEngine_memory_max(engine); *memory = TrEngine_memory_max(engine);
*tries = TrEngine_tries_max(engine); *tries = TrEngine_tries_max(engine);
*entries = TrEngine_entries_max(engine); *entries = TrEngine_entries_max(engine);
@ -543,9 +519,8 @@ void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_I
return; return;
} }
void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes,
YAP_Int *virtual_nodes) {
void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *virtual_nodes) {
USAGE_ENTRIES = 0; USAGE_ENTRIES = 0;
USAGE_NODES = 0; USAGE_NODES = 0;
USAGE_VIRTUAL_NODES = 0; USAGE_VIRTUAL_NODES = 0;
@ -557,8 +532,6 @@ void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *vir
return; return;
} }
void core_trie_print(TrNode node, void (*print_function)(TrNode)) { void core_trie_print(TrNode node, void (*print_function)(TrNode)) {
DATA_PRINT_FUNCTION = print_function; DATA_PRINT_FUNCTION = print_function;
if (TrNode_child(node)) { if (TrNode_child(node)) {
@ -572,19 +545,9 @@ void core_trie_print(TrNode node, void (*print_function)(TrNode)) {
return; return;
} }
void core_disable_hash_table(void) { TRIE_DISABLE_HASH_TABLE = 1; }
void core_enable_hash_table(void) { TRIE_DISABLE_HASH_TABLE = 0; }
void core_disable_hash_table(void) {
TRIE_DISABLE_HASH_TABLE = 1;
}
void core_enable_hash_table(void) {
TRIE_DISABLE_HASH_TABLE = 0;
}
YAP_Term core_trie_to_list(TrNode node) { YAP_Term core_trie_to_list(TrNode node) {
TrNode root = TrNode_child(node); TrNode root = TrNode_child(node);
@ -595,19 +558,19 @@ YAP_Term core_trie_to_list(TrNode node) {
return YAP_MkAtomTerm(YAP_LookupAtom("empty")); return YAP_MkAtomTerm(YAP_LookupAtom("empty"));
} }
/* -------------------------- */ /* -------------------------- */
/* Local Procedures */ /* Local Procedures */
/* -------------------------- */ /* -------------------------- */
static static TrNode put_entry(TrNode node, YAP_Term entry) {
TrNode put_entry(TrNode node, YAP_Term entry) {
YAP_Term t = YAP_Deref(entry); YAP_Term t = YAP_Deref(entry);
if (YAP_IsVarTerm(t)) { if (YAP_IsVarTerm(t)) {
if (IsTrieVar(t, stack_vars, stack_vars_base)) { if (IsTrieVar(t, stack_vars, stack_vars_base)) {
node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)); node = trie_node_check_insert(
node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2));
} else { } else {
node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - stack_vars) / 2)); node = trie_node_check_insert(
node, MkTrieVar((stack_vars_base - stack_vars) / 2));
PUSH_UP(stack_vars, t, stack_args); PUSH_UP(stack_vars, t, stack_args);
*((YAP_Term *)t) = (YAP_Term)stack_vars; *((YAP_Term *)t) = (YAP_Term)stack_vars;
PUSH_UP(stack_vars, stack_vars, stack_args); PUSH_UP(stack_vars, stack_vars, stack_args);
@ -684,16 +647,16 @@ TrNode put_entry(TrNode node, YAP_Term entry) {
return node; return node;
} }
static TrNode check_entry(TrNode node, YAP_Term entry) {
static
TrNode check_entry(TrNode node, YAP_Term entry) {
YAP_Term t = YAP_Deref(entry); YAP_Term t = YAP_Deref(entry);
if (YAP_IsVarTerm(t)) { if (YAP_IsVarTerm(t)) {
if (IsTrieVar(t, stack_vars, stack_vars_base)) { if (IsTrieVar(t, stack_vars, stack_vars_base)) {
if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)))) if (!(node = trie_node_check(
node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2))))
return NULL; return NULL;
} else { } else {
if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - stack_vars) / 2)))) if (!(node = trie_node_check(
node, MkTrieVar((stack_vars_base - stack_vars) / 2))))
return NULL; return NULL;
PUSH_UP(stack_vars, t, stack_args); PUSH_UP(stack_vars, t, stack_args);
*((YAP_Term *)t) = (YAP_Term)stack_vars; *((YAP_Term *)t) = (YAP_Term)stack_vars;
@ -792,9 +755,7 @@ TrNode check_entry(TrNode node, YAP_Term entry) {
return node; return node;
} }
static YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
static
YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
YAP_Term t = (YAP_Term)&t; YAP_Term t = (YAP_Term)&t;
while (TrNode_parent(node)) { while (TrNode_parent(node)) {
t = TrNode_entry(node); t = TrNode_entry(node);
@ -834,7 +795,8 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
t2 = *stack_aux--; t2 = *stack_aux--;
t = YAP_MkPairTerm(t2, t); t = YAP_MkPairTerm(t2, t);
} }
} else if (CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */ } else if (CURRENT_TRIE_MODE &
TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */
YAP_Term *stack_aux = stack_mark; YAP_Term *stack_aux = stack_mark;
t = *stack_aux; t = *stack_aux;
if (t == YAP_TermNil()) if (t == YAP_TermNil())
@ -908,9 +870,7 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) {
return t; return t;
} }
static void remove_entry(TrNode node) {
static
void remove_entry(TrNode node) {
TrNode parent = TrNode_parent(node); TrNode parent = TrNode_parent(node);
while (parent) { while (parent) {
if (TrNode_previous(node)) { if (TrNode_previous(node)) {
@ -953,9 +913,7 @@ void remove_entry(TrNode node) {
return; return;
} }
static void remove_child_nodes(TrNode node) {
static
void remove_child_nodes(TrNode node) {
if (IS_HASH_NODE(node)) { if (IS_HASH_NODE(node)) {
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash)node; TrHash hash = (TrHash)node;
@ -982,9 +940,7 @@ void remove_child_nodes(TrNode node) {
return; return;
} }
static TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
static
TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
TrNode child_dest, next_dest; TrNode child_dest, next_dest;
if (IS_HASH_NODE(child_source)) { if (IS_HASH_NODE(child_source)) {
@ -993,7 +949,8 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
hash_source = (TrHash)child_source; hash_source = (TrHash)child_source;
first_bucket_source = TrHash_buckets(hash_source); first_bucket_source = TrHash_buckets(hash_source);
bucket_source = first_bucket_source + TrHash_num_buckets(hash_source); bucket_source = first_bucket_source + TrHash_num_buckets(hash_source);
new_trie_hash(hash_dest, TrHash_num_nodes(hash_source), TrHash_num_buckets(hash_source)); new_trie_hash(hash_dest, TrHash_num_nodes(hash_source),
TrHash_num_buckets(hash_source));
bucket_dest = TrHash_buckets(hash_dest) + TrHash_num_buckets(hash_dest); bucket_dest = TrHash_buckets(hash_dest) + TrHash_num_buckets(hash_dest);
do { do {
bucket_dest--; bucket_dest--;
@ -1010,7 +967,8 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
next_dest = copy_child_nodes(parent_dest, TrNode_next(child_source)); next_dest = copy_child_nodes(parent_dest, TrNode_next(child_source));
else else
next_dest = NULL; next_dest = NULL;
new_trie_node(child_dest, TrNode_entry(child_source), parent_dest, NULL, next_dest, NULL); new_trie_node(child_dest, TrNode_entry(child_source), parent_dest, NULL,
next_dest, NULL);
if (next_dest) if (next_dest)
TrNode_previous(next_dest) = child_dest; TrNode_previous(next_dest) = child_dest;
if (IS_LEAF_TRIE_NODE(child_source)) { if (IS_LEAF_TRIE_NODE(child_source)) {
@ -1019,13 +977,12 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) {
if (DATA_COPY_FUNCTION) if (DATA_COPY_FUNCTION)
(*DATA_COPY_FUNCTION)(child_dest, child_source); (*DATA_COPY_FUNCTION)(child_dest, child_source);
} else } else
TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); TrNode_child(child_dest) =
copy_child_nodes(child_dest, TrNode_child(child_source));
return child_dest; return child_dest;
} }
static void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
static
void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
TrNode child_dest, child_source; TrNode child_dest, child_source;
/* parent_source is not a leaf node */ /* parent_source is not a leaf node */
@ -1072,9 +1029,7 @@ void traverse_and_add(TrNode parent_dest, TrNode parent_source) {
return; return;
} }
static void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
static
void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
TrNode child_dest, child_source; TrNode child_dest, child_source;
/* parent_source is not a leaf node */ /* parent_source is not a leaf node */
@ -1099,14 +1054,16 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
/* child_dest and child_source are not leaf nodes */ /* child_dest and child_source are not leaf nodes */
traverse_and_join(child_dest, child_source); traverse_and_join(child_dest, child_source);
} else { } else {
child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source)); child_dest =
trie_node_check_insert(parent_dest, TrNode_entry(child_source));
if (IS_LEAF_TRIE_NODE(child_source)) { if (IS_LEAF_TRIE_NODE(child_source)) {
MARK_AS_LEAF_TRIE_NODE(child_dest); MARK_AS_LEAF_TRIE_NODE(child_dest);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
if (DATA_COPY_FUNCTION) if (DATA_COPY_FUNCTION)
(*DATA_COPY_FUNCTION)(child_dest, child_source); (*DATA_COPY_FUNCTION)(child_dest, child_source);
} else } else
TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); TrNode_child(child_dest) =
copy_child_nodes(child_dest, TrNode_child(child_source));
} }
child_source = TrNode_next(child_source); child_source = TrNode_next(child_source);
} }
@ -1125,23 +1082,23 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) {
/* child_dest and child_source are not leaf nodes */ /* child_dest and child_source are not leaf nodes */
traverse_and_join(child_dest, child_source); traverse_and_join(child_dest, child_source);
} else { } else {
child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source)); child_dest =
trie_node_check_insert(parent_dest, TrNode_entry(child_source));
if (IS_LEAF_TRIE_NODE(child_source)) { if (IS_LEAF_TRIE_NODE(child_source)) {
MARK_AS_LEAF_TRIE_NODE(child_dest); MARK_AS_LEAF_TRIE_NODE(child_dest);
INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE);
if (DATA_COPY_FUNCTION) if (DATA_COPY_FUNCTION)
(*DATA_COPY_FUNCTION)(child_dest, child_source); (*DATA_COPY_FUNCTION)(child_dest, child_source);
} else } else
TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); TrNode_child(child_dest) =
copy_child_nodes(child_dest, TrNode_child(child_source));
} }
child_source = TrNode_next(child_source); child_source = TrNode_next(child_source);
} }
return; return;
} }
static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
static
void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
TrNode child_dest, child_source, child_next; TrNode child_dest, child_source, child_next;
/* parent_dest is not a leaf node */ /* parent_dest is not a leaf node */
@ -1206,9 +1163,8 @@ void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) {
return; return;
} }
static YAP_Int traverse_and_count_common_entries(TrNode parent1,
static TrNode parent2) {
YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) {
TrNode child1, child2; TrNode child1, child2;
YAP_Int count = 0; YAP_Int count = 0;
@ -1254,9 +1210,7 @@ YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) {
return count; return count;
} }
static YAP_Int traverse_and_count_entries(TrNode node) {
static
YAP_Int traverse_and_count_entries(TrNode node) {
YAP_Int count = 0; YAP_Int count = 0;
if (IS_HASH_NODE(node)) { if (IS_HASH_NODE(node)) {
@ -1283,9 +1237,7 @@ YAP_Int traverse_and_count_entries(TrNode node) {
return count; return count;
} }
static void traverse_and_get_usage(TrNode node, YAP_Int depth) {
static
void traverse_and_get_usage(TrNode node, YAP_Int depth) {
if (IS_HASH_NODE(node)) { if (IS_HASH_NODE(node)) {
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash; TrHash hash;
@ -1314,9 +1266,7 @@ void traverse_and_get_usage(TrNode node, YAP_Int depth) {
return; return;
} }
static void traverse_and_save(TrNode node, FILE *file, int float_block) {
static
void traverse_and_save(TrNode node, FILE *file, int float_block) {
YAP_Term t; YAP_Term t;
if (IS_HASH_NODE(node)) { if (IS_HASH_NODE(node)) {
@ -1363,13 +1313,14 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) {
expand_auxiliary_term_stack(); expand_auxiliary_term_stack();
AUXILIARY_TERM_STACK[CURRENT_INDEX] = t; AUXILIARY_TERM_STACK[CURRENT_INDEX] = t;
if (YAP_IsAtomTerm(t)) if (YAP_IsAtomTerm(t))
fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0'); fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index,
YAP_AtomName(YAP_AtomOfTerm(t)), '\0');
else /* (ApplTag & t) */ else /* (ApplTag & t) */
fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK, index, fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK,
index,
YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))), YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))),
YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t))); YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)));
} else } else if (YAP_IsAtomTerm(t))
if (YAP_IsAtomTerm(t))
fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index); fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index);
else else
fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index); fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index);
@ -1378,17 +1329,14 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) {
fprintf(file, "- "); fprintf(file, "- ");
if (DATA_SAVE_FUNCTION) if (DATA_SAVE_FUNCTION)
(*DATA_SAVE_FUNCTION)(node, file); (*DATA_SAVE_FUNCTION)(node, file);
} } else {
else {
traverse_and_save(TrNode_child(node), file, float_block); traverse_and_save(TrNode_child(node), file, float_block);
fprintf(file, "- "); fprintf(file, "- ");
} }
return; return;
} }
static void traverse_and_load(TrNode parent, FILE *file) {
static
void traverse_and_load(TrNode parent, FILE *file) {
TrHash hash = NULL; TrHash hash = NULL;
YAP_Term t; YAP_Term t;
int n; int n;
@ -1429,7 +1377,8 @@ void traverse_and_load(TrNode parent, FILE *file) {
CURRENT_INDEX = index; CURRENT_INDEX = index;
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE) if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
expand_auxiliary_term_stack(); expand_auxiliary_term_stack();
AUXILIARY_TERM_STACK[CURRENT_INDEX] = YAP_MkAtomTerm(YAP_LookupAtom(atom)); AUXILIARY_TERM_STACK[CURRENT_INDEX] =
YAP_MkAtomTerm(YAP_LookupAtom(atom));
} }
t = AUXILIARY_TERM_STACK[index]; t = AUXILIARY_TERM_STACK[index];
} else if (t == FUNCTOR_SAVE_MARK) { } else if (t == FUNCTOR_SAVE_MARK) {
@ -1442,7 +1391,8 @@ void traverse_and_load(TrNode parent, FILE *file) {
CURRENT_INDEX = index; CURRENT_INDEX = index;
if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE) if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE)
expand_auxiliary_term_stack(); expand_auxiliary_term_stack();
AUXILIARY_TERM_STACK[CURRENT_INDEX] = ApplTag | ((YAP_Term) YAP_MkFunctor(YAP_LookupAtom(atom), arity)); AUXILIARY_TERM_STACK[CURRENT_INDEX] =
ApplTag | ((YAP_Term)YAP_MkFunctor(YAP_LookupAtom(atom), arity));
} }
t = AUXILIARY_TERM_STACK[index]; t = AUXILIARY_TERM_STACK[index];
} else if (t == FLOAT_SAVE_MARK) } else if (t == FLOAT_SAVE_MARK)
@ -1451,13 +1401,13 @@ void traverse_and_load(TrNode parent, FILE *file) {
traverse_and_load(child, file); traverse_and_load(child, file);
} while (fscanf(file, UInt_FORMAT, &t)); } while (fscanf(file, UInt_FORMAT, &t));
CURRENT_DEPTH--; CURRENT_DEPTH--;
if (n) n = 0; // just added to remove the warning of not used! if (n)
n = 0; // just added to remove the warning of not used!
return; return;
} }
static void traverse_and_print(TrNode node, int *arity, char *str,
static int str_index, int mode) {
void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode) {
YAP_Term t; YAP_Term t;
int last_pair_mark = -arity[arity[0]]; int last_pair_mark = -arity[arity[0]];
@ -1475,7 +1425,8 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
traverse_and_print(node, arity, str, str_index, mode); traverse_and_print(node, arity, str, str_index, mode);
memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
/* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag
* side-effect */
if (str_index > 0 && str[str_index - 1] != '[') if (str_index > 0 && str[str_index - 1] != '[')
str[str_index - 1] = ','; str[str_index - 1] = ',';
/* restore possible PairEndTermTag side-effect */ /* restore possible PairEndTermTag side-effect */
@ -1494,7 +1445,8 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
traverse_and_print(TrNode_next(node), arity, str, str_index, mode); traverse_and_print(TrNode_next(node), arity, str, str_index, mode);
memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) {
/* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect
*/
if (str_index > 0 && str[str_index - 1] != '[') if (str_index > 0 && str[str_index - 1] != '[')
str[str_index - 1] = ','; str[str_index - 1] = ',';
/* restore possible PairEndTermTag side-effect */ /* restore possible PairEndTermTag side-effect */
@ -1558,7 +1510,8 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
} }
} }
} else if (YAP_IsAtomTerm(t)) { } else if (YAP_IsAtomTerm(t)) {
str_index += sprintf(& str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t))); str_index +=
sprintf(&str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t)));
while (arity[0]) { while (arity[0]) {
if (arity[arity[0]] == 1) { if (arity[arity[0]] == 1) {
str_index += sprintf(&str[str_index], ")"); str_index += sprintf(&str[str_index], ")");
@ -1618,7 +1571,9 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
} }
} }
} else if (ApplTag & t) { } else if (ApplTag & t) {
str_index += sprintf(& str[str_index], "%s(", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t)))); str_index +=
sprintf(&str[str_index], "%s(",
YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))));
arity[0]++; arity[0]++;
arity[arity[0]] = YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)); arity[arity[0]] = YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t));
} else { } else {
@ -1639,9 +1594,7 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m
return; return;
} }
static YAP_Term trie_to_list(TrNode node) {
static
YAP_Term trie_to_list(TrNode node) {
YAP_Term tail = YAP_MkAtomTerm(YAP_LookupAtom("[]")); YAP_Term tail = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
#define CONSUME_NODE_LIST \ #define CONSUME_NODE_LIST \
@ -1673,9 +1626,7 @@ YAP_Term trie_to_list(TrNode node) {
return tail; return tail;
} }
static YAP_Term trie_to_list_node(TrNode node) {
static
YAP_Term trie_to_list_node(TrNode node) {
YAP_Term t = TrNode_entry(node); YAP_Term t = TrNode_entry(node);
if (YAP_IsIntTerm(t) || YAP_IsAtomTerm(t)) { if (YAP_IsIntTerm(t) || YAP_IsAtomTerm(t)) {
@ -1703,11 +1654,9 @@ YAP_Term trie_to_list_node(TrNode node) {
YAP_Functor f = (YAP_Functor)(~ApplTag & t); YAP_Functor f = (YAP_Functor)(~ApplTag & t);
int arity = YAP_ArityOfFunctor(f); int arity = YAP_ArityOfFunctor(f);
YAP_Functor new_f = YAP_MkFunctor(YAP_LookupAtom("functor"), 3); YAP_Functor new_f = YAP_MkFunctor(YAP_LookupAtom("functor"), 3);
YAP_Term args[3] = { YAP_Term args[3] = {YAP_MkAtomTerm(YAP_NameOfFunctor(f)),
YAP_MkAtomTerm(YAP_NameOfFunctor(f)),
YAP_MkIntTerm((YAP_Int)arity), YAP_MkIntTerm((YAP_Int)arity),
trie_to_list(TrNode_child(node)) trie_to_list(TrNode_child(node))};
};
return YAP_MkApplTerm(new_f, 3, args); return YAP_MkApplTerm(new_f, 3, args);
} }
fprintf(stderr, "***************************************\n"); fprintf(stderr, "***************************************\n");
@ -1718,16 +1667,16 @@ YAP_Term trie_to_list_node(TrNode node) {
return YAP_MkAtomTerm(YAP_LookupAtom("fail")); return YAP_MkAtomTerm(YAP_LookupAtom("fail"));
} }
#define PUSH_NEW_FLOAT_TERM(val) \ #define PUSH_NEW_FLOAT_TERM(val) \
result = YAP_MkPairTerm( \ result = YAP_MkPairTerm(trie_to_list_create_two("float", TrNode_child(node), \
trie_to_list_create_two("float", TrNode_child(node), YAP_MkFloatTerm(val)), \ YAP_MkFloatTerm(val)), \
result); result);
#ifdef TAG_LOW_BITS_32 #ifdef TAG_LOW_BITS_32
YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile YAP_Term *p, volatile double *f) { YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node,
volatile YAP_Term *p,
volatile double *f) {
if (IS_HASH_NODE(node)) { if (IS_HASH_NODE(node)) {
TrNode *first_bucket, *bucket; TrNode *first_bucket, *bucket;
TrHash hash = (TrHash)node; TrHash hash = (TrHash)node;
@ -1755,9 +1704,7 @@ YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile Y
} }
#endif /* TAG_LOW_BITS_32 */ #endif /* TAG_LOW_BITS_32 */
static YAP_Term trie_to_list_floats(TrNode node) {
static
YAP_Term trie_to_list_floats(TrNode node) {
volatile union { volatile union {
double f; double f;
YAP_Term p[SIZE_FLOAT_AS_TERM]; YAP_Term p[SIZE_FLOAT_AS_TERM];
@ -1775,7 +1722,8 @@ YAP_Term trie_to_list_floats(TrNode node) {
do { do {
tf.p[0] = TrNode_entry(node); tf.p[0] = TrNode_entry(node);
#ifdef TAG_LOW_BITS_32 #ifdef TAG_LOW_BITS_32
result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); result = trie_to_list_floats_tag_low_32(result, TrNode_child(node),
&tf.p, &tf.f);
#else #else
PUSH_NEW_FLOAT_TERM(tf.f); PUSH_NEW_FLOAT_TERM(tf.f);
#endif /* TAG_LOW_BITS_32 */ #endif /* TAG_LOW_BITS_32 */
@ -1786,7 +1734,8 @@ YAP_Term trie_to_list_floats(TrNode node) {
do { do {
tf.p[0] = TrNode_entry(node); tf.p[0] = TrNode_entry(node);
#ifdef TAG_LOW_BITS_32 #ifdef TAG_LOW_BITS_32
result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p,
&tf.f);
#else #else
PUSH_NEW_FLOAT_TERM(tf.f); PUSH_NEW_FLOAT_TERM(tf.f);
#endif /* TAG_LOW_BITS_32 */ #endif /* TAG_LOW_BITS_32 */
@ -1797,5 +1746,4 @@ YAP_Term trie_to_list_floats(TrNode node) {
} }
#undef PUSH_NEW_FLOAT_TERM #undef PUSH_NEW_FLOAT_TERM
#include "core_dbtries.c" #include "core_dbtries.c"

147
library/tries/core_tries.h
View File

@ -5,13 +5,11 @@
version: $ID$ version: $ID$
*********************************************/ *********************************************/
/* -------------------------------------- */ /* -------------------------------------- */
/* Yap Tagging Scheme */ /* Yap Tagging Scheme */
/* -------------------------------------- */ /* -------------------------------------- */
#include "config.h" #include "YapInterface.h"
#if SIZEOF_INT_P == 4 #if SIZEOF_INT_P == 4
#define TAG_LOW_BITS_32 /* 'Tags_32LowTag.h' tagging scheme */ #define TAG_LOW_BITS_32 /* 'Tags_32LowTag.h' tagging scheme */
#define SIZE_FLOAT_AS_TERM 2 #define SIZE_FLOAT_AS_TERM 2
@ -22,8 +20,6 @@
#error Unknown tagging scheme #error Unknown tagging scheme
#endif /* YAP_SCHEME */ #endif /* YAP_SCHEME */
/* --------------------------- */ /* --------------------------- */
/* Defines */ /* Defines */
/* --------------------------- */ /* --------------------------- */
@ -53,8 +49,6 @@
#define BASE_AUXILIARY_TERM_STACK_SIZE 100000 #define BASE_AUXILIARY_TERM_STACK_SIZE 100000
/* --------------------------- */ /* --------------------------- */
/* Structs */ /* Structs */
/* --------------------------- */ /* --------------------------- */
@ -98,7 +92,8 @@ typedef struct trie_node {
#define TrNode_entry(X) ((X)->entry) #define TrNode_entry(X) ((X)->entry)
typedef struct trie_hash { typedef struct trie_hash {
struct trie_node *parent; /* for compatibility with the trie_node data structure */ struct trie_node
*parent; /* for compatibility with the trie_node data structure */
struct trie_node **buckets; struct trie_node **buckets;
int number_of_buckets; int number_of_buckets;
int number_of_nodes; int number_of_nodes;
@ -119,9 +114,8 @@ typedef struct trie_hash {
#define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH) #define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH)
#define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *) #define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *)
#define AS_TR_NODE_NEXT(ADDR) (TrNode)((YAP_UInt)(ADDR) - 2 * sizeof(struct trie_node *)) #define AS_TR_NODE_NEXT(ADDR) \
(TrNode)((YAP_UInt)(ADDR)-2 * sizeof(struct trie_node *))
/* --------------------------- */ /* --------------------------- */
/* Macros */ /* Macros */
@ -129,12 +123,15 @@ typedef struct trie_hash {
#define TAG_ADDR(ADDR) ((YAP_UInt)(ADDR) | 0x1) #define TAG_ADDR(ADDR) ((YAP_UInt)(ADDR) | 0x1)
#define UNTAG_ADDR(ADDR) ((YAP_UInt)(ADDR) & ~(0x1)) #define UNTAG_ADDR(ADDR) ((YAP_UInt)(ADDR) & ~(0x1))
#define PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, DATA) TrNode_child(TR_NODE) = (TrNode)TAG_ADDR(DATA) #define PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, DATA) \
TrNode_child(TR_NODE) = (TrNode)TAG_ADDR(DATA)
#define GET_DATA_FROM_LEAF_TRIE_NODE(TR_NODE) UNTAG_ADDR(TrNode_child(TR_NODE)) #define GET_DATA_FROM_LEAF_TRIE_NODE(TR_NODE) UNTAG_ADDR(TrNode_child(TR_NODE))
#define MARK_AS_LEAF_TRIE_NODE(TR_NODE) PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, TrNode_child(TR_NODE)) #define MARK_AS_LEAF_TRIE_NODE(TR_NODE) \
PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, TrNode_child(TR_NODE))
#define IS_LEAF_TRIE_NODE(TR_NODE) ((YAP_UInt)(TrNode_child(TR_NODE)) & 0x1) #define IS_LEAF_TRIE_NODE(TR_NODE) ((YAP_UInt)(TrNode_child(TR_NODE)) & 0x1)
#define IsTrieVar(TERM, STACK, STACK_BASE) ((YAP_Term *)(TERM) > STACK && (YAP_Term *)(TERM) <= STACK_BASE) #define IsTrieVar(TERM, STACK, STACK_BASE) \
((YAP_Term *)(TERM) > STACK && (YAP_Term *)(TERM) <= STACK_BASE)
#define MkTrieVar(INDEX) ((INDEX) << 4) #define MkTrieVar(INDEX) ((INDEX) << 4)
#define TrieVarIndex(TERM) ((TERM) >> 4) #define TrieVarIndex(TERM) ((TERM) >> 4)
@ -144,7 +141,9 @@ typedef struct trie_hash {
#define HASH_TERM(TERM, SEED) (((TERM) >> 4) & (SEED)) #define HASH_TERM(TERM, SEED) (((TERM) >> 4) & (SEED))
#define IS_HASH_NODE(NODE) (TrHash_mark(NODE) == NULL) #define IS_HASH_NODE(NODE) (TrHash_mark(NODE) == NULL)
#define BASE_SAVE_MARK 10000 /* could lead to errors if the number of different variables in a term is greater than it */ #define BASE_SAVE_MARK \
10000 /* could lead to errors if the number of different variables in a term \
is greater than it */
#define HASH_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK)) #define HASH_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK))
#define ATOM_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 1)) #define ATOM_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 1))
#define FUNCTOR_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 2)) #define FUNCTOR_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 2))
@ -154,7 +153,8 @@ typedef struct trie_hash {
#define POP_UP(STACK) *--STACK #define POP_UP(STACK) *--STACK
#define POP_DOWN(STACK) *++STACK #define POP_DOWN(STACK) *++STACK
#define PUSH_UP(STACK, ITEM, STACK_TOP) \ #define PUSH_UP(STACK, ITEM, STACK_TOP) \
{ if (STACK < STACK_TOP) { \ { \
if (STACK < STACK_TOP) { \
fprintf(stderr, "**************************************\n"); \ fprintf(stderr, "**************************************\n"); \
fprintf(stderr, " Tries core module: term stack full\n"); \ fprintf(stderr, " Tries core module: term stack full\n"); \
fprintf(stderr, "**************************************\n"); \ fprintf(stderr, "**************************************\n"); \
@ -163,7 +163,8 @@ typedef struct trie_hash {
STACK--; \ STACK--; \
} }
#define PUSH_DOWN(STACK, ITEM, STACK_TOP) \ #define PUSH_DOWN(STACK, ITEM, STACK_TOP) \
{ if (STACK > STACK_TOP) { \ { \
if (STACK > STACK_TOP) { \
fprintf(stderr, "**************************************\n"); \ fprintf(stderr, "**************************************\n"); \
fprintf(stderr, " Tries core module: term stack empty\n"); \ fprintf(stderr, " Tries core module: term stack empty\n"); \
fprintf(stderr, "**************************************\n"); \ fprintf(stderr, "**************************************\n"); \
@ -172,12 +173,11 @@ typedef struct trie_hash {
STACK++; \ STACK++; \
} }
#define new_struct(STR, STR_TYPE, STR_SIZE) \ #define new_struct(STR, STR_TYPE, STR_SIZE) \
STR = (STR_TYPE *)YAP_AllocSpaceFromYap(STR_SIZE) STR = (STR_TYPE *)YAP_AllocSpaceFromYap(STR_SIZE)
#define new_trie_engine(TR_ENGINE) \ #define new_trie_engine(TR_ENGINE) \
{ new_struct(TR_ENGINE, TYPE_TR_ENGINE, SIZEOF_TR_ENGINE); \ { \
new_struct(TR_ENGINE, TYPE_TR_ENGINE, SIZEOF_TR_ENGINE); \
TrEngine_trie(TR_ENGINE) = NULL; \ TrEngine_trie(TR_ENGINE) = NULL; \
TrEngine_memory(TR_ENGINE) = 0; \ TrEngine_memory(TR_ENGINE) = 0; \
TrEngine_tries(TR_ENGINE) = 0; \ TrEngine_tries(TR_ENGINE) = 0; \
@ -189,7 +189,8 @@ typedef struct trie_hash {
TrEngine_nodes_max(TR_ENGINE) = 0; \ TrEngine_nodes_max(TR_ENGINE) = 0; \
} }
#define new_trie_node(TR_NODE, ENTRY, PARENT, CHILD, NEXT, PREVIOUS) \ #define new_trie_node(TR_NODE, ENTRY, PARENT, CHILD, NEXT, PREVIOUS) \
{ new_struct(TR_NODE, TYPE_TR_NODE, SIZEOF_TR_NODE); \ { \
new_struct(TR_NODE, TYPE_TR_NODE, SIZEOF_TR_NODE); \
TrNode_entry(TR_NODE) = ENTRY; \ TrNode_entry(TR_NODE) = ENTRY; \
TrNode_parent(TR_NODE) = PARENT; \ TrNode_parent(TR_NODE) = PARENT; \
TrNode_child(TR_NODE) = CHILD; \ TrNode_child(TR_NODE) = CHILD; \
@ -199,7 +200,8 @@ typedef struct trie_hash {
INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \
} }
#define new_trie_hash(TR_HASH, NUM_NODES, NUM_BUCKETS) \ #define new_trie_hash(TR_HASH, NUM_NODES, NUM_BUCKETS) \
{ new_struct(TR_HASH, TYPE_TR_HASH, SIZEOF_TR_HASH); \ { \
new_struct(TR_HASH, TYPE_TR_HASH, SIZEOF_TR_HASH); \
TrHash_mark(TR_HASH) = NULL; \ TrHash_mark(TR_HASH) = NULL; \
TrHash_num_buckets(TR_HASH) = NUM_BUCKETS; \ TrHash_num_buckets(TR_HASH) = NUM_BUCKETS; \
new_hash_buckets(TR_HASH, NUM_BUCKETS); \ new_hash_buckets(TR_HASH, NUM_BUCKETS); \
@ -207,7 +209,9 @@ typedef struct trie_hash {
INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \
} }
#define new_hash_buckets(TR_HASH, NUM_BUCKETS) \ #define new_hash_buckets(TR_HASH, NUM_BUCKETS) \
{ int i; void **ptr; \ { \
int i; \
void **ptr; \
new_struct(ptr, void *, NUM_BUCKETS * sizeof(void *)); \ new_struct(ptr, void *, NUM_BUCKETS * sizeof(void *)); \
TrHash_buckets(TR_HASH) = (TYPE_TR_NODE **)ptr; \ TrHash_buckets(TR_HASH) = (TYPE_TR_NODE **)ptr; \
for (i = NUM_BUCKETS; i != 0; i--) \ for (i = NUM_BUCKETS; i != 0; i--) \
@ -215,10 +219,9 @@ typedef struct trie_hash {
INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \ INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \
} }
#define expand_auxiliary_term_stack() \ #define expand_auxiliary_term_stack() \
{ YAP_Term *aux_stack; \ { \
YAP_Term *aux_stack; \
YAP_Int aux_size = CURRENT_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term); \ YAP_Int aux_size = CURRENT_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term); \
new_struct(aux_stack, YAP_Term, aux_size * 2); \ new_struct(aux_stack, YAP_Term, aux_size * 2); \
memmove(aux_stack, AUXILIARY_TERM_STACK, aux_size); \ memmove(aux_stack, AUXILIARY_TERM_STACK, aux_size); \
@ -227,87 +230,101 @@ typedef struct trie_hash {
CURRENT_AUXILIARY_TERM_STACK_SIZE *= 2; \ CURRENT_AUXILIARY_TERM_STACK_SIZE *= 2; \
} }
#define free_struct(STR) YAP_FreeSpaceFromYap((char *)(STR))
#define free_struct(STR) \
YAP_FreeSpaceFromYap((char *) (STR))
#define free_trie_node(STR) \ #define free_trie_node(STR) \
{ free_struct(STR); \ { \
free_struct(STR); \
DECREMENT_NODES(CURRENT_TRIE_ENGINE); \ DECREMENT_NODES(CURRENT_TRIE_ENGINE); \
DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \
} }
#define free_trie_hash(STR) \ #define free_trie_hash(STR) \
{ free_struct(STR); \ { \
free_struct(STR); \
DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \
} }
#define free_hash_buckets(STR, NUM_BUCKETS) \ #define free_hash_buckets(STR, NUM_BUCKETS) \
{ free_struct(STR); \ { \
free_struct(STR); \
DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \ DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \
} }
#define INCREMENT_MEMORY(TR_ENGINE, SIZE) \ #define INCREMENT_MEMORY(TR_ENGINE, SIZE) \
{ TrEngine_memory(TR_ENGINE) += SIZE; \ { \
TrEngine_memory(TR_ENGINE) += SIZE; \
if (TrEngine_memory(TR_ENGINE) > TrEngine_memory_max(TR_ENGINE)) \ if (TrEngine_memory(TR_ENGINE) > TrEngine_memory_max(TR_ENGINE)) \
TrEngine_memory_max(TR_ENGINE) = TrEngine_memory(TR_ENGINE); \ TrEngine_memory_max(TR_ENGINE) = TrEngine_memory(TR_ENGINE); \
} }
#define INCREMENT_TRIES(TR_ENGINE) \ #define INCREMENT_TRIES(TR_ENGINE) \
{ TrEngine_tries(TR_ENGINE)++; \ { \
TrEngine_tries(TR_ENGINE)++; \
if (TrEngine_tries(TR_ENGINE) > TrEngine_tries_max(TR_ENGINE)) \ if (TrEngine_tries(TR_ENGINE) > TrEngine_tries_max(TR_ENGINE)) \
TrEngine_tries_max(TR_ENGINE) = TrEngine_tries(TR_ENGINE); \ TrEngine_tries_max(TR_ENGINE) = TrEngine_tries(TR_ENGINE); \
} }
#define INCREMENT_ENTRIES(TR_ENGINE) \ #define INCREMENT_ENTRIES(TR_ENGINE) \
{ TrEngine_entries(TR_ENGINE)++; \ { \
TrEngine_entries(TR_ENGINE)++; \
if (TrEngine_entries(TR_ENGINE) > TrEngine_entries_max(TR_ENGINE)) \ if (TrEngine_entries(TR_ENGINE) > TrEngine_entries_max(TR_ENGINE)) \
TrEngine_entries_max(TR_ENGINE) = TrEngine_entries(TR_ENGINE); \ TrEngine_entries_max(TR_ENGINE) = TrEngine_entries(TR_ENGINE); \
} }
#define INCREMENT_NODES(TR_ENGINE) \ #define INCREMENT_NODES(TR_ENGINE) \
{ TrEngine_nodes(TR_ENGINE)++; \ { \
TrEngine_nodes(TR_ENGINE)++; \
if (TrEngine_nodes(TR_ENGINE) > TrEngine_nodes_max(TR_ENGINE)) \ if (TrEngine_nodes(TR_ENGINE) > TrEngine_nodes_max(TR_ENGINE)) \
TrEngine_nodes_max(TR_ENGINE) = TrEngine_nodes(TR_ENGINE); \ TrEngine_nodes_max(TR_ENGINE) = TrEngine_nodes(TR_ENGINE); \
} }
#define DECREMENT_MEMORY(TR_ENGINE, SIZE) \ #define DECREMENT_MEMORY(TR_ENGINE, SIZE) TrEngine_memory(TR_ENGINE) -= SIZE
TrEngine_memory(TR_ENGINE) -= SIZE #define DECREMENT_TRIES(TR_ENGINE) TrEngine_tries(TR_ENGINE)--
#define DECREMENT_TRIES(TR_ENGINE) \ #define DECREMENT_ENTRIES(TR_ENGINE) TrEngine_entries(TR_ENGINE)--
TrEngine_tries(TR_ENGINE)-- #define DECREMENT_NODES(TR_ENGINE) TrEngine_nodes(TR_ENGINE)--
#define DECREMENT_ENTRIES(TR_ENGINE) \
TrEngine_entries(TR_ENGINE)--
#define DECREMENT_NODES(TR_ENGINE) \
TrEngine_nodes(TR_ENGINE)--
#define IS_FUNCTOR_NODE(N) \
#define IS_FUNCTOR_NODE(N) (((ApplTag & TrNode_entry(N)) == ApplTag) && \ (((ApplTag & TrNode_entry(N)) == ApplTag) && \
(TrNode_entry(N) != PairInitTag) && \ (TrNode_entry(N) != PairInitTag) && (TrNode_entry(N) != PairEndEmptyTag) && \
(TrNode_entry(N) != PairEndEmptyTag) && \
(TrNode_entry(N) != PairEndTermTag)) (TrNode_entry(N) != PairEndTermTag))
/* --------------------------- */ /* --------------------------- */
/* API */ /* API */
/* --------------------------- */ /* --------------------------- */
extern TrEngine core_trie_init_module(void); extern TrEngine core_trie_init_module(void);
extern TrNode core_trie_open(TrEngine engine); extern TrNode core_trie_open(TrEngine engine);
extern void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); extern void core_trie_close(TrEngine engine, TrNode node,
extern void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)); void (*destruct_function)(TrNode));
extern void core_trie_close_all(TrEngine engine,
void (*destruct_function)(TrNode));
extern void core_trie_set_mode(YAP_Int mode); extern void core_trie_set_mode(YAP_Int mode);
extern YAP_Int core_trie_get_mode(void); extern YAP_Int core_trie_get_mode(void);
extern TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int *depth); extern TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry,
YAP_Int *depth);
extern TrNode core_trie_check_entry(TrNode node, YAP_Term entry); extern TrNode core_trie_check_entry(TrNode node, YAP_Term entry);
extern YAP_Term core_trie_get_entry(TrNode node); extern YAP_Term core_trie_get_entry(TrNode node);
extern void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); extern void core_trie_remove_entry(TrEngine engine, TrNode node,
extern void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); void (*destruct_function)(TrNode));
extern void core_trie_add(TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode)); extern void core_trie_remove_subtree(TrEngine engine, TrNode node,
extern void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*copy_function)(TrNode, TrNode)); void (*destruct_function)(TrNode));
extern void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*destruct_function)(TrNode)); extern void core_trie_add(TrNode node_dest, TrNode node_source,
void (*add_function)(TrNode, TrNode));
extern void core_trie_join(TrEngine engine, TrNode node_dest,
TrNode node_source,
void (*add_function)(TrNode, TrNode),
void (*copy_function)(TrNode, TrNode));
extern void core_trie_intersect(TrEngine engine, TrNode node_dest,
TrNode node_source,
void (*add_function)(TrNode, TrNode),
void (*destruct_function)(TrNode));
extern YAP_Int core_trie_count_join(TrNode node1, TrNode node2); extern YAP_Int core_trie_count_join(TrNode node1, TrNode node2);
extern YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2); extern YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2);
extern void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE *)); extern void core_trie_save(TrNode node, FILE *file,
extern TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, YAP_Int, FILE *)); void (*save_function)(TrNode, FILE *));
extern void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes); extern TrNode core_trie_load(TrEngine engine, FILE *file,
extern void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes); void (*load_function)(TrNode, YAP_Int, FILE *));
extern void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *virtual_nodes); extern void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries,
YAP_Int *entries, YAP_Int *nodes);
extern void core_trie_max_stats(TrEngine engine, YAP_Int *memory,
YAP_Int *tries, YAP_Int *entries,
YAP_Int *nodes);
extern void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes,
YAP_Int *virtual_nodes);
extern void core_trie_print(TrNode node, void (*print_function)(TrNode)); extern void core_trie_print(TrNode node, void (*print_function)(TrNode));
extern void core_disable_hash_table(void); extern void core_disable_hash_table(void);

61
os/open_memstream.c
View File

@ -16,8 +16,7 @@
/* Written by Eric Blake <e...@byu.net>, 2010. */ /* Written by Eric Blake <e...@byu.net>, 2010. */
#include "YapConfig.h"
#include "config.h"
/* Specification. */ /* Specification. */
#include <stdio.h> #include <stdio.h>
@ -39,8 +38,7 @@ FILE * open_memstream (char **buf, size_t *len);
#define INITIAL_ALLOC 64 #define INITIAL_ALLOC 64
struct data struct data {
{
char **buf; /* User's argument. */ char **buf; /* User's argument. */
size_t *len; /* User's argument. Smaller of pos or eof. */ size_t *len; /* User's argument. Smaller of pos or eof. */
size_t pos; /* Current position. */ size_t pos; /* Current position. */
@ -54,15 +52,12 @@ typedef struct data data;
// verify (sizeof (int) <= sizeof (size_t)); // verify (sizeof (int) <= sizeof (size_t));
// verify (sizeof (int) <= sizeof (ssize_t)); // verify (sizeof (int) <= sizeof (ssize_t));
static int static int mem_write(void *c, const char *buf, int n) {
mem_write (void *c, const char *buf, int n)
{
data *cookie = c; data *cookie = c;
char *cbuf = *cookie->buf; char *cbuf = *cookie->buf;
/* Be sure we don't overflow. */ /* Be sure we don't overflow. */
if ((ssize_t) (cookie->pos + n) < 0) if ((ssize_t)(cookie->pos + n) < 0) {
{
errno = EFBIG; errno = EFBIG;
return EOF; return EOF;
} }
@ -70,8 +65,7 @@ mem_write (void *c, const char *buf, int n)
quadratic realloc behavior. Overallocate, to accomodate the quadratic realloc behavior. Overallocate, to accomodate the
requirement to always place a trailing NUL not counted by length. requirement to always place a trailing NUL not counted by length.
Thus, we want max(prev_size*1.5, cookie->posn1). */ Thus, we want max(prev_size*1.5, cookie->posn1). */
if (cookie->allocated <= cookie->pos + n) if (cookie->allocated <= cookie->pos + n) {
{
size_t newsize = cookie->allocated * 3 / 2; size_t newsize = cookie->allocated * 3 / 2;
if (newsize < cookie->pos + n + 1) if (newsize < cookie->pos + n + 1)
newsize = cookie->pos + n + 1; newsize = cookie->pos + n + 1;
@ -99,9 +93,7 @@ mem_write (void *c, const char *buf, int n)
return n; return n;
} }
static fpos_t static fpos_t mem_seek(void *c, fpos_t pos, int whence) {
mem_seek (void *c, fpos_t pos, int whence)
{
data *cookie = c; data *cookie = c;
off_t offset = pos; off_t offset = pos;
@ -109,39 +101,29 @@ mem_seek (void *c, fpos_t pos, int whence)
offset = cookie->pos; offset = cookie->pos;
else if (whence == SEEK_END) else if (whence == SEEK_END)
offset = cookie->eof; offset = cookie->eof;
if (offset < 0) if (offset < 0) {
{
errno = EINVAL; errno = EINVAL;
offset = -1; offset = -1;
} } else if ((size_t)offset != offset) {
else if ((size_t) offset != offset)
{
errno = ENOSPC; errno = ENOSPC;
offset = -1; offset = -1;
} } else {
else if (cookie->pos < cookie->eof) {
{
if (cookie->pos < cookie->eof)
{
(*cookie->buf)[cookie->pos] = cookie->c; (*cookie->buf)[cookie->pos] = cookie->c;
cookie->c = '\0'; cookie->c = '\0';
} }
cookie->pos = offset; cookie->pos = offset;
if (cookie->pos < cookie->eof) if (cookie->pos < cookie->eof) {
{
cookie->c = (*cookie->buf)[cookie->pos]; cookie->c = (*cookie->buf)[cookie->pos];
(*cookie->buf)[cookie->pos] = '\0'; (*cookie->buf)[cookie->pos] = '\0';
*cookie->len = cookie->pos; *cookie->len = cookie->pos;
} } else
else
*cookie->len = cookie->eof; *cookie->len = cookie->eof;
} }
return offset; return offset;
} }
static int static int mem_close(void *c) {
mem_close (void *c)
{
data *cookie = c; data *cookie = c;
char *buf; char *buf;
@ -153,21 +135,17 @@ mem_close (void *c)
return 0; return 0;
} }
FILE * FILE *open_memstream(char **buf, size_t *len) {
open_memstream (char **buf, size_t *len)
{
FILE *f; FILE *f;
data *cookie; data *cookie;
if (!buf || !len) if (!buf || !len) {
{
errno = EINVAL; errno = EINVAL;
return NULL; return NULL;
} }
if (!(cookie = malloc(sizeof *cookie))) if (!(cookie = malloc(sizeof *cookie)))
return NULL; return NULL;
if (!(*buf = malloc (INITIAL_ALLOC))) if (!(*buf = malloc(INITIAL_ALLOC))) {
{
free(cookie); free(cookie);
errno = ENOMEM; errno = ENOMEM;
return NULL; return NULL;
@ -176,14 +154,11 @@ open_memstream (char **buf, size_t *len)
*len = 0; *len = 0;
f = funopen(cookie, NULL, mem_write, mem_seek, mem_close); f = funopen(cookie, NULL, mem_write, mem_seek, mem_close);
if (!f) if (!f) {
{
int saved_errno = errno; int saved_errno = errno;
free(cookie); free(cookie);
errno = saved_errno; errno = saved_errno;
} } else {
else
{
cookie->buf = buf; cookie->buf = buf;
cookie->len = len; cookie->len = len;
cookie->pos = 0; cookie->pos = 0;

6
os/sysbits.h
View File

@ -13,7 +13,7 @@
* *
*/ */
#include "config.h" #include "YapConfig.h"
#if _WIN32 || defined(__MINGW32__) #if _WIN32 || defined(__MINGW32__)
#if !defined(MINGW_HAS_SECURE_API) #if !defined(MINGW_HAS_SECURE_API)
@ -22,10 +22,10 @@
//#undef _POSIX_ //#undef _POSIX_
#endif #endif
#include "Yap.h" #include "Yap.h"
#include "YapEval.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "YapText.h" #include "YapText.h"
#include "Yatom.h" #include "Yatom.h"
#include "YapEval.h"
#include "yapio.h" #include "yapio.h"
// Win32 InputOutput Support // Win32 InputOutput Support
@ -46,7 +46,6 @@
#endif #endif
#endif #endif
#ifdef HAVE_UNISTD_H #ifdef HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif #endif
@ -121,7 +120,6 @@
/* windows.h does not like absmi.h, this /* windows.h does not like absmi.h, this
should fix it for now */ should fix it for now */
#include <math.h> #include <math.h>
#include <math.h>
#if HAVE_TIME_H #if HAVE_TIME_H
#include <time.h> #include <time.h>
#endif #endif

2
os/yio.yap
View File

@ -181,7 +181,7 @@ display(Stream, T) :-
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),
'$system_catch'(call(portray(T)),user,Error,user:'$Error'(Error)), !, catch(user:portray(T),Error,'$Error'(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.

1
packages/bdd/cudd.c
View File

@ -41,7 +41,6 @@ CUDD will generate better/faster code.
#include <stdio.h> #include <stdio.h>
#include "YapInterface.h" #include "YapInterface.h"
#include "config.h"
#include "cudd_config.h" #include "cudd_config.h"
#if HAVE_STRING_H #if HAVE_STRING_H

49
packages/bdd/simplecudd/simplecudd.h
View File

@ -186,14 +186,13 @@
* * * *
\******************************************************************************/ \******************************************************************************/
#include "YapInterface.h"
#include "cudd_config.h"
#include <math.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include <math.h>
#include <time.h> #include <time.h>
#include "config.h"
#include "cudd_config.h"
#if HAVE_CUDD_UTIL_H #if HAVE_CUDD_UTIL_H
#include <cudd/util.h> #include <cudd/util.h>
@ -293,12 +292,17 @@ DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader); DdNode *FileGenerateBDD(DdManager *manager, namedvars varmap,
DdNode** FileGenerateBDDForest(DdManager *manager, namedvars varmap, bddfileheader fileheader); bddfileheader fileheader);
DdNode **FileGenerateBDDForest(DdManager *manager, namedvars varmap,
bddfileheader fileheader);
DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap); DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap);
DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline); DdNode *LineParser(DdManager *manager, namedvars varmap, DdNode **inter,
DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline); int maxinter, char *function, int iline);
DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper); DdNode *OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter,
int maxinter, char *function, int iline);
DdNode *BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2,
char Operator, int inegoper);
int getInterBDD(char *function); int getInterBDD(char *function);
char *getFileName(const char *function); char *getFileName(const char *function);
int GetParam(char *inputline, int iParam); int GetParam(char *inputline, int iParam);
@ -313,8 +317,10 @@ namedvars InitNamedVars(int varcnt, int varstart);
void EnlargeNamedVars(namedvars *varmap, int newvarcnt); void EnlargeNamedVars(namedvars *varmap, int newvarcnt);
int AddNamedVarAt(namedvars varmap, const char *varname, int index); int AddNamedVarAt(namedvars varmap, const char *varname, int index);
int AddNamedVar(namedvars varmap, const char *varname); int AddNamedVar(namedvars varmap, const char *varname);
void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue); void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue,
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue); void *dynvalue);
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue,
int ivalue, void *dynvalue);
int GetNamedVarIndex(const namedvars varmap, const char *varname); int GetNamedVarIndex(const namedvars varmap, const char *varname);
int RepairVarcnt(namedvars *varmap); int RepairVarcnt(namedvars *varmap);
char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node);
@ -330,10 +336,12 @@ DdNode* LowNodeOf(DdManager *manager, DdNode *node);
hisqueue *InitHistory(int varcnt); hisqueue *InitHistory(int varcnt);
void ReInitHistory(hisqueue *HisQueue, int varcnt); void ReInitHistory(hisqueue *HisQueue, int varcnt);
void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue); void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue,
int ivalue, void *dynvalue);
hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node); hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node);
int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node); int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node);
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd); void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue,
DdNode *bdd);
/* Save-load */ /* Save-load */
@ -341,14 +349,19 @@ bddfileheader ReadFileHeader(char *filename);
int CheckFileVersion(const char *version); int CheckFileVersion(const char *version);
DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile);
DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current); DdNode *LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes,
DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum); FILE *inputfile, nodeline current);
DdNode *GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes,
char *varname, int nodenum);
int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd,
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile); char *filename);
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes,
DdNode *Current, FILE *outputfile);
void ExpandNodes(hisqueue *Nodes, int index, int nodenum); void ExpandNodes(hisqueue *Nodes, int index, int nodenum);
/* Export */ /* Export */
int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename); int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename);
int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd,
char *filename);

56
packages/bdd/simplecudd_lfi/simplecudd.h
View File

@ -184,16 +184,15 @@
* * * *
\******************************************************************************/ \******************************************************************************/
#include "YapInterface.h"
#include <unistd.h> #include "cudd_config.h"
#include "pqueue.h"
#include <math.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include <math.h>
#include <time.h> #include <time.h>
#include "pqueue.h" #include <unistd.h>
#include "config.h"
#include "cudd_config.h"
#if HAVE_CUDD_UTIL_H #if HAVE_CUDD_UTIL_H
#include <cudd/util.h> #include <cudd/util.h>
#elif HAVE_UTIL_H #elif HAVE_UTIL_H
@ -297,12 +296,17 @@ DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader); DdNode *FileGenerateBDD(DdManager *manager, namedvars varmap,
DdNode** FileGenerateBDDForest(DdManager *manager, namedvars varmap, bddfileheader fileheader); bddfileheader fileheader);
DdNode **FileGenerateBDDForest(DdManager *manager, namedvars varmap,
bddfileheader fileheader);
DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap); DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap);
DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline); DdNode *LineParser(DdManager *manager, namedvars varmap, DdNode **inter,
DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline); int maxinter, char *function, int iline);
DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper); DdNode *OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter,
int maxinter, char *function, int iline);
DdNode *BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2,
char Operator, int inegoper);
int getInterBDD(char *function); int getInterBDD(char *function);
char *getFileName(const char *function); char *getFileName(const char *function);
int GetParam(char *inputline, int iParam); int GetParam(char *inputline, int iParam);
@ -317,12 +321,15 @@ namedvars InitNamedVars(int varcnt, int varstart);
void EnlargeNamedVars(namedvars *varmap, int newvarcnt); void EnlargeNamedVars(namedvars *varmap, int newvarcnt);
int AddNamedVarAt(namedvars varmap, const char *varname, int index); int AddNamedVarAt(namedvars varmap, const char *varname, int index);
int AddNamedVar(namedvars varmap, const char *varname); int AddNamedVar(namedvars varmap, const char *varname);
void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue); void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue,
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue); void *dynvalue);
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue,
int ivalue, void *dynvalue);
int GetNamedVarIndex(const namedvars varmap, const char *varname); int GetNamedVarIndex(const namedvars varmap, const char *varname);
int RepairVarcnt(namedvars *varmap); int RepairVarcnt(namedvars *varmap);
const char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); const char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node);
const char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); const char *GetNodeVarNameDisp(DdManager *manager, namedvars varmap,
DdNode *node);
int all_loaded(namedvars varmap, int disp); int all_loaded(namedvars varmap, int disp);
int all_loaded_for_deterministic_variables(namedvars varmap, int disp); int all_loaded_for_deterministic_variables(namedvars varmap, int disp);
@ -335,10 +342,12 @@ DdNode* LowNodeOf(DdManager *manager, DdNode *node);
hisqueue *InitHistory(int varcnt); hisqueue *InitHistory(int varcnt);
void ReInitHistory(hisqueue *HisQueue, int varcnt); void ReInitHistory(hisqueue *HisQueue, int varcnt);
void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue); void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue,
int ivalue, void *dynvalue);
hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node); hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node);
int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node); int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node);
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd); void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue,
DdNode *bdd);
/* Save-load */ /* Save-load */
@ -346,14 +355,19 @@ bddfileheader ReadFileHeader(char *filename);
int CheckFileVersion(const char *version); int CheckFileVersion(const char *version);
DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile);
DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current); DdNode *LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes,
DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum); FILE *inputfile, nodeline current);
DdNode *GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes,
char *varname, int nodenum);
int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd,
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile); char *filename);
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes,
DdNode *Current, FILE *outputfile);
void ExpandNodes(hisqueue *Nodes, int index, int nodenum); void ExpandNodes(hisqueue *Nodes, int index, int nodenum);
/* Export */ /* Export */
int simpleBDDtoDot(DdManager *manager, DdNode *bdd, const char *filename); int simpleBDDtoDot(DdManager *manager, DdNode *bdd, const char *filename);
int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, const char *filename); int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd,
const char *filename);

2
packages/cplint/approx/simplecuddLPADs/simplecudd.h
View File

@ -190,7 +190,7 @@ form
variable=value variable=value
*/ */
#include "config.h" #include "YapInterface.h"
#include "cudd_config.h" #include "cudd_config.h"
#include <math.h> #include <math.h>
#include <stdio.h> #include <stdio.h>

5
packages/cplint/cplint.h
View File

@ -7,7 +7,6 @@ This package uses the library cudd, see http://vlsi.colorado.edu/~fabio/CUDD/
for the relative license. for the relative license.
*/ */
#include "config.h"
#include "cudd_config.h" #include "cudd_config.h"
#include <stdio.h> #include <stdio.h>
#if HAVE_CUDDINT_H #if HAVE_CUDDINT_H
@ -18,7 +17,9 @@ for the relative license.
#include "YapInterface.h" #include "YapInterface.h"
typedef struct { int var, value; } factor; typedef struct {
int var, value;
} factor;
typedef struct { typedef struct {
int nFact; int nFact;

1
packages/cplint/slipcase/bddem.c
View File

@ -9,7 +9,6 @@ for the relative license.
*/ */
#include "config.h"
#include "cudd_config.h" #include "cudd_config.h"
#include <math.h> #include <math.h>
#include <stdio.h> #include <stdio.h>

8
packages/myddas/myddas.h
View File

@ -1,21 +1,20 @@
#ifndef __MYDDAS_H__ #ifndef __MYDDAS_H__
#define __MYDDAS_H__ #define __MYDDAS_H__
#include "config.h" #include "YapConfig.h"
#include <stdio.h> #include <stdio.h>
#include "myddas_types.h" #include "myddas_types.h"
/* Passar para o myddas_statictics.h ???????? */ /* Passar para o myddas_statictics.h ???????? */
#ifdef MYDDAS_STATS #ifdef MYDDAS_STATS
#include <time.h>
#include <sys/time.h> #include <sys/time.h>
#include <time.h>
#endif #endif
typedef struct myddas_global *MYDDAS_GLOBAL; typedef struct myddas_global *MYDDAS_GLOBAL;
#include "myddas_util.h" #include "myddas_util.h"
// extern void Yap_InitMYDDAS_SQLITE3Preds(void); // extern void Yap_InitMYDDAS_SQLITE3Preds(void);
// extern void Yap_InitBackMYDDAS_SQLITE3Preds(void); // extern void Yap_InitBackMYDDAS_SQLITE3Preds(void);
@ -38,8 +37,7 @@ typedef void *MYDDAS_STATS_TIME;
NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->memory_freed; NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->memory_freed;
#endif #endif
#include "myddas_structs.h"
#include "MyddasProto.h" #include "MyddasProto.h"
#include "myddas_structs.h"
#endif /*__MYDDAS_H__*/ #endif /*__MYDDAS_H__*/

342
packages/yap-lbfgs/liblbfgs-1.10/lib/lbfgs.c vendored
View File

@ -61,14 +61,12 @@ distributing the effieicnt and explanatory implementation in an open source
licence. licence.
*/ */
#ifdef HAVE_CONFIG_H #include "YapConfig.h"
#include <config.h>
#endif/*HAVE_CONFIG_H*/
#include <math.h>
#include <stdint.h> #include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <math.h>
#include <lbfgs.h> #include <lbfgs.h>
@ -111,112 +109,63 @@ struct tag_iteration_data {
typedef struct tag_iteration_data iteration_data_t; typedef struct tag_iteration_data iteration_data_t;
static const lbfgs_parameter_t _defparam = { static const lbfgs_parameter_t _defparam = {
6, 1e-5, 0, 1e-5, 6, 1e-5, 0, 1e-5, 0, LBFGS_LINESEARCH_DEFAULT,
0, LBFGS_LINESEARCH_DEFAULT, 40, 40, 1e-20, 1e20, 1e-4, 0.9, 0.9,
1e-20, 1e20, 1e-4, 0.9, 0.9, 1.0e-16, 1.0e-16, 0.0, 0, -1,
0.0, 0, -1,
}; };
/* Forward function declarations. */ /* Forward function declarations. */
typedef int (*line_search_proc)( typedef int (*line_search_proc)(int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f,
int n, lbfgsfloatval_t *g, lbfgsfloatval_t *s,
lbfgsfloatval_t *x, lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp,
lbfgsfloatval_t *f, const lbfgsfloatval_t *gp, lbfgsfloatval_t *wa,
lbfgsfloatval_t *g,
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t* xp,
const lbfgsfloatval_t* gp,
lbfgsfloatval_t *wa,
callback_data_t *cd, callback_data_t *cd,
const lbfgs_parameter_t *param const lbfgs_parameter_t *param);
);
static int line_search_backtracking( static int line_search_backtracking(int n, lbfgsfloatval_t *x,
int n, lbfgsfloatval_t *f, lbfgsfloatval_t *g,
lbfgsfloatval_t *x, lbfgsfloatval_t *s, lbfgsfloatval_t *stp,
lbfgsfloatval_t *f,
lbfgsfloatval_t *g,
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t *xp, const lbfgsfloatval_t *xp,
const lbfgsfloatval_t *gp, const lbfgsfloatval_t *gp,
lbfgsfloatval_t *wa, lbfgsfloatval_t *wa, callback_data_t *cd,
callback_data_t *cd, const lbfgs_parameter_t *param);
const lbfgs_parameter_t *param
);
static int line_search_backtracking_owlqn( static int line_search_backtracking_owlqn(
int n, int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g,
lbfgsfloatval_t *x, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp,
lbfgsfloatval_t *f, const lbfgsfloatval_t *gp, lbfgsfloatval_t *wp, callback_data_t *cd,
lbfgsfloatval_t *g, const lbfgs_parameter_t *param);
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp, static int line_search_morethuente(int n, lbfgsfloatval_t *x,
lbfgsfloatval_t *f, lbfgsfloatval_t *g,
lbfgsfloatval_t *s, lbfgsfloatval_t *stp,
const lbfgsfloatval_t *xp, const lbfgsfloatval_t *xp,
const lbfgsfloatval_t *gp, const lbfgsfloatval_t *gp,
lbfgsfloatval_t *wp, lbfgsfloatval_t *wa, callback_data_t *cd,
callback_data_t *cd, const lbfgs_parameter_t *param);
const lbfgs_parameter_t *param
);
static int line_search_morethuente( static int update_trial_interval(lbfgsfloatval_t *x, lbfgsfloatval_t *fx,
int n, lbfgsfloatval_t *dx, lbfgsfloatval_t *y,
lbfgsfloatval_t *x, lbfgsfloatval_t *fy, lbfgsfloatval_t *dy,
lbfgsfloatval_t *f, lbfgsfloatval_t *t, lbfgsfloatval_t *ft,
lbfgsfloatval_t *g,
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t* xp,
const lbfgsfloatval_t* gp,
lbfgsfloatval_t *wa,
callback_data_t *cd,
const lbfgs_parameter_t *param
);
static int update_trial_interval(
lbfgsfloatval_t *x,
lbfgsfloatval_t *fx,
lbfgsfloatval_t *dx,
lbfgsfloatval_t *y,
lbfgsfloatval_t *fy,
lbfgsfloatval_t *dy,
lbfgsfloatval_t *t,
lbfgsfloatval_t *ft,
lbfgsfloatval_t *dt, lbfgsfloatval_t *dt,
const lbfgsfloatval_t tmin, const lbfgsfloatval_t tmin,
const lbfgsfloatval_t tmax, const lbfgsfloatval_t tmax, int *brackt);
int *brackt
);
static lbfgsfloatval_t owlqn_x1norm( static lbfgsfloatval_t owlqn_x1norm(const lbfgsfloatval_t *x, const int start,
const lbfgsfloatval_t* x, const int n);
const int start,
const int n
);
static void owlqn_pseudo_gradient( static void owlqn_pseudo_gradient(lbfgsfloatval_t *pg, const lbfgsfloatval_t *x,
lbfgsfloatval_t* pg, const lbfgsfloatval_t *g, const int n,
const lbfgsfloatval_t* x, const lbfgsfloatval_t c, const int start,
const lbfgsfloatval_t* g, const int end);
const int n,
const lbfgsfloatval_t c,
const int start,
const int end
);
static void owlqn_project(
lbfgsfloatval_t* d,
const lbfgsfloatval_t* sign,
const int start,
const int end
);
static void owlqn_project(lbfgsfloatval_t *d, const lbfgsfloatval_t *sign,
const int start, const int end);
#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__))
static int round_out_variables(int n) static int round_out_variables(int n) {
{
n += 7; n += 7;
n /= 8; n /= 8;
n *= 8; n *= 8;
@ -224,34 +173,22 @@ static int round_out_variables(int n)
} }
#endif /*defined(USE_SSE)*/ #endif /*defined(USE_SSE)*/
lbfgsfloatval_t* lbfgs_malloc(int n) lbfgsfloatval_t *lbfgs_malloc(int n) {
{
#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) #if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__))
n = round_out_variables(n); n = round_out_variables(n);
#endif /*defined(USE_SSE)*/ #endif /*defined(USE_SSE)*/
return (lbfgsfloatval_t *)vecalloc(sizeof(lbfgsfloatval_t) * n); return (lbfgsfloatval_t *)vecalloc(sizeof(lbfgsfloatval_t) * n);
} }
void lbfgs_free(lbfgsfloatval_t *x) void lbfgs_free(lbfgsfloatval_t *x) { vecfree(x); }
{
vecfree(x);
}
void lbfgs_parameter_init(lbfgs_parameter_t *param) void lbfgs_parameter_init(lbfgs_parameter_t *param) {
{
memmove(param, &_defparam, sizeof(*param)); memmove(param, &_defparam, sizeof(*param));
} }
int lbfgs( int lbfgs(int n, lbfgsfloatval_t *x, lbfgsfloatval_t *ptr_fx,
int n, lbfgs_evaluate_t proc_evaluate, lbfgs_progress_t proc_progress,
lbfgsfloatval_t *x, void *instance, lbfgs_parameter_t *_param) {
lbfgsfloatval_t *ptr_fx,
lbfgs_evaluate_t proc_evaluate,
lbfgs_progress_t proc_progress,
void *instance,
lbfgs_parameter_t *_param
)
{
int ret; int ret;
int i, j, k, ls, end, bound; int i, j, k, ls, end, bound;
lbfgsfloatval_t step; lbfgsfloatval_t step;
@ -414,10 +351,8 @@ int lbfgs(
/* Compute the L1 norm of the variable and add it to the object value. */ /* Compute the L1 norm of the variable and add it to the object value. */
xnorm = owlqn_x1norm(x, param.orthantwise_start, param.orthantwise_end); xnorm = owlqn_x1norm(x, param.orthantwise_start, param.orthantwise_end);
fx += xnorm * param.orthantwise_c; fx += xnorm * param.orthantwise_c;
owlqn_pseudo_gradient( owlqn_pseudo_gradient(pg, x, g, n, param.orthantwise_c,
pg, x, g, n, param.orthantwise_start, param.orthantwise_end);
param.orthantwise_c, param.orthantwise_start, param.orthantwise_end
);
} }
/* Store the initial value of the objective function. */ /* Store the initial value of the objective function. */
@ -444,7 +379,8 @@ int lbfgs(
} else { } else {
vec2norm(&gnorm, pg, n); vec2norm(&gnorm, pg, n);
} }
if (xnorm < 1.0) xnorm = 1.0; if (xnorm < 1.0)
xnorm = 1.0;
if (gnorm / xnorm <= param.epsilon) { if (gnorm / xnorm <= param.epsilon) {
ret = LBFGS_ALREADY_MINIMIZED; ret = LBFGS_ALREADY_MINIMIZED;
goto lbfgs_exit; goto lbfgs_exit;
@ -467,10 +403,8 @@ int lbfgs(
ls = linesearch(n, x, &fx, g, d, &step, xp, gp, w, &cd, &param); ls = linesearch(n, x, &fx, g, d, &step, xp, gp, w, &cd, &param);
} else { } else {
ls = linesearch(n, x, &fx, g, d, &step, xp, pg, w, &cd, &param); ls = linesearch(n, x, &fx, g, d, &step, xp, pg, w, &cd, &param);
owlqn_pseudo_gradient( owlqn_pseudo_gradient(pg, x, g, n, param.orthantwise_c,
pg, x, g, n, param.orthantwise_start, param.orthantwise_end);
param.orthantwise_c, param.orthantwise_start, param.orthantwise_end
);
} }
if (ls < 0) { if (ls < 0) {
/* Revert to the previous point. */ /* Revert to the previous point. */
@ -490,7 +424,8 @@ int lbfgs(
/* Report the progress. */ /* Report the progress. */
if (cd.proc_progress) { if (cd.proc_progress) {
if ((ret = cd.proc_progress(cd.instance, x, g, fx, xnorm, gnorm, step, cd.n, k, ls))) { if ((ret = cd.proc_progress(cd.instance, x, g, fx, xnorm, gnorm, step,
cd.n, k, ls))) {
goto lbfgs_exit; goto lbfgs_exit;
} }
} }
@ -500,7 +435,8 @@ int lbfgs(
The criterion is given by the following formula: The criterion is given by the following formula:
|g(x)| / \max(1, |x|) < \epsilon |g(x)| / \max(1, |x|) < \epsilon
*/ */
if (xnorm < 1.0) xnorm = 1.0; if (xnorm < 1.0)
xnorm = 1.0;
if (gnorm / xnorm <= param.epsilon) { if (gnorm / xnorm <= param.epsilon) {
/* Convergence. */ /* Convergence. */
ret = LBFGS_SUCCESS; ret = LBFGS_SUCCESS;
@ -548,7 +484,8 @@ int lbfgs(
Compute scalars ys and yy: Compute scalars ys and yy:
ys = y^t \cdot s = 1 / \rho. ys = y^t \cdot s = 1 / \rho.
yy = y^t \cdot y. yy = y^t \cdot y.
Notice that yy is used for scaling the hessian matrix H_0 (Cholesky factor). Notice that yy is used for scaling the hessian matrix H_0 (Cholesky
factor).
*/ */
vecdot(&ys, it->y, it->s, n); vecdot(&ys, it->y, it->s, n);
vecdot(&yy, it->y, it->y, n); vecdot(&yy, it->y, it->y, n);
@ -640,22 +577,13 @@ lbfgs_exit:
return ret; return ret;
} }
static int line_search_backtracking(int n, lbfgsfloatval_t *x,
lbfgsfloatval_t *f, lbfgsfloatval_t *g,
static int line_search_backtracking( lbfgsfloatval_t *s, lbfgsfloatval_t *stp,
int n,
lbfgsfloatval_t *x,
lbfgsfloatval_t *f,
lbfgsfloatval_t *g,
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t *xp, const lbfgsfloatval_t *xp,
const lbfgsfloatval_t *gp, const lbfgsfloatval_t *gp,
lbfgsfloatval_t *wp, lbfgsfloatval_t *wp, callback_data_t *cd,
callback_data_t *cd, const lbfgs_parameter_t *param) {
const lbfgs_parameter_t *param
)
{
int count = 0; int count = 0;
lbfgsfloatval_t width, dg; lbfgsfloatval_t width, dg;
lbfgsfloatval_t finit, dginit = 0., dgtest; lbfgsfloatval_t finit, dginit = 0., dgtest;
@ -733,22 +661,11 @@ static int line_search_backtracking(
} }
} }
static int line_search_backtracking_owlqn( static int line_search_backtracking_owlqn(
int n, int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g,
lbfgsfloatval_t *x, lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp,
lbfgsfloatval_t *f, const lbfgsfloatval_t *gp, lbfgsfloatval_t *wp, callback_data_t *cd,
lbfgsfloatval_t *g, const lbfgs_parameter_t *param) {
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t* xp,
const lbfgsfloatval_t* gp,
lbfgsfloatval_t *wp,
callback_data_t *cd,
const lbfgs_parameter_t *param
)
{
int i, count = 0; int i, count = 0;
lbfgsfloatval_t width = 0.5, norm = 0.; lbfgsfloatval_t width = 0.5, norm = 0.;
lbfgsfloatval_t finit = *f, dgtest; lbfgsfloatval_t finit = *f, dgtest;
@ -807,22 +724,13 @@ static int line_search_backtracking_owlqn(
} }
} }
static int line_search_morethuente(int n, lbfgsfloatval_t *x,
lbfgsfloatval_t *f, lbfgsfloatval_t *g,
static int line_search_morethuente( lbfgsfloatval_t *s, lbfgsfloatval_t *stp,
int n,
lbfgsfloatval_t *x,
lbfgsfloatval_t *f,
lbfgsfloatval_t *g,
lbfgsfloatval_t *s,
lbfgsfloatval_t *stp,
const lbfgsfloatval_t *xp, const lbfgsfloatval_t *xp,
const lbfgsfloatval_t *gp, const lbfgsfloatval_t *gp,
lbfgsfloatval_t *wa, lbfgsfloatval_t *wa, callback_data_t *cd,
callback_data_t *cd, const lbfgs_parameter_t *param) {
const lbfgs_parameter_t *param
)
{
int count = 0; int count = 0;
int brackt, stage1, uinfo = 0; int brackt, stage1, uinfo = 0;
lbfgsfloatval_t dg; lbfgsfloatval_t dg;
@ -881,14 +789,18 @@ static int line_search_morethuente(
} }
/* Clip the step in the range of [stpmin, stpmax]. */ /* Clip the step in the range of [stpmin, stpmax]. */
if (*stp < param->min_step) *stp = param->min_step; if (*stp < param->min_step)
if (param->max_step < *stp) *stp = param->max_step; *stp = param->min_step;
if (param->max_step < *stp)
*stp = param->max_step;
/* /*
If an unusual termination is to occur then let If an unusual termination is to occur then let
stp be the lowest point obtained so far. stp be the lowest point obtained so far.
*/ */
if ((brackt && ((*stp <= stmin || stmax <= *stp) || param->max_linesearch <= count + 1 || uinfo != 0)) || (brackt && (stmax - stmin <= param->xtol * stmax))) { if ((brackt && ((*stp <= stmin || stmax <= *stp) ||
param->max_linesearch <= count + 1 || uinfo != 0)) ||
(brackt && (stmax - stmin <= param->xtol * stmax))) {
*stp = stx; *stp = stx;
} }
@ -928,7 +840,8 @@ static int line_search_morethuente(
return LBFGSERR_MAXIMUMLINESEARCH; return LBFGSERR_MAXIMUMLINESEARCH;
} }
if (*f <= ftest1 && fabs(dg) <= param->gtol * (-dginit)) { if (*f <= ftest1 && fabs(dg) <= param->gtol * (-dginit)) {
/* The sufficient decrease condition and the directional derivative condition hold. */ /* The sufficient decrease condition and the directional derivative
* condition hold. */
return count; return count;
} }
@ -936,7 +849,8 @@ static int line_search_morethuente(
In the first stage we seek a step for which the modified In the first stage we seek a step for which the modified
function has a nonpositive value and nonnegative derivative. function has a nonpositive value and nonnegative derivative.
*/ */
if (stage1 && *f <= ftest1 && min2(param->ftol, param->gtol) * dginit <= dg) { if (stage1 && *f <= ftest1 &&
min2(param->ftol, param->gtol) * dginit <= dg) {
stage1 = 0; stage1 = 0;
} }
@ -960,12 +874,8 @@ static int line_search_morethuente(
Call update_trial_interval() to update the interval of Call update_trial_interval() to update the interval of
uncertainty and to compute the new step. uncertainty and to compute the new step.
*/ */
uinfo = update_trial_interval( uinfo = update_trial_interval(&stx, &fxm, &dgxm, &sty, &fym, &dgym, stp,
&stx, &fxm, &dgxm, &fm, &dgm, stmin, stmax, &brackt);
&sty, &fym, &dgym,
stp, &fm, &dgm,
stmin, stmax, &brackt
);
/* Reset the function and gradient values for f. */ /* Reset the function and gradient values for f. */
fx = fxm + stx * dgtest; fx = fxm + stx * dgtest;
@ -977,12 +887,8 @@ static int line_search_morethuente(
Call update_trial_interval() to update the interval of Call update_trial_interval() to update the interval of
uncertainty and to compute the new step. uncertainty and to compute the new step.
*/ */
uinfo = update_trial_interval( uinfo = update_trial_interval(&stx, &fx, &dgx, &sty, &fy, &dgy, stp, f,
&stx, &fx, &dgx, &dg, stmin, stmax, &brackt);
&sty, &fy, &dgy,
stp, f, &dg,
stmin, stmax, &brackt
);
} }
/* /*
@ -1000,13 +906,10 @@ static int line_search_morethuente(
return LBFGSERR_LOGICERROR; return LBFGSERR_LOGICERROR;
} }
/** /**
* Define the local variables for computing minimizers. * Define the local variables for computing minimizers.
*/ */
#define USES_MINIMIZER \ #define USES_MINIMIZER lbfgsfloatval_t a, d, gamma, theta, p, q, r, s;
lbfgsfloatval_t a, d, gamma, theta, p, q, r, s;
/** /**
* Find a minimizer of an interpolated cubic function. * Find a minimizer of an interpolated cubic function.
@ -1028,7 +931,8 @@ static int line_search_morethuente(
/* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \
a = theta / s; \ a = theta / s; \
gamma = s * sqrt(a * a - ((du) / s) * ((dv) / s)); \ gamma = s * sqrt(a * a - ((du) / s) * ((dv) / s)); \
if ((v) < (u)) gamma = -gamma; \ if ((v) < (u)) \
gamma = -gamma; \
p = gamma - (du) + theta; \ p = gamma - (du) + theta; \
q = gamma - (du) + gamma + (dv); \ q = gamma - (du) + gamma + (dv); \
r = p / q; \ r = p / q; \
@ -1056,7 +960,8 @@ static int line_search_morethuente(
/* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \
a = theta / s; \ a = theta / s; \
gamma = s * sqrt(max2(0, a * a - ((du) / s) * ((dv) / s))); \ gamma = s * sqrt(max2(0, a * a - ((du) / s) * ((dv) / s))); \
if ((u) < (v)) gamma = -gamma; \ if ((u) < (v)) \
gamma = -gamma; \
p = gamma - (dv) + theta; \ p = gamma - (dv) + theta; \
q = gamma - (dv) + gamma + (du); \ q = gamma - (dv) + gamma + (du); \
r = p / q; \ r = p / q; \
@ -1122,21 +1027,13 @@ static int line_search_morethuente(
* guaranteed sufficient decrease. ACM Transactions on Mathematical * guaranteed sufficient decrease. ACM Transactions on Mathematical
* Software (TOMS), Vol 20, No 3, pp. 286-307, 1994. * Software (TOMS), Vol 20, No 3, pp. 286-307, 1994.
*/ */
static int update_trial_interval( static int update_trial_interval(lbfgsfloatval_t *x, lbfgsfloatval_t *fx,
lbfgsfloatval_t *x, lbfgsfloatval_t *dx, lbfgsfloatval_t *y,
lbfgsfloatval_t *fx, lbfgsfloatval_t *fy, lbfgsfloatval_t *dy,
lbfgsfloatval_t *dx, lbfgsfloatval_t *t, lbfgsfloatval_t *ft,
lbfgsfloatval_t *y,
lbfgsfloatval_t *fy,
lbfgsfloatval_t *dy,
lbfgsfloatval_t *t,
lbfgsfloatval_t *ft,
lbfgsfloatval_t *dt, lbfgsfloatval_t *dt,
const lbfgsfloatval_t tmin, const lbfgsfloatval_t tmin,
const lbfgsfloatval_t tmax, const lbfgsfloatval_t tmax, int *brackt) {
int *brackt
)
{
int bound; int bound;
int dsign = fsigndiff(dt, dx); int dsign = fsigndiff(dt, dx);
lbfgsfloatval_t mc; /* minimizer of an interpolated cubic. */ lbfgsfloatval_t mc; /* minimizer of an interpolated cubic. */
@ -1270,8 +1167,10 @@ static int update_trial_interval(
} }
/* Clip the new trial value in [tmin, tmax]. */ /* Clip the new trial value in [tmin, tmax]. */
if (tmax < newt) newt = tmax; if (tmax < newt)
if (newt < tmin) newt = tmin; newt = tmax;
if (newt < tmin)
newt = tmin;
/* /*
Redefine the new trial value if it is close to the upper bound Redefine the new trial value if it is close to the upper bound
@ -1280,9 +1179,11 @@ static int update_trial_interval(
if (*brackt && bound) { if (*brackt && bound) {
mq = *x + 0.66 * (*y - *x); mq = *x + 0.66 * (*y - *x);
if (*x < *y) { if (*x < *y) {
if (mq < newt) newt = mq; if (mq < newt)
newt = mq;
} else { } else {
if (newt < mq) newt = mq; if (newt < mq)
newt = mq;
} }
} }
@ -1291,16 +1192,8 @@ static int update_trial_interval(
return 0; return 0;
} }
static lbfgsfloatval_t owlqn_x1norm(const lbfgsfloatval_t *x, const int start,
const int n) {
static lbfgsfloatval_t owlqn_x1norm(
const lbfgsfloatval_t* x,
const int start,
const int n
)
{
int i; int i;
lbfgsfloatval_t norm = 0.; lbfgsfloatval_t norm = 0.;
@ -1311,16 +1204,10 @@ static lbfgsfloatval_t owlqn_x1norm(
return norm; return norm;
} }
static void owlqn_pseudo_gradient( static void owlqn_pseudo_gradient(lbfgsfloatval_t *pg, const lbfgsfloatval_t *x,
lbfgsfloatval_t* pg, const lbfgsfloatval_t *g, const int n,
const lbfgsfloatval_t* x, const lbfgsfloatval_t c, const int start,
const lbfgsfloatval_t* g, const int end) {
const int n,
const lbfgsfloatval_t c,
const int start,
const int end
)
{
int i; int i;
/* Compute the negative of gradients. */ /* Compute the negative of gradients. */
@ -1354,13 +1241,8 @@ static void owlqn_pseudo_gradient(
} }
} }
static void owlqn_project( static void owlqn_project(lbfgsfloatval_t *d, const lbfgsfloatval_t *sign,
lbfgsfloatval_t* d, const int start, const int end) {
const lbfgsfloatval_t* sign,
const int start,
const int end
)
{
int i; int i;
for (i = start; i < end; ++i) { for (i = start; i < end; ++i) {

1
packages/yap-lbfgs/yap_lbfgs.c
View File

@ -516,7 +516,6 @@ static YAP_Bool lbfgs_set_parameter(void) {
return TRUE; return TRUE;
} }
/** @pred lbfgs_get_parameter(+Name,-Value)</h3> /** @pred lbfgs_get_parameter(+Name,-Value)</h3>
Get the current Value for Name Get the current Value for Name
*/ */

5
pl/listing.yap
View File

@ -144,7 +144,7 @@ listing(Stream, [MV|MVs]) :- !,
'$listing'(_,_,_,_). '$listing'(_,_,_,_).
'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name). '$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
'$funcspec'(Name,Name,_) :- atom(Name), !. '$funcspec'(Name,Name,0) :- atom(Name), !.
'$funcspec'(Name,_,_) :- '$funcspec'(Name,_,_) :-
'$do_error'(domain_error(predicate_spec,Name),listing(Name)). '$do_error'(domain_error(predicate_spec,Name),listing(Name)).
@ -216,7 +216,7 @@ listing(Stream, [MV|MVs]) :- !,
'$clause'(Pred, M, Body, _), '$clause'(Pred, M, Body, _),
'$current_module'(Mod), '$current_module'(Mod),
( M \= Mod -> H = M:Pred ; H = Pred ), ( M \= Mod -> H = M:Pred ; H = Pred ),
'$portray_clause'(Stream,(H:-Body)), portray_clause(Stream,(H:-Body)),
fail. fail.
/** @pred portray_clause(+ _S_,+ _C_) /** @pred portray_clause(+ _S_,+ _C_)
@ -318,6 +318,7 @@ portray_clause(Clause) :-
'$beautify_vs'(T) :- '$beautify_vs'(T) :-
'$non_singletons_in_term'(T,[],Fs), '$non_singletons_in_term'(T,[],Fs),
writeln(Fs),
'$vv_transform'(Fs,1), '$vv_transform'(Fs,1),
term_variables(T, NFs), term_variables(T, NFs),
'$v_transform'(NFs). '$v_transform'(NFs).

2
pl/yio.yap
View File

@ -181,7 +181,7 @@ display(Stream, T) :-
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),
catch(user:portray(T),user,Error,user:'$Error'(Error)), !, catch(user:portray(T),Error,user:'$Error'(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.