diff --git a/C/c_interface.c b/C/c_interface.c index 5fefae752..a8dc3e278 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2427,12 +2427,14 @@ YAP_RunGoal(Term t) ENV = (CELL *)ENV[E_E]; CP = old_CP; LOCAL_AllowRestart = TRUE; + Yap_StartSlots( PASS_REGS1 ); } else { ENV = B->cp_env; B = B->cp_b; LOCAL_AllowRestart = FALSE; } + RECOVER_MACHINE_REGS(); return out; } @@ -2647,6 +2649,8 @@ YAP_PruneGoal(void) { POP_EXECUTE(); } + if (!B->cp_b) + break; B = B->cp_b; } Yap_TrimTrail(); @@ -2820,7 +2824,6 @@ YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) X_API char * YAP_WriteDynamicBuffer(Term t, char *buf, size_t sze, size_t *lengthp, int *encp, int flags) { - int enc; char *b; BACKUP_MACHINE_REGS(); diff --git a/C/iopreds.c b/C/iopreds.c index c7791ff02..bbce87620 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -1090,7 +1090,7 @@ Yap_InitBackIO (void) { } -/* used to test writebuffer +#if DEBUG static Int p_write_string( USES_REGS1 ) { @@ -1106,8 +1106,7 @@ p_write_string( USES_REGS1 ) fprintf(stderr,"%ld %s\n",length, s); return TRUE; } -*/ - +#endif void Yap_InitIOPreds(void) @@ -1119,7 +1118,9 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag); Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag); - /* test predicate Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag); */ +#if DEBUG + Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag); +#endif Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); diff --git a/C/yap-args.c b/C/yap-args.c index 2ea6caea9..f6187ffb1 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -72,6 +72,7 @@ print_usage(void) fprintf(stderr," -GSize Max Area for Global Stack\n"); fprintf(stderr," -LSize Max Area for Local Stack (number must follow L)\n"); fprintf(stderr," -TSize Max Area for Trail (number must follow L)\n"); + fprintf(stderr," -nosignals disable signal handling from Prolog\n"); fprintf(stderr,"\n[Execution Modes]\n"); fprintf(stderr," -J0 Interpreted mode (default)\n"); fprintf(stderr," -J1 Mixed mode only for user predicates\n"); @@ -483,6 +484,12 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) iap->YapPrologTopLevelGoal = add_end_dot(*argv); } break; + case 'n': + if (!strcmp("nosignals", p)) { + iap->PrologShouldHandleInterrupts = FALSE; + break; + } + goto myddas_error_print; case 'p': if ((*argv)[0] == '\0') iap->YapPrologAddPath = *argv; @@ -524,9 +531,7 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) break; default: { -#ifdef MYDDAS_MYSQL myddas_error_print : -#endif fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p); #ifdef MYDDAS_MYSQL myddas_error : diff --git a/configure b/configure index 2aae855ea..3ad9221a9 100755 --- a/configure +++ b/configure @@ -1,9 +1,11 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69. +# Generated by GNU Autoconf 2.68. # # -# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software +# Foundation, Inc. # # # This configure script is free software; the Free Software Foundation @@ -132,31 +134,6 @@ export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -as_fn_exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh @@ -190,8 +167,7 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : else exitcode=1; echo positional parameters were not saved. fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" +test x\$exitcode = x0 || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && @@ -236,25 +212,21 @@ IFS=$as_save_IFS if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 + # We cannot yet assume a decent shell, so we have to provide a + # neutralization value for shells without unset; and this also + # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. + BASH_ENV=/dev/null + ENV=/dev/null + (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV + export CONFIG_SHELL + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : @@ -356,14 +328,6 @@ $as_echo X"$as_dir" | } # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take @@ -485,10 +449,6 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). @@ -523,16 +483,16 @@ if (echo >conf$$.file) 2>/dev/null; then # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' + as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -544,8 +504,28 @@ else as_mkdir_p=false fi -as_test_x='test -x' -as_executable_p=as_fn_executable_p +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -1323,6 +1303,8 @@ target=$target_alias if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe + $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host. + If a cross compiler is detected then cross compile mode will be used" >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi @@ -1612,9 +1594,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF configure -generated by GNU Autoconf 2.69 +generated by GNU Autoconf 2.68 -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1925,7 +1907,7 @@ $as_echo "$ac_try_echo"; } >&5 test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || - test -x conftest$ac_exeext + $as_test_x conftest$ac_exeext }; then : ac_retval=0 else @@ -2028,8 +2010,7 @@ int main () { static int test_array [1 - 2 * !(($2) >= 0)]; -test_array [0] = 0; -return test_array [0]; +test_array [0] = 0 ; return 0; @@ -2045,8 +2026,7 @@ int main () { static int test_array [1 - 2 * !(($2) <= $ac_mid)]; -test_array [0] = 0; -return test_array [0]; +test_array [0] = 0 ; return 0; @@ -2072,8 +2052,7 @@ int main () { static int test_array [1 - 2 * !(($2) < 0)]; -test_array [0] = 0; -return test_array [0]; +test_array [0] = 0 ; return 0; @@ -2089,8 +2068,7 @@ int main () { static int test_array [1 - 2 * !(($2) >= $ac_mid)]; -test_array [0] = 0; -return test_array [0]; +test_array [0] = 0 ; return 0; @@ -2124,8 +2102,7 @@ int main () { static int test_array [1 - 2 * !(($2) <= $ac_mid)]; -test_array [0] = 0; -return test_array [0]; +test_array [0] = 0 ; return 0; @@ -2309,7 +2286,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was -generated by GNU Autoconf 2.69. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2685,7 +2662,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2725,7 +2702,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2778,7 +2755,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2819,7 +2796,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue @@ -2877,7 +2854,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -2921,7 +2898,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -3367,7 +3344,8 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include -struct stat; +#include +#include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); @@ -3480,7 +3458,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -3524,7 +3502,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_CXX="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -3727,7 +3705,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_AWK="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -4077,7 +4055,7 @@ do for ac_prog in grep ggrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue # Check for GNU ac_path_GREP and select it if it is found. # Check for GNU $ac_path_GREP case `"$ac_path_GREP" --version 2>&1` in @@ -4143,7 +4121,7 @@ do for ac_prog in egrep; do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue # Check for GNU ac_path_EGREP and select it if it is found. # Check for GNU $ac_path_EGREP case `"$ac_path_EGREP" --version 2>&1` in @@ -4781,7 +4759,11 @@ if test "${with_readline+set}" = set; then : yap_cv_readline=no else yap_cv_readline=$with_readline - LDFLAGS="$LDFLAGS -L${yap_cv_readline}/lib" + if test -d "${yap_cv_readline}/lib64" -a "$YAP_TARGET" = amd64; then + LDFLAGS="-L${yap_cv_readline}/lib64 -L${yap_cv_readline}/lib $LDFLAGS" + else + LDFLAGS="-L${yap_cv_readline}/lib $LDFLAGS" + fi CPPFLAGS="-I${yap_cv_readline}/include $CPPFLAGS" fi else @@ -5243,7 +5225,7 @@ case $as_dir/ in #(( # by default. for ac_prog in ginstall scoinst install; do for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then if test $ac_prog = install && grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then # AIX install. It has an incompatible calling convention. @@ -5316,7 +5298,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5356,7 +5338,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_RANLIB="ranlib" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5408,7 +5390,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_INDENT="${ac_tool_prefix}indent" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5448,7 +5430,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_INDENT="indent" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5500,7 +5482,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_AR="${ac_tool_prefix}ar" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5540,7 +5522,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_AR="ar" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5592,7 +5574,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_MPI_CC="${ac_tool_prefix}mpicc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5632,7 +5614,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_ac_ct_MPI_CC="mpicc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5686,7 +5668,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -5727,7 +5709,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_path_SHELL="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -6597,7 +6579,7 @@ fi $as_echo "$ac_cv_lib_ncurses_main" >&6; } if test "x$ac_cv_lib_ncurses_main" = xyes; then : - LDFLAGS="$LDFLAGS -lncurses" + LIBS="-lncurses $LIBS" fi @@ -6636,7 +6618,7 @@ if test "x$ac_cv_lib_readline_main" = xyes; then : $as_echo "#define HAVE_LIBREADLINE 1" >>confdefs.h - LIBS="$LDFLAGS -lreadline" + LIBS="-lreadline $LIBS" else if test "x$with_readline" != xcheck; then @@ -6649,6 +6631,7 @@ See \`config.log' for more details" "$LINENO" 5; } fi fi + if test "$yap_cv_gmp" != "no" then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lgmp" >&5 @@ -6716,7 +6699,7 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then ac_cv_prog_REXE="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 @@ -11600,16 +11583,16 @@ if (echo >conf$$.file) 2>/dev/null; then # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # In both cases, we have to default to `cp -p'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' + as_ln_s='cp -p' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi else - as_ln_s='cp -pR' + as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null @@ -11669,16 +11652,28 @@ else as_mkdir_p=false fi - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in #( + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #(( + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" @@ -11700,7 +11695,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by $as_me, which was -generated by GNU Autoconf 2.69. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -11762,10 +11757,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ config.status -configured by $0, generated by GNU Autoconf 2.69, +configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2010 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -11855,7 +11850,7 @@ fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' diff --git a/configure.in b/configure.in index a0af682a7..302e0f5d5 100755 --- a/configure.in +++ b/configure.in @@ -316,7 +316,11 @@ AC_ARG_WITH(readline, yap_cv_readline=no else yap_cv_readline=$with_readline - LDFLAGS="$LDFLAGS -L${yap_cv_readline}/lib" + if test -d "${yap_cv_readline}/lib64" -a "$YAP_TARGET" = amd64; then + LDFLAGS="-L${yap_cv_readline}/lib64 -L${yap_cv_readline}/lib $LDFLAGS" + else + LDFLAGS="-L${yap_cv_readline}/lib $LDFLAGS" + fi CPPFLAGS="-I${yap_cv_readline}/include $CPPFLAGS" fi, [yap_cv_readline=yes]) @@ -744,11 +748,11 @@ fi if test "$yap_cv_readline" != "no" then AC_CHECK_LIB([ncurses], [main],[ - LDFLAGS="$LDFLAGS -lncurses" + LIBS="-lncurses $LIBS" ]) AC_CHECK_LIB([readline], [main],[ AC_DEFINE([HAVE_LIBREADLINE], [1],[Define if you have libreadline]) - LIBS="$LDFLAGS -lreadline" + LIBS="-lreadline $LIBS" ], [if test "x$with_readline" != xcheck; then AC_MSG_FAILURE( @@ -756,6 +760,7 @@ then fi ]) fi + if test "$yap_cv_gmp" != "no" then AC_CHECK_LIB(gmp,main) diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 5d4ff4a0d..1e8e26954 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2316,7 +2316,7 @@ X_API int PL_next_solution(qid_t qi) if (setjmp(LOCAL_execution->env)) return 0; if (qi->state == 0) { - result = YAP_RunGoal(qi->g); + result = YAP_RunGoal(qi->g); } else { LOCAL_AllowRestart = qi->open; result = YAP_RestartGoal(); @@ -2330,7 +2330,7 @@ X_API int PL_next_solution(qid_t qi) X_API void PL_cut_query(qid_t qi) { - if (qi->open != 1) return; + if (qi->open != 1 || qi->state == 0) return; YAP_PruneGoal(); YAP_cut_up(); qi->open = 0; @@ -2339,7 +2339,7 @@ X_API void PL_cut_query(qid_t qi) X_API void PL_close_query(qid_t qi) { /* need to implement backtracking here */ - if (qi->open != 1) + if (qi->open != 1 || qi->state == 0) return; YAP_PruneGoal(); YAP_RestartGoal(); diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 86dc40292..738141875 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -37,7 +37,8 @@ [ve/3, check_if_ve_done/1, init_ve_solver/4, - run_ve_solver/3 + run_ve_solver/3, + call_ve_ground_solver/6 ]). :- use_module('clpbn/horus_ground', @@ -321,6 +322,8 @@ call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !, call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). call_ground_solver(bdd, GVars, GoalKeys, Keys, Factors, Evidence) :- !, call_bdd_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). +call_ground_solver(ve, GVars, GoalKeys, Keys, Factors, Evidence) :- !, + call_ve_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :- % traditional solver b_hash_new(Hash0), diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap index b76db9a10..0eb56a938 100644 --- a/packages/CLPBN/clpbn/bdd.yap +++ b/packages/CLPBN/clpbn/bdd.yap @@ -185,17 +185,14 @@ get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) --> get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :- reorder_keys(Parents0, OrderVs, Parents, Map), check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1), -writeln(v), unbound_parms(Parms, ParmVars), F = f(_,[Size|_],_,_), check_key(V, Size, DIST, Vs, Vs1), DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms), % get a list of form [[P00,P01], [P10,P11], [P20,P21]] -writeln(ps:Parents), foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2), cross_product(Values, Ev, PVars, ParmVars, Formula0), % (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true), -writeln(ev:Evs), get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs). %, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true) @@ -588,10 +585,10 @@ to_disj2([V,V1|Vs], V0, Out) :- % check_key_p(DistId, _, Map, Parms, ParmVars, Ps, Ps) :- rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !. -check_key_p(DistId, f(_, Sizes, Parms0, _DistId), Map, Parms, ParmVars, Ps, PsF) :- +check_key_p(DistId, f(_, Sizes, Parms0, DistId), Map, Parms, ParmVars, Ps, PsF) :- swap_parms(Parms0, Sizes, [0|Map], Parms1), length(Parms1, L0), - get_dist_domain_size(DistId, Size), + Sizes = [Size|_], L1 is L0 div Size, L is L0-L1, initial_maxes(L1, Multipliers), @@ -798,7 +795,7 @@ skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :- skim_for_theta(More, Ps, Left, New ). get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :- - rb_lookup(Evs, V, Pos), !, + rb_lookup(V, Pos, Evs), !, zero_pos(0, Pos, Ev), insert_output(Leaves, V, Finals, Tree, Outs, SendOut), get_outs(F0, F, SendOut, Outs). @@ -871,13 +868,12 @@ run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :- findall(LPs, (member(Q, QIds), run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))), - LLPs), writeln(LLPs). + LLPs). run_bdd_solver([[V]], LPs, bdd(Term, _Leaves, Nodes)) :- build_out_node(Nodes, Node), findall(Prob, get_prob(Term, Node, V, Prob),TermProbs), sumlist(TermProbs, Sum), - writeln(LPs:TermProbs), normalise(TermProbs, Sum, LPs). build_out_node([_Top], []). diff --git a/packages/CLPBN/clpbn/connected.yap b/packages/CLPBN/clpbn/connected.yap index 967a4f5cc..5996d932a 100644 --- a/packages/CLPBN/clpbn/connected.yap +++ b/packages/CLPBN/clpbn/connected.yap @@ -1,8 +1,12 @@ :- module(clpbn_connected, [influences/3, - init_influences/3, - influences/4]). + factor_influences/4, + init_influences/3, + influences/4] + ). + +:- use_module(library(maplist)). :- use_module(library(dgraphs), [dgraph_new/1, @@ -18,15 +22,29 @@ rb_insert/4, rb_visit/2]). +factor_influences(Vs, QVars, Ev, LV) :- + init_factor_influences(Vs, G, RG), + influences(QVars, Ev, G, RG, LV). + +init_factor_influences(Vs, G, RG) :- + dgraph_new(G0), + foldl(factor_to_dgraph, Vs, G0, G), + dgraph_transpose(G, RG). + influences(Vs, QVars, LV) :- init_influences(Vs, G, RG), - influences(QVars, G, RG, LV). + influences(QVars, [], G, RG, LV). init_influences(Vs, G, RG) :- dgraph_new(G0), to_dgraph(Vs, G0, G), dgraph_transpose(G, RG). +factor_to_dgraph(f([V|Parents],_,_,_), G0, G) :- + dgraph_add_vertex(G0, V, G00), + build_edges(Parents, V, Edges), + dgraph_add_edges(G00, Edges, G). + to_dgraph([], G, G). to_dgraph([V|Vs], G0, G) :- clpbn:get_atts(V, [dist(_,Parents)]), !, @@ -41,103 +59,106 @@ build_edges([P|Parents], V, [P-V|Edges]) :- % search for the set of variables that influence V influences(Vs, G, RG, Vars) :- - rb_new(Visited0), - influences(Vs, G, RG, Visited0, Visited), - all_top(Visited, Vars). + influences(Vs, [], G, RG, Vars). -influences([], _, _, Visited, Visited). -influences([V|LV], G, RG, Vs, NVs) :- - rb_lookup(V, T.B, Vs), T == t, B == b, !, - influences(LV, G, RG, Vs, NVs). -influences([V|LV], G, RG, Vs0, Vs3) :- - rb_insert(Vs0, V, t.b, Vs1), - process_new_variable(V, G, RG, Vs1, Vs2), - influences(LV, G, RG, Vs2, Vs3). +% search for the set of variables that influence V +influences(Vs, Evs, G, RG, Vars) :- + rb_new(Visited0), + foldl(influence(Evs, G, RG), Vs, Visited0, Visited), + all_top(Visited, Evs, Vars). -process_new_variable(V, _G, _RG, _Vs0, _Vs1) :- +influence(_, _G, _RG, V, Vs, Vs) :- + rb_lookup(V, [T|B], Vs), T == t, B == b, !. +influence(Ev, G, RG, V, Vs0, Vs) :- + rb_insert(Vs0, V, [t|b], Vs1), + process_new_variable(V, Ev, G, RG, Vs1, Vs). + +process_new_variable(V, _Evs, _G, _RG, _Vs0, _Vs1) :- + var(V), clpbn:get_atts(V,[evidence(Ev)]), !, throw(error(bound_to_evidence(V/Ev))). -process_new_variable(V, G, RG, Vs0, Vs2) :- +process_new_variable(V, Evs, _G, _RG, _Vs0, _Vs1) :- + rb_lookup(V, Ev, Evs), !, + throw(error(bound_to_evidence(V/Ev))). +process_new_variable(V, Evs, G, RG, Vs0, Vs2) :- dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1), dgraph_neighbors(V, RG, Parents), - throw_all_above(Parents, G, RG, Vs1, Vs2). - -throw_all_below([], _, _, Vs, Vs). -throw_all_below(Child.Children, G, RG, Vs0, Vs2) :- -% clpbn:get_atts(Child,[key(K)]), rb_visit(Vs0, Pairs), writeln(down:Child:K:Pairs), - throw_below(Child, G, RG, Vs0, Vs1), - throw_all_below(Children, G, RG, Vs1, Vs2). + foldl(throw_above(Evs, G, RG), Parents, Vs1, Vs2). % visited -throw_below(Child, G, RG, Vs0, Vs1) :- - rb_lookup(Child, _.B, Vs0), !, +throw_below(Evs, G, RG, Child, Vs0, Vs1) :- + rb_lookup(Child, [_|B], Vs0), !, ( B == b -> Vs0 = Vs1 % been there before ; B = b, % mark it - handle_ball_from_above(Child, G, RG, Vs0, Vs1) + handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1) ). -throw_below(Child, G, RG, Vs0, Vs2) :- - rb_insert(Vs0, Child, _.b, Vs1), - handle_ball_from_above(Child, G, RG, Vs1, Vs2). +throw_below(Evs, G, RG, Child, Vs0, Vs2) :- + rb_insert(Vs0, Child, [_|b], Vs1), + handle_ball_from_above(Child, Evs, G, RG, Vs1, Vs2). % share this with parents, if we have evidence -handle_ball_from_above(V, G, RG, Vs0, Vs1) :- - clpbn:get_atts(V,[evidence(_)]), !, - dgraph_neighbors(V, RG, Parents), - throw_all_above(Parents, G, RG, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !, + dgraph_neighbors(V, RG, Parents), + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + nonvar(V), + rb_lookup(V,_,Evs), !, + dgraph_neighbors(V, RG, Parents), + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). % propagate to kids, if we do not -handle_ball_from_above(V, G, RG, Vs0, Vs1) :- - dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, G, Children), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). -throw_all_above([], _, _, Vs, Vs). -throw_all_above(Parent.Parentren, G, RG, Vs0, Vs2) :- -% clpbn:get_atts(Parent,[key(K)]), rb_visit(Vs0, Pairs), writeln(up:Parent:K:Pairs), - throw_above(Parent, G, RG, Vs0, Vs1), - throw_all_above(Parentren, G, RG, Vs1, Vs2). - % visited -throw_above(Parent, G, RG, Vs0, Vs1) :- - rb_lookup(Parent, T._, Vs0), !, +throw_above(Evs, G, RG, Parent, Vs0, Vs1) :- + rb_lookup(Parent, [T|_], Vs0), !, ( T == t -> Vs1 = Vs0 % been there before ; T = t, % mark it - handle_ball_from_below(Parent, G, RG, Vs0, Vs1) + handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1) ). -throw_above(Parent, G, RG, Vs0, Vs2) :- - rb_insert(Vs0, Parent, t._, Vs1), - handle_ball_from_below(Parent, G, RG, Vs1, Vs2). +throw_above(Evs, G, RG, Parent, Vs0, Vs2) :- + rb_insert(Vs0, Parent, [t|_], Vs1), + handle_ball_from_below(Parent, Evs, G, RG, Vs1, Vs2). % share this with parents, if we have evidence -handle_ball_from_below(V, _, _, Vs, Vs) :- - clpbn:get_atts(V,[evidence(_)]), !. +handle_ball_from_below(V, _Evs, _, _, Vs, Vs) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !. +handle_ball_from_below(V, Evs, _, _, Vs, Vs) :- + nonvar(V), + rb_lookup(V, _, Evs), !. % propagate to kids, if we do not -handle_ball_from_below(V, G, RG, Vs0, Vs1) :- - dgraph_neighbors(V, RG, Parents), - propagate_ball_from_below(Parents, V, G, RG, Vs0, Vs1). +handle_ball_from_below(V, Evs, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, RG, Parents), + propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1). -propagate_ball_from_below([], V, G, RG, Vs0, Vs1) :- !, - dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1). -propagate_ball_from_below(Parents, _V, G, RG, Vs0, Vs1) :- - throw_all_above(Parents, G, RG, Vs0, Vs1). +propagate_ball_from_below([], Evs, V, G, RG, Vs0, Vs1) :- !, + dgraph_neighbors(V, G, Children), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). +propagate_ball_from_below(Parents, Evs, _V, G, RG, Vs0, Vs1) :- + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). -all_top(T, Vs) :- - rb_visit(T, Pairs), - get_tops(Pairs, Vs). +all_top(T, Evs, Vs) :- + rb_visit(T, Pairs), + foldl( get_top(Evs), Pairs, [], Vs). -get_tops([], []). -get_tops([V-(T._)|Pairs], V.Vs) :- - T == t, !, - get_tops(Pairs, Vs). -get_tops([V-_|Pairs], V.Vs) :- - clpbn:get_atts(V,[evidence(_)]), !, - get_tops(Pairs, Vs). -get_tops(_.Pairs, Vs) :- - get_tops(Pairs, Vs). +get_top(_EVs, V-[T|_], Vs, [V|Vs]) :- + T == t, !. +get_top(_EVs, V-_, Vs, [V|Vs]) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !. +get_top(EVs, V-_, Vs, [V|Vs]) :- + nonvar(V), + rb_lookup(V, _, EVs), !. +get_top(_, Vs, Vs). diff --git a/packages/CLPBN/clpbn/ve.yap b/packages/CLPBN/clpbn/ve.yap index faf8b49e6..f6ab08192 100644 --- a/packages/CLPBN/clpbn/ve.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -15,9 +15,10 @@ *********************************/ :- module(clpbn_ve, [ve/3, - check_if_ve_done/1, - init_ve_solver/4, - run_ve_solver/3]). + check_if_ve_done/1, + init_ve_solver/4, + run_ve_solver/3, + call_ve_ground_solver/6]). :- attribute size/1, all_diffs/1. @@ -46,11 +47,14 @@ :- use_module(library('clpbn/connected'), [ init_influences/3, - influences/4 + influences/4, + factor_influences/4 ]). :- use_module(library(clpbn/matrix_cpt_utils)). +:- use_module(library(clpbn/numbers)). + :- use_module(library(lists), [ member/2, @@ -77,16 +81,63 @@ check_if_ve_done(Var) :- get_atts(Var, [size(_)]), !. - % + +% +% new PFL like interface... +% +call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- + call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions), + clpbn_bind_vals([QueryVars], Solutions, Output). + +call_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- + keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), + init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE), + run_solver(QueryKeys, Solutions, VE). + +simulate_ve_ground_solver(_QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- + simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output). + +simulate_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- + keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), + init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE), + simulate_solver(QueryKeys, Solutions, VE). + + +% % implementation of the well known variable elimination algorithm % ve([[]],_,_) :- !. ve(LLVs,Vs0,AllDiffs) :- - init_ve_solver(LLVs, Vs0, AllDiffs, State), - % variable elimination proper - run_ve_solver(LLVs, LLPs, State), - % bind Probs back to variables so that they can be output. - clpbn_bind_vals(LLVs,LLPs,AllDiffs). + init_ve_solver(LLVs, Vs0, AllDiffs, State), + % variable elimination proper + run_ve_solver(LLVs, LLPs, State), + % bind Probs back to variables so that they can be output. + clpbn_bind_vals(LLVs,LLPs,AllDiffs). + + +init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, BG, Ev)) :- + rb_new(Fs0), + foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF), + sort(FVs, SFVs), + rb_new(VInfo0), + add_vs(SFVs, Fs, VInfo0, VInfo), + BG = bigraph(VInfo, IF, Fs), + rb_new(Ev0), + foldl(evtotree,EvidenceIds,Ev0,Ev). + +evtotree(K=V,Ev0,Ev) :- + rb_insert(Ev0, K, V, Ev). + +factor_to_graph( f(Nodes, Sizes, Pars0, _), Factors0, Factors, Edges0, Edges, I0, I) :- + I is I0+1, + init_CPT(Pars0, Sizes, CPT0), + reorder_CPT(Nodes, CPT0, FIPs, CPT, _), + F = f(I0, FIPs, CPT), + rb_insert(Factors0, I0, F, Factors), + foldl(add_f_to_nodes(I0), Nodes, Edges0, Edges). + +add_f_to_nodes(I0, Node, Edges, [Node-I0|Edges]). + % % Qs is a list of lists with all query vars (marginals) @@ -156,7 +207,7 @@ parent_to_id(VMap, V, DS, I) :- factors_to_vs(Fs, VInfo) :- rb_visit(Fs, L), - foldl(fsvs, L, FVs, []), + fsvs(L, FVs, []), sort(FVs, SFVs), rb_new(VInfo0), add_vs(SFVs, Fs, VInfo0, VInfo). @@ -186,6 +237,46 @@ collect_factors([V-F|SFVs], Fs, V, [FInfo|FInfos], R):- collect_factors(SFVs, Fs, V, FInfos, R). collect_factors(SFVs, _Fs, _V, [], SFVs). +% solve each query independently +% use a findall to recover space without needing for GC +run_solver(LQVs, LLPs, ve(FIds, Hash, Id, BG, Ev)) :- + lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _), + findall(LPs, solve(LQIds, FIds, BG, Ev, LPs), LLPs). + +solve([QVs|_], FIds, Bigraph, Evs, LPs) :- + factor_influences(FIds, QVs, Evs, LVs), + do_solve(QVs, LVs, Bigraph, Evs, LPs). +solve([_|LQVs], FIds, Bigraph, Ev, LPs) :- + solve(LQVs, FIds, Bigraph, Ev, LPs). + +do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :- + % get only what is relevant to query, + project_to_query_related(IVs, OldVs, SVs, Fs1), + % and also prune using evidence + rb_visit(Ev, EvL), + foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), + % eliminate + eliminate(IQVs, digraph(EVs, IF, Fs2), Dist), +% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD), +%exps(LD,LDE),writeln(LDE), + % move from potentials back to probabilities + normalise_CPT(Dist,MPs), + list_from_CPT(MPs, Ps). + +simulate_solver(LQVs, Choices, ve(FIds, Hash, Id, BG, Evs)) :- + lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _), + factor_influences(FIds, QVs, Evs, LVs), + do_simulate(QVs, LVs, BG, Evs, Choices). + +do_simulate(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Choices) :- + % get only what is relevant to query, + project_to_query_related(IVs, OldVs, SVs, Fs1), + % and also prune using evidence + rb_visit(Ev, EvL), + foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), + % eliminate + simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices). + % solve each query independently % use a findall to recover space without needing for GC run_ve_solver(_, LLPs, state(LQVs, LVs, _VMap, Bigraph, Ev)) :- @@ -277,6 +368,9 @@ check_v(NVs, V) :- clean_v_ev(V=E, FVs0, FVs, Vs0, Vs) :- rb_delete(Vs0, V, Fs, Vs1), foldl2(simplify_f_ev(V, E), Fs, FVs0, FVs, Vs1, Vs). +clean_v_ev(V-E, FVs0, FVs, Vs0, Vs) :- + rb_delete(Vs0, V, Fs, Vs1), + foldl2(simplify_f_ev(V, E), Fs, FVs0, FVs, Vs1, Vs). % % diff --git a/packages/CLPBN/examples/School/README b/packages/CLPBN/examples/School/README index 7b2a725e5..93265adf4 100644 --- a/packages/CLPBN/examples/School/README +++ b/packages/CLPBN/examples/School/README @@ -49,8 +49,8 @@ course_rating(c0,h), course_difficulty(c0,X). course_difficulty(c0,X). -student_ranking(s0,X). +rank(s0,X). -student_ranking(s0,X), student_intelligence(s0,h). +rank(s0,X), student_intelligence(s0,h). diff --git a/packages/CLPBN/examples/School/school_32.yap b/packages/CLPBN/examples/School/school_32.yap index 2a794bbda..3ba7f855a 100644 --- a/packages/CLPBN/examples/School/school_32.yap +++ b/packages/CLPBN/examples/School/school_32.yap @@ -21,8 +21,8 @@ total_students(256). %:- clpbn_horus:set_solver(fove). %:- clpbn_horus:set_solver(hve). :- clpbn_horus:set_solver(bp). -:- clpbn_horus:set_solver(bdd). -%:- clpbn_horus:set_solver(ve). +%:- clpbn_horus:set_solver(bdd). +:- clpbn_horus:set_solver(ve). %:- clpbn_horus:set_solver(cbp). :- ensure_loaded(school32_data). diff --git a/packages/Dialect.defs.in b/packages/Dialect.defs.in index 5358668d2..f40185efc 100644 --- a/packages/Dialect.defs.in +++ b/packages/Dialect.defs.in @@ -48,10 +48,11 @@ CMFLAGS=@SHLIB_CFLAGS@ CIFLAGS= CFLAGS=$(COFLAGS) $(CWFLAGS) $(CMFLAGS) $(CIFLAGS) $(PKGCFLAGS) @DEFS@ -LDSOFLAGS=@LDFLAGS@ @EXTRA_LIBS_FOR_SWIDLLS@ +LDSOFLAGS=@LDFLAGS@ LDFLAGS=$(PKGLDFLAGS) -LIBPLEMBED= +LIBPLEMBED=@EXTRA_LIBS_FOR_SWIDLLS@ +LIBPLSO=@EXTRA_LIBS_FOR_SWIDLLS@ MKINDEX=(cd $(srcdir) ; $(PL) -f none -g make -t halt) diff --git a/packages/real b/packages/real index 758eb8d79..d0118006e 160000 --- a/packages/real +++ b/packages/real @@ -1 +1 @@ -Subproject commit 758eb8d7960684fe18e01cdff41013cce097f197 +Subproject commit d0118006ebb4e9afe6eb23d0cff46fec56d76a12