diff --git a/.gitignore b/.gitignore index 53270c3cc..912c2703a 100644 --- a/.gitignore +++ b/.gitignore @@ -135,4 +135,7 @@ build Debug debug Release -Build \ No newline at end of file +Build +xcode +Threads +mxe \ No newline at end of file diff --git a/C/absmi.c b/C/absmi.c index 99fa1bbae..1edb24337 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -1062,6 +1062,39 @@ interrupt_pexecute( PredEntry *pen USES_REGS ) return interrupt_handler( pen PASS_REGS ); } +static void +execute_dealloc( USES_REGS1 ) +{ + /* other instructions do depend on S being set by deallocate + :-( */ + CELL *ENV_YREG = YENV; + S = ENV_YREG; + CP = (yamop *) ENV_YREG[E_CP]; + ENV = ENV_YREG = (CELL *) ENV_YREG[E_E]; +#ifdef DEPTH_LIMIT + DEPTH = ENV_YREG[E_DEPTH]; +#endif /* DEPTH_LIMIT */ +#ifdef FROZEN_STACKS + { + choiceptr top_b = PROTECT_FROZEN_B(B); +#ifdef YAPOR_SBA + if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; +#else + if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b; +#endif /* YAPOR_SBA */ + else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CP)); + } +#else + if (ENV_YREG > (CELL *) B) + ENV_YREG = (CELL *) B; + else + ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP)); +#endif /* FROZEN_STACKS */ + YENV = ENV_YREG; + P = NEXTOP(P,p); + +} + /* don't forget I cannot creep at deallocate (where to?) */ /* also, this is unusual in that I have already done deallocate, so I don't need to redo it. @@ -1085,6 +1118,7 @@ interrupt_deallocate( USES_REGS1 ) /* keep on going if there is something else */ (P->opc != Yap_opcode(_procceed) && P->opc != Yap_opcode(_cut_e))) { + execute_dealloc( PASS_REGS1 ); return 1; } else { CELL cut_b = LCL0-(CELL *)(S[E_CB]); diff --git a/C/atomic.c b/C/atomic.c index 1897b79b9..429939f83 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -1100,7 +1100,7 @@ atom_concat2( USES_REGS1 ) error: /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError( "string_code/3" )) { + if (Yap_HandleError( "atom_concat/2" )) { goto restart_aux; } else { return FALSE; diff --git a/C/blobs.c b/C/blobs.c index 66b232d9b..2e19d06e4 100644 --- a/C/blobs.c +++ b/C/blobs.c @@ -35,6 +35,7 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz) char *s = (char *)s0; blob_type_t *type = RepBlobProp(ref->PropsOfAE)->blob_type; +#if HAVE_FMEMOPEN if (type->write) { FILE *f = fmemopen( s, sz, "w"); if (f == NULL){ @@ -49,6 +50,7 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz) fclose(f); // return the final result. return s; } else { +#endif #if __APPLE__ size_t sz0 = strlcpy( s, (char *)RepAtom( AtomSWIStream )->StrOfAE, sz); #else @@ -65,8 +67,10 @@ char * Yap_blob_to_string(AtomEntry *ref, const char *s0, size_t sz) snprintf(s+strlen(s), sz0, "(0x%p)", ref); #endif return s; - } +#if HAVE_FMEMOPEN + } return NULL; +#endif } int Yap_write_blob(AtomEntry *ref, FILE *stream) diff --git a/C/c_interface.c b/C/c_interface.c index 77425b3dd..e05b56495 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1,332 +1,20 @@ /************************************************************************* * -* YAP Prolog * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- * -* * -************************************************************************** -* * -* File: c_interface.c * -* comments: c_interface primitives definition * -* * -* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ -** -* $Log: not supported by cvs2svn $ -* Revision 1.122 2008/08/01 21:44:24 vsc -* swi compatibility support -* -* Revision 1.121 2008/07/24 16:02:00 vsc -* improve C-interface and SWI comptaibility a bit. -* -* Revision 1.120 2008/07/11 17:02:07 vsc -* fixes by Bart and Tom: mostly libraries but nasty one in indexing -* compilation. -* -* Revision 1.119 2008/06/17 13:37:48 vsc -* fix c_interface not to crash when people try to recover slots that are -* not there. -* fix try_logical and friends to handle case where predicate has arity 0. -* -* Revision 1.118 2008/06/04 14:47:18 vsc -* make sure we do trim_trail whenever we mess with B!cfc -* -* Revision 1.117 2008/06/04 13:58:36 vsc -* more fixes to C-interface -* -* Revision 1.116 2008/04/28 23:02:32 vsc -* fix bug in current_predicate/2 -* fix bug in c_interface. -* -* Revision 1.115 2008/04/11 16:30:27 ricroc -* *** empty log message *** -* -* Revision 1.114 2008/04/04 13:35:41 vsc -* fix duplicate dependency frame at entry -* -* Revision 1.113 2008/04/04 09:10:02 vsc -* restore was restoring twice -* -* Revision 1.112 2008/04/03 13:26:38 vsc -* protect signal handling with locks for threaded version. -* fix close/1 entry in manual (obs from Nicos). -* fix -f option in chr Makefile. -* -* Revision 1.111 2008/04/02 21:44:07 vsc -* threaded version should ignore saved states (for now). -* -* Revision 1.110 2008/04/02 17:37:06 vsc -* handle out of memory error at thread creation (obs from Paulo Moura). -* -* Revision 1.109 2008/04/01 15:31:41 vsc -* more saved state fixes -* -* Revision 1.108 2008/03/22 23:35:00 vsc -* fix bug in all_calls -* -* Revision 1.107 2008/03/13 18:41:50 vsc -* -q flag -* -* Revision 1.106 2008/02/12 17:03:50 vsc -* SWI-portability changes -* -* Revision 1.105 2008/01/28 10:42:19 vsc -* fix BOM trouble -* -* Revision 1.104 2007/12/05 12:17:23 vsc -* improve JT -* fix graph compatibility with SICStus -* re-export declaration. -* -* Revision 1.103 2007/11/16 14:58:40 vsc -* implement sophisticated operations with matrices. -* -* Revision 1.102 2007/11/01 20:50:31 vsc -* fix YAP_LeaveGoal (again) -* -* Revision 1.101 2007/10/29 22:48:54 vsc -* small fixes -* -* Revision 1.100 2007/10/28 00:54:09 vsc -* new version of viterbi implementation -* fix all:atvars reporting bad info -* fix bad S info in x86_64 -* -* Revision 1.99 2007/10/16 18:57:17 vsc -* get rid of debug statement. -* -* Revision 1.98 2007/10/15 23:48:46 vsc -* unset var -* -* Revision 1.97 2007/10/05 18:24:30 vsc -* fix garbage collector and fix LeaveGoal -* -* Revision 1.96 2007/09/04 10:34:54 vsc -* Improve SWI interface emulation. -* -* Revision 1.95 2007/06/04 12:28:01 vsc -* interface speedups -* bad error message in X is foo>>2. -* -* Revision 1.94 2007/05/15 11:33:51 vsc -* fix min list -* -* Revision 1.93 2007/05/14 16:44:11 vsc -* improve external interface -* -* Revision 1.92 2007/04/18 23:01:16 vsc -* fix deadlock when trying to create a module with the same name as a -* predicate (for now, just don't lock modules). obs Paulo Moura. -* -* Revision 1.91 2007/03/30 16:47:22 vsc -* fix gmpless blob handling -* -* Revision 1.90 2007/03/22 11:12:20 vsc -* make sure that YAP_Restart does not restart a failed goal. -* -* Revision 1.89 2007/01/28 14:26:36 vsc -* WIN32 support -* -* Revision 1.88 2007/01/08 08:27:19 vsc -* fix restore (Trevor) -* make indexing a bit faster on IDB -* -* Revision 1.87 2006/12/13 16:10:14 vsc -* several debugger and CLP(BN) improvements. -* -* Revision 1.86 2006/11/27 17:42:02 vsc -* support for UNICODE, and other bug fixes. -* -* Revision 1.85 2006/05/16 18:37:30 vsc -* WIN32 fixes -* compiler bug fixes -* extend interface -* -* Revision 1.84 2006/03/09 15:52:04 tiagosoares -* CUT_C and MYDDAS support for 64 bits architectures -* -* Revision 1.83 2006/02/08 17:29:54 tiagosoares -* MYDDAS: Myddas Top Level for MySQL and Datalog -* -* Revision 1.82 2006/01/18 15:34:53 vsc -* avoid sideffects from MkBigInt -* -* Revision 1.81 2006/01/16 02:57:51 vsc -* fix bug with very large integers -* fix bug where indexing code was looking at code after a cut. -* -* Revision 1.80 2006/01/02 03:35:44 vsc -* fix interface and docs -* -* Revision 1.79 2006/01/02 02:25:44 vsc -* cannot release space from external GMPs. -* -* Revision 1.78 2006/01/02 02:16:18 vsc -* support new interface between YAP and GMP, so that we don't rely on our own -* allocation routines. -* Several big fixes. -* -* Revision 1.77 2005/11/18 18:48:51 tiagosoares -* support for executing c code when a cut occurs -* -* Revision 1.76 2005/11/03 18:49:26 vsc -* fix bignum conversion -* -* Revision 1.75 2005/10/28 17:38:49 vsc -* sveral updates -* -* Revision 1.74 2005/10/21 16:07:07 vsc -* fix tabling -* -* Revision 1.73 2005/10/18 17:04:43 vsc -* 5.1: -* - improvements to GC -* 2 generations -* generic speedups -* - new scheme for attvars -* - hProlog like interface also supported -* - SWI compatibility layer -* - extra predicates -* - global variables -* - moved to Prolog module -* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart -* Demoen and Jan Wielemacker -* - load_files/2 -* -* from 5.0.1 -* -* - WIN32 missing include files (untested) -* - -L trouble (my thanks to Takeyuchi Shiramoto-san)! -* - debugging of backtrable user-C preds would core dump. -* - redeclaring a C-predicate as Prolog core dumps. -* - badly protected YapInterface.h. -* - break/0 was failing at exit. -* - YAP_cut_fail and YAP_cut_succeed were different from manual. -* - tracing through data-bases could core dump. -* - cut could break on very large computations. -* - first pass at BigNum issues (reported by Roberto). -* - debugger could get go awol after fail port. -* - weird message on wrong debugger option. -* -* Revision 1.72 2005/10/15 02:42:57 vsc -* fix interface -* -* Revision 1.71 2005/08/17 13:35:51 vsc -* YPP would leave exceptions on the system, disabling Yap-4.5.7 -* message. -* -* Revision 1.70 2005/08/04 15:45:51 ricroc -* TABLING NEW: support to limit the table space size -* -* Revision 1.69 2005/07/19 17:12:18 rslopes -* fix for older compilers that do not support declaration of vars -* in the middle of the function code. -* -* Revision 1.68 2005/05/31 00:23:47 ricroc -* remove abort_yapor function -* -* Revision 1.67 2005/04/10 04:35:19 vsc -* AllocMemoryFromYap should now handle large requests the right way. -* -* Revision 1.66 2005/04/10 04:01:10 vsc -* bug fixes, I hope! -* -* Revision 1.65 2005/03/15 18:29:23 vsc -* fix GPL -* fix idb: stuff in coroutines. -* -* Revision 1.64 2005/03/13 06:26:10 vsc -* fix excessive pruning in meta-calls -* fix Term->int breakage in compiler -* improve JPL (at least it does something now for amd64). -* -* Revision 1.63 2005/03/04 20:30:10 ricroc -* bug fixes for YapTab support -* -* Revision 1.62 2005/03/02 18:35:44 vsc -* try to make initialization process more robust -* try to make name more robust (in case Lookup new atom fails) -* -* Revision 1.61 2005/03/01 22:25:08 vsc -* fix pruning bug -* make DL_MALLOC less enthusiastic about walking through buckets. -* -* Revision 1.60 2005/02/08 18:04:47 vsc -* library_directory may not be deterministic (usually it isn't). -* -* Revision 1.59 2004/12/08 00:56:35 vsc -* missing ; -* -* Revision 1.58 2004/11/19 22:08:41 vsc -* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever -*appropriate. -* -* Revision 1.57 2004/11/18 22:32:31 vsc -* fix situation where we might assume nonextsing double initialization of C -*predicates (use -* Hidden Pred Flag). -* $host_type was double initialized. -* -* Revision 1.56 2004/10/31 02:18:03 vsc -* fix bug in handling Yap heap overflow while adding new clause. -* -* Revision 1.55 2004/10/28 20:12:20 vsc -* Use Doug Lea's malloc as an alternative to YAP's standard malloc -* don't use TR directly in scanner/parser, this avoids trouble with ^C while -* consulting large files. -* pass gcc -mno-cygwin to library compilation in cygwin environment (cygwin -*should -* compile out of the box now). -* -* Revision 1.54 2004/10/06 16:55:46 vsc -* change configure to support big mem configs -* get rid of extra globals -* fix trouble with multifile preds -* -* Revision 1.53 2004/08/11 16:14:51 vsc -* whole lot of fixes: -* - memory leak in indexing -* - memory management in WIN32 now supports holes -* - extend Yap interface, more support for SWI-Interface -* - new predicate mktime in system -* - buffer console I/O in WIN32 -* -* Revision 1.52 2004/07/23 03:37:16 vsc -* fix heap overflow in YAP_LookupAtom -* -* Revision 1.51 2004/07/22 21:32:20 vsc -* debugger fixes -* initial support for JPL -* bad calls to garbage collector and gc -* debugger fixes -* -* Revision 1.50 2004/06/29 19:04:41 vsc -* fix multithreaded version -* include new version of Ricardo's profiler -* new predicat atomic_concat -* allow multithreaded-debugging -* small fixes -* -* Revision 1.49 2004/06/09 03:32:02 vsc -* fix bugs -* -* Revision 1.48 2004/06/05 03:36:59 vsc -* coroutining is now a part of attvars. -* some more fixes. -* -* Revision 1.47 2004/05/17 21:42:08 vsc -* misc fixes -* -* Revision 1.46 2004/05/14 17:56:45 vsc -* Yap_WriteBuffer -* -* Revision 1.45 2004/05/14 17:11:30 vsc -* support BigNums in interface -* -* Revision 1.44 2004/05/14 16:33:44 vsc -* add Yap_ReadBuffer -* * -* * -*************************************************************************/ + * YAP Prolog * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- * + * * + ************************************************************************** + * * + * File: c_interface.c * + * comments: c_interface primitives definition * + * * + * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $ + ** + * $Log: not supported by cvs2svn $ + * * + * * + *************************************************************************/ /** @file c_interface.c @@ -370,11 +58,11 @@ #include #endif -typedef enum { - FRG_FIRST_CALL = 0, /* Initial call */ - FRG_CUTTED = 1, /* Context was cutted */ - FRG_REDO = 2 /* Normal redo */ -} frg_code; + typedef enum { + FRG_FIRST_CALL = 0, /* Initial call */ + FRG_CUTTED = 1, /* Context was cutted */ + FRG_REDO = 2 /* Normal redo */ + } frg_code; struct foreign_context { uintptr_t context; /* context value */ @@ -391,7 +79,7 @@ X_API int YAP_Reset(yap_reset_t mode); #define strncat(X, Y, Z) strcat(X, Y) #endif -#if defined(_MSC_VER) && defined(YAP_EXPORTS) +#if defined(_WIN32) #define X_API __declspec(dllexport) #endif @@ -1626,11 +1314,12 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); } * @param bufsize bu * * @return - */X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { + */ X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { CACHE_REGS seq_tv_t inp, out; inp.val.t = t; - inp.type = YAP_STRING_ATOMS_CODES |YAP_STRING_STRING |YAP_STRING_ATOM | YAP_STRING_TRUNC | YAP_STRING_MALLOC; + inp.type = YAP_STRING_ATOMS_CODES | YAP_STRING_STRING | YAP_STRING_ATOM | + YAP_STRING_TRUNC | YAP_STRING_MALLOC; inp.max = bufsize; out.type = YAP_STRING_CHARS; out.val.c = buf; @@ -1723,7 +1412,8 @@ X_API Term YAP_ReadBuffer(const char *s, Term *tp) { BACKUP_H(); LOCAL_ErrorMessage = NULL; - while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, GLOBAL_MaxPriority, tp))) { + while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, + GLOBAL_MaxPriority, tp))) { if (LOCAL_ErrorMessage) { if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) { if (!Yap_dogc(0, NULL PASS_REGS)) { @@ -2404,7 +2094,8 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { } bool consulted = (mode == YAP_CONSULT_MODE); Yap_init_consult(consulted, filename); - f = fopen(Yap_AbsoluteFile(filename, LOCAL_FileNameBuf, FILENAME_MAX-1), "r"); + f = fopen(Yap_AbsoluteFile(filename, LOCAL_FileNameBuf, FILENAME_MAX - 1), + "r"); if (!f) return -1; sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f); @@ -3590,43 +3281,43 @@ size_t YAP_UTF8_TextLength(Term t) { utf8proc_uint8_t dst[8]; size_t sz = 0; - if (IsPairTerm( t )) { + if (IsPairTerm(t)) { while (t != TermNil) { int c; - Term hd = HeadOfTerm( t ); + Term hd = HeadOfTerm(t); if (IsAtomTerm(hd)) { - Atom at = AtomOfTerm(hd); - if (IsWideAtom(at)) - c = RepAtom(at)->WStrOfAE[0]; - else - c = RepAtom(at)->StrOfAE[0]; + Atom at = AtomOfTerm(hd); + if (IsWideAtom(at)) + c = RepAtom(at)->WStrOfAE[0]; + else + c = RepAtom(at)->StrOfAE[0]; } else if (IsIntegerTerm(hd)) { - c = IntegerOfTerm( hd ); + c = IntegerOfTerm(hd); } else { - c = '\0'; + c = '\0'; } sz += utf8proc_encode_char(c, dst); t = TailOfTerm(t); } - } else if (IsAtomTerm(t)) { - Atom at = AtomOfTerm(t); - if (IsWideAtom(at)) { - const wchar_t *s = RepAtom(at)->WStrOfAE; - int c; - while ((c = *s++)) { - sz += utf8proc_encode_char(c, dst); - } - } else { - const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE; - int c; + } else if (IsAtomTerm(t)) { + Atom at = AtomOfTerm(t); + if (IsWideAtom(at)) { + const wchar_t *s = RepAtom(at)->WStrOfAE; + int c; + while ((c = *s++)) { + sz += utf8proc_encode_char(c, dst); + } + } else { + const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE; + int c; - while ((c = *s++)) { - sz += utf8proc_encode_char(c, dst); - } - } - } else if (IsStringTerm(t)) { - sz = strlen(StringOfTerm( t )) ; + while ((c = *s++)) { + sz += utf8proc_encode_char(c, dst); + } + } + } else if (IsStringTerm(t)) { + sz = strlen(StringOfTerm(t)); } return sz; } diff --git a/C/cdmgr.c b/C/cdmgr.c index 8e50c251a..e60de6425 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1954,8 +1954,9 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */ cclause() in case there is a overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */ if (!LOCAL_ErrorMessage) { - + YAPEnterCriticalSection(); addclause(t, code_adr, mode, mod, &ARG5); + YAPLeaveCriticalSection(); } if (LOCAL_ErrorMessage) { if (!LOCAL_Error_Term) @@ -1964,7 +1965,6 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */ YAPLeaveCriticalSection(); return false; } - YAPLeaveCriticalSection(); return true; } @@ -2524,6 +2524,10 @@ static Int p_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */ UNLOCKPE(48, pe); return FALSE; } + if (is_system(pe) || is_foreign(pe) ) { + UNLOCKPE(48, pe); + return FALSE; + } owner = pe->src.OwnerFile; UNLOCKPE(49, pe); if (owner == AtomNil) diff --git a/C/clause_list.c b/C/clause_list.c index 845a8aaa3..87280478e 100644 --- a/C/clause_list.c +++ b/C/clause_list.c @@ -3,49 +3,42 @@ #include "tracer.h" #ifdef YAPOR #include "or.macros.h" -#endif /* YAPOR */ +#endif /* YAPOR */ #include "clause_list.h" /* need to fix overflow handling */ -static void -mk_blob(int sz USES_REGS) -{ +static void mk_blob(int sz USES_REGS) { MP_INT *dst; - + HR[0] = (CELL)FunctorBigInt; HR[1] = CLAUSE_LIST; - dst = (MP_INT *)(HR+2); + dst = (MP_INT *)(HR + 2); dst->_mp_size = 0L; dst->_mp_alloc = sz; - HR += (1+sizeof(MP_INT)/sizeof(CELL)); + HR += (1 + sizeof(MP_INT) / sizeof(CELL)); HR[sz] = EndSpecials; - HR += sz+1; + HR += sz + 1; } -static CELL * -extend_blob(CELL *start, int sz USES_REGS) -{ +static CELL *extend_blob(CELL *start, int sz USES_REGS) { UInt osize; MP_INT *dst; - + if (HR + sz > ASP) return NULL; - dst = (MP_INT *)(start+2); + dst = (MP_INT *)(start + 2); osize = dst->_mp_alloc; - start += (1+sizeof(MP_INT)/sizeof(CELL)); - start[sz+osize] = EndSpecials; + start += (1 + sizeof(MP_INT) / sizeof(CELL)); + start[sz + osize] = EndSpecials; dst->_mp_alloc += sz; HR += sz; - return start+osize; + return start + osize; } /*init of ClasuseList*/ -X_API clause_list_t -Yap_ClauseListInit(clause_list_t in) -{ - CACHE_REGS - in->n = 0; + clause_list_t Yap_ClauseListInit(clause_list_t in) { + CACHE_REGS in->n = 0; in->start = HR; mk_blob(0 PASS_REGS); in->end = HR; @@ -54,9 +47,7 @@ Yap_ClauseListInit(clause_list_t in) /*add clause to ClauseList returns FALSE on error*/ -X_API int -Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) -{ + int Yap_ClauseListExtend(clause_list_t cl, void *clause, void *pred) { CACHE_REGS PredEntry *ap = (PredEntry *)pred; @@ -65,15 +56,19 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) return FALSE; if (cl->n == 0) { void **ptr; - if (!(ptr = (void **)extend_blob(cl->start,1 PASS_REGS))) return FALSE; + if (!(ptr = (void **)extend_blob(cl->start, 1 PASS_REGS))) + return FALSE; ptr[0] = clause; - } else if (cl->n == 1) { + } else if (cl->n == 1) { yamop **ptr; yamop *code_p, *fclause; - - if (!(ptr = (yamop **)extend_blob(cl->start,2*(CELL)NEXTOP((yamop *)NULL,Otapl)/sizeof(CELL)-1 PASS_REGS))) return FALSE; + + if (!(ptr = (yamop **)extend_blob( + cl->start, 2 * (CELL)NEXTOP((yamop *)NULL, Otapl) / sizeof(CELL) - + 1 PASS_REGS))) + return FALSE; fclause = ptr[-1]; - code_p = (yamop *)(ptr-1); + code_p = (yamop *)(ptr - 1); code_p->opc = Yap_opcode(_try_clause); code_p->y_u.Otapl.d = fclause; code_p->y_u.Otapl.s = ap->ArityOfPE; @@ -84,7 +79,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) #ifdef YAPOR INIT_YAMOP_LTT(code_p, 0); #endif /* YAPOR */ - code_p = NEXTOP(code_p,Otapl); + code_p = NEXTOP(code_p, Otapl); code_p->opc = Yap_opcode(_trust); code_p->y_u.Otapl.d = clause; code_p->y_u.Otapl.s = ap->ArityOfPE; @@ -98,7 +93,10 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) } else { yamop *code_p; - if (!(code_p = (yamop *)extend_blob(cl->start,((CELL)NEXTOP((yamop *)NULL,Otapl))/sizeof(CELL) PASS_REGS))) return FALSE; + if (!(code_p = (yamop *)extend_blob(cl->start, + ((CELL)NEXTOP((yamop *)NULL, Otapl)) / + sizeof(CELL) PASS_REGS))) + return FALSE; code_p->opc = Yap_opcode(_trust); code_p->y_u.Otapl.d = clause; code_p->y_u.Otapl.s = ap->ArityOfPE; @@ -109,7 +107,7 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) #ifdef YAPOR INIT_YAMOP_LTT(code_p, 0); #endif /* YAPOR */ - code_p = PREVOP(code_p,Otapl); + code_p = PREVOP(code_p, Otapl); code_p->opc = Yap_opcode(_retry); } cl->end = HR; @@ -118,16 +116,11 @@ Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred) } /*closes the clause list*/ -X_API void -Yap_ClauseListClose(clause_list_t cl) -{ - /* no need to do nothing */ + void Yap_ClauseListClose(clause_list_t cl) { /* no need to do nothing */ } /*destroys the clause list freeing memory*/ -X_API int -Yap_ClauseListDestroy(clause_list_t cl) -{ + int Yap_ClauseListDestroy(clause_list_t cl) { CACHE_REGS if (cl->end != HR) return FALSE; @@ -136,34 +129,25 @@ Yap_ClauseListDestroy(clause_list_t cl) } /*destroys clause list and returns only first clause*/ -X_API void * -Yap_ClauseListToClause(clause_list_t cl) -{ + void *Yap_ClauseListToClause(clause_list_t cl) { CACHE_REGS void **ptr; if (cl->end != HR) return NULL; if (cl->n != 1) return NULL; - if (!(ptr = (void **)extend_blob(cl->start,0 PASS_REGS))) return NULL; + if (!(ptr = (void **)extend_blob(cl->start, 0 PASS_REGS))) + return NULL; return ptr[-1]; } /*return pointer to start of try-retry-trust sequence*/ -X_API void * -Yap_ClauseListCode(clause_list_t cl) -{ + void *Yap_ClauseListCode(clause_list_t cl) { CELL *ptr; ptr = (CELL *)cl->start; - ptr += (1+sizeof(MP_INT)/sizeof(CELL)); + ptr += (1 + sizeof(MP_INT) / sizeof(CELL)); return (void *)ptr; } /* where to fail */ -X_API void * -Yap_FAILCODE(void) -{ - return (void *)FAILCODE; -} - - + void *Yap_FAILCODE(void) { return (void *)FAILCODE; } diff --git a/C/cmppreds.c b/C/cmppreds.c index 31278c5fd..6ef967f01 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -15,11 +15,13 @@ * comments: comparing two prolog terms * * * *************************************************************************/ + /// @file cmppreds.c -/** @defgroup Comparing_Terms Comparing Terms +/** + @defgroup Comparing_Terms Comparing Terms @ingroup builtins The following predicates are used to compare and order terms, using the @@ -29,8 +31,7 @@ standard ordering: variables come before numbers, numbers come before atoms which in turn come before compound terms, i.e.: variables @< numbers @< atoms @< compound terms. -+ -Variables are roughly ordered by "age" (the "oldest" variable is put ++ Variables are roughly ordered by "age" (the "oldest" variable is put first); + Floating point numbers are sorted in increasing order; diff --git a/C/errors.c b/C/errors.c index f409e17d3..63ec1424e 100755 --- a/C/errors.c +++ b/C/errors.c @@ -115,17 +115,17 @@ bool Yap_Warning(const char *s, ...) { } else return false; va_end(ap); - if (pred->OpcodeOfPred == UNDEF_OPCODE) { + if (pred->OpcodeOfPred == UNDEF_OPCODE|| + pred->OpcodeOfPred == FAIL_OPCODE) { fprintf(stderr, "warning message: %s\n", tmpbuf); LOCAL_DoingUndefp = false; LOCAL_within_print_message = false; - return true; + return false; } ts[1] = MkAtomTerm(AtomWarning); ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf)); rc = Yap_execute_pred(pred, ts, true PASS_REGS); - LOCAL_within_print_message = false; return rc; } @@ -133,6 +133,7 @@ bool Yap_PrintWarning(Term twarning) { CACHE_REGS PredEntry *pred = RepPredProp(PredPropByFunc( FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2; + Term cmod = CurrentModule; bool rc; Term ts[2]; @@ -143,13 +144,16 @@ bool Yap_PrintWarning(Term twarning) { } LOCAL_DoingUndefp = true; LOCAL_within_print_message = true; - if (pred->OpcodeOfPred == UNDEF_OPCODE) { + if (pred->OpcodeOfPred == UNDEF_OPCODE || + pred->OpcodeOfPred == FAIL_OPCODE + ) { fprintf(stderr, "warning message:\n"); Yap_DebugPlWrite(twarning); fprintf(stderr, "\n"); LOCAL_DoingUndefp = false; LOCAL_within_print_message = false; - return true; + CurrentModule = cmod; + return false; } ts[1] = twarning; ts[0] = MkAtomTerm(AtomWarning); @@ -159,7 +163,7 @@ bool Yap_PrintWarning(Term twarning) { return rc; } -int Yap_HandleError(const char *s, ...) { +bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *s, ...) { CACHE_REGS yap_error_number err = LOCAL_Error_TYPE; const char *serr; @@ -173,28 +177,28 @@ int Yap_HandleError(const char *s, ...) { switch (err) { case RESOURCE_ERROR_STACK: if (!Yap_gc(2, ENV, gc_P(P, CP))) { - Yap_Error(RESOURCE_ERROR_STACK, ARG1, serr); - return (FALSE); + Yap_Error__(file, function, lineno, RESOURCE_ERROR_STACK, ARG1, serr); + return false; } - return TRUE; + return true; case RESOURCE_ERROR_AUXILIARY_STACK: if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) { LOCAL_MAX_SIZE += 1024; } if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { /* crash in flames */ - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr); - return FALSE; + Yap_Error__(file, function, lineno, RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr); + return false; } - return TRUE; + return true; case RESOURCE_ERROR_HEAP: if (!Yap_growheap(FALSE, 0, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr); - return FALSE; + Yap_Error__(file, function, lineno, RESOURCE_ERROR_HEAP, ARG2, serr); + return false; } default: - Yap_Error(err, LOCAL_Error_Term, serr); - return (FALSE); + Yap_Error__(file, function, lineno, err, LOCAL_Error_Term, serr); + return false; } } @@ -361,7 +365,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, CELL nt[3]; Functor fun; bool serious; - Term tf, error_t, comment, culprit; + Term tf, error_t, comment, culprit = TermNil; char *format; char s[MAXPATHLEN]; @@ -527,6 +531,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, } if (type != ABORT_EVENT) { + Term location; + /* This is used by some complex procedures to detect there was an error */ if (IsAtomTerm(nt[0])) { strncpy(LOCAL_ErrorSay, (char *) RepAtom(AtomOfTerm(nt[0]))->StrOfAE, @@ -538,14 +544,14 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, MAX_ERROR_MSG_SIZE); LOCAL_ErrorMessage = LOCAL_ErrorSay; } + nt[1] = TermNil; switch (type) { case RESOURCE_ERROR_HEAP: case RESOURCE_ERROR_STACK: case RESOURCE_ERROR_TRAIL: comment = MkAtomTerm(Yap_LookupAtom(tmpbuf)); - default: - nt[1] = TermNil; - if (comment != TermNil) + default: + if (comment != TermNil) nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")), comment), nt[1]); if (file && function) { @@ -557,12 +563,12 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]); } - if ((culprit = Yap_pc_location(P, B, ENV)) != TermNil) { - nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), culprit), + if ((location = Yap_pc_location(P, B, ENV)) != TermNil) { + nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), location), nt[1]); } - if ((culprit = Yap_env_location(CP, B, ENV, 0)) != TermNil) { - nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), culprit), + if ((location = Yap_env_location(CP, B, ENV, 0)) != TermNil) { + nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), location), nt[1]); } } diff --git a/C/fail_absmi_insts.h b/C/fail_absmi_insts.h index b8c237f16..feaa5d081 100644 --- a/C/fail_absmi_insts.h +++ b/C/fail_absmi_insts.h @@ -133,7 +133,7 @@ #endif /* TABLING */ case _or_else: case _or_last: - low_level_trace(retry_or, (PredEntry *)ipc, &(B->cp_a1)); + low_level_trace(retry_or, NULL, NULL); break; case _retry2: case _retry3: diff --git a/C/flags.c b/C/flags.c index 4ccb29ce5..b2ba41153 100644 --- a/C/flags.c +++ b/C/flags.c @@ -29,7 +29,7 @@ static bool ro(Term inp); static bool nat(Term inp); static bool isatom(Term inp); -static bool boolean(Term inp); +static bool booleanFlag(Term inp); // static bool string( Term inp ); // static bool list_atom( Term inp ); static bool list_option(Term inp); @@ -1124,7 +1124,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, flag_term *tarr) { errno = 0; - if (f == boolean) { + if (f == booleanFlag) { if (!bootstrap) { return 0; } @@ -1266,7 +1266,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s, PAR("access", isaccess, PROLOG_FLAG_PROPERTY_ACCESS, "read_write"), \ PAR("type", isground, PROLOG_FLAG_PROPERTY_TYPE, "term"), \ PAR("scope", flagscope, PROLOG_FLAG_PROPERTY_SCOPE, "global"), \ - PAR("keep", boolean, PROLOG_FLAG_PROPERTY_KEEP, "false"), \ + PAR("keep", booleanFlag, PROLOG_FLAG_PROPERTY_KEEP, "false"), \ PAR(NULL, ok, PROLOG_FLAG_PROPERTY_END, 0) #define PAR(x, y, z, w) z @@ -1318,7 +1318,7 @@ do_prolog_flag_property(Term tflag, args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue); break; case PROLOG_FLAG_PROPERTY_TYPE: - if (fv->type == boolean) + if (fv->type == booleanFlag) rc = rc && Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue); else if (fv->type == isatom) @@ -1480,7 +1480,7 @@ static Int do_create_prolog_flag(USES_REGS1) { case PROLOG_FLAG_PROPERTY_TYPE: { Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue; if (ttype == TermBoolean) - fv->type = boolean; + fv->type = booleanFlag; else if (ttype == TermInteger) fv->type = isatom; else if (ttype == TermFloat) diff --git a/C/init.c b/C/init.c index 6a138a444..1a8e91246 100755 --- a/C/init.c +++ b/C/init.c @@ -947,8 +947,8 @@ static void InitStdPreds(void) { Yap_InitCPreds(); Yap_InitBackCPreds(); BACKUP_MACHINE_REGS(); - Yap_InitPlIO(); Yap_InitFlags(false); + Yap_InitPlIO(); #if HAVE_MPE Yap_InitMPE(); #endif @@ -1221,9 +1221,9 @@ void Yap_CloseScratchPad(void) { LOCAL_ScratchPad.msz = SCRATCH_START_SIZE; } -#include "heap/iglobals.h" +#include "iglobals.h" -#include "heap/ilocals.h" +#include "ilocals.h" #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) struct global_data *Yap_global; @@ -1247,7 +1247,7 @@ static void InitCodes(void) { Yap_local[wid] = NULL; } #endif -#include "heap/ihstruct.h" +#include "ihstruct.h" #if THREADS Yap_InitThread(0); #endif /* THREADS */ diff --git a/C/load_dll.c b/C/load_dll.c index 3e5f00e54..dbb232480 100755 --- a/C/load_dll.c +++ b/C/load_dll.c @@ -19,7 +19,7 @@ #include "yapio.h" #include "Foreign.h" -#if LOAD_DLL +#if _WIN32 #include @@ -101,7 +101,7 @@ LoadForeign(StringList ofiles, StringList libs, other routines */ while (libs) { HINSTANCE handle; - char * s = AtomName(libs->name); + const char * s = AtomName(libs->name); if (s[0] == '-') { strcat(LOCAL_FileNameBuf,s+2); diff --git a/C/mavar.c b/C/mavar.c index 899f19b4b..3ce613ba8 100644 --- a/C/mavar.c +++ b/C/mavar.c @@ -16,9 +16,13 @@ *************************************************************************/ -/** @defgroup Term_Modification Term Modification +/** + +@file mavar.c + +@defgroup Term_Modification Term Modification @ingroup builtins -@{ + It is sometimes useful to change the value of instantiated variables. Although, this is against the spirit of logic programming, it @@ -26,14 +30,14 @@ is sometimes useful. As in other Prolog systems, YAP has several primitives that allow updating Prolog terms. Note that these primitives are also backtrackable. -The `setarg/3` primitive allows updating any argument of a Prolog -compound terms. The `mutable` family of predicates provides -mutable variables. They should be used instead of `setarg/3`, +The setarg/3 primitive allows updating any argument of a Prolog +compound terms. The _mutable_ family of predicates provides +mutable variables. They should be used instead of setarg/3, as they allow the encapsulation of accesses to updatable variables. Their implementation can also be more efficient for long deterministic computations. - +@{ */ @@ -315,7 +319,6 @@ p_update_mutable( USES_REGS1 ) return(TRUE); } -static Int /** @pred is_mutable(? _D_) @@ -323,6 +326,7 @@ Holds if _D_ is a mutable term. */ +static Int p_is_mutable( USES_REGS1 ) { Term t = Deref(ARG1); diff --git a/C/modules.c b/C/modules.c index da5448cdf..94a177882 100644 --- a/C/modules.c +++ b/C/modules.c @@ -14,7 +14,7 @@ * comments: module support * * * *************************************************************************/ -#ifdef SCCS +#ifdef SCCSLookupSystemModule static char SccsId[] = "%W% %G%"; #endif @@ -26,9 +26,69 @@ static Int current_module(USES_REGS1); static Int current_module1(USES_REGS1); static ModEntry *LookupModule(Term a); static ModEntry *LookupSystemModule(Term a); +static ModEntry *GetModuleEntry(Atom at); +static ModEntry *FetchModuleEntry(Atom at); +/** + * initialize module data-structure + * + * @param to parent module (CurrentModule) + * @param ae module name. + * + * @return a new module structure + *//** */ +static ModEntry * +initMod( AtomEntry *toname, AtomEntry *ae) { + CACHE_REGS + ModEntry *n, *parent; + + if (toname == NULL) + parent = NULL; + else { + parent = FetchModuleEntry( toname ); + } + n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n)); + INIT_RWLOCK(n->ModRWLock); + n->KindOfPE = ModProperty; + n->PredForME = NULL; + n->NextME = CurrentModules; + CurrentModules = n; + n->AtomOfME = ae; + n->OwnerFile = Yap_ConsultingFile( PASS_REGS1); + AddPropToAtom(ae, (PropEntry *)n); + Yap_setModuleFlags(n, parent); + return n; +} + +/** + * get predicate entry for ap/arity; create it if neccessary + * + * @param[in] at + * + * @return module descriptorxs + */ + static ModEntry *GetModuleEntry(Atom at) +{ + Prop p0; + AtomEntry *ae = RepAtom(at); + + READ_LOCK(ae->ARWLock); + p0 = ae->PropsOfAE; + while (p0) { + ModEntry *me = RepModProp(p0); + if (me->KindOfPE == ModProperty) { + READ_UNLOCK(ae->ARWLock); + return me; + } + p0 = me->NextOfPE; + } + READ_UNLOCK(ae->ARWLock); + + return initMod( ( CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm( CurrentModule ) ), at ); +} + +/** get entry for ap/arity; assumes one is there. */ static ModEntry *FetchModuleEntry(Atom at) -/* get predicate entry for ap/arity; create it if neccessary. */ { Prop p0; AtomEntry *ae = RepAtom(at); @@ -47,40 +107,6 @@ static ModEntry *LookupSystemModule(Term a); return NULL; } -inline static ModEntry *GetModuleEntry(Atom at) -/* Get predicate entry for ap/arity; create it if necessary. */ -{ - Prop p0; - AtomEntry *ae = RepAtom(at); - ModEntry *new, *oat; - - p0 = ae->PropsOfAE; - while (p0) { - if (p0->KindOfPE == ModProperty) { - return RepModProp(p0); - } - p0 = p0->NextOfPE; - } - { - CACHE_REGS - new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new)); - INIT_RWLOCK(new->ModRWLock); - new->KindOfPE = ModProperty; - new->PredForME = NULL; - new->NextME = CurrentModules; - CurrentModules = new; - new->AtomOfME = ae; - new->OwnerFile = Yap_ConsultingFile( PASS_REGS1); - AddPropToAtom(ae, (PropEntry *)new); - if (CurrentModule == 0L || (oat = GetModuleEntry(AtomOfTerm(CurrentModule))) == new) { - Yap_setModuleFlags(new, NULL); - } else { - Yap_setModuleFlags(new, oat); - } - } - return new; -} - Term Yap_getUnknownModule(ModEntry *m) { if (m && m->flags & UNKNOWN_ERROR) { return TermError; @@ -109,21 +135,20 @@ bool Yap_getUnknown ( Term mod) { Term Yap_Module_Name(PredEntry *ap) { CACHE_REGS Term mod; + if (!ap) + return TermUser; if (!ap->ModuleOfPred) - /* If the system predicate is a metacall I should return the + /* If the system predicate is a meta-call I should return the module for the metacall, which I will suppose has to be reachable from the current module anyway. So I will return the current module in case the system predicate is a meta-call. Otherwise it will still work. */ - mod = CurrentModule; + return TermProlog; else { - mod = ap->ModuleOfPred; + return ap->ModuleOfPred; } - if (mod) - return mod; - return TermProlog; } @@ -135,13 +160,16 @@ static ModEntry *LookupSystemModule(Term a) { /* prolog module */ if (a == 0) { - return GetModuleEntry(AtomProlog); + a = TermProlog; } at = AtomOfTerm(a); me = GetModuleEntry(at); + if (!me) + return NULL; me->flags |= M_SYSTEM; me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 ); - return me;} + return me; +} static ModEntry *LookupModule(Term a) { @@ -201,7 +229,7 @@ void Yap_NewModulePred(Term mod, struct pred_entry *ap) { } static Int - current_module(USES_REGS1) { /* $current_module(Old,New) */ + current_module(USES_REGS1) { /* $current_module(Old,N) */ Term t; if (CurrentModule) { @@ -225,7 +253,7 @@ static Int return TRUE; } -static Int change_module(USES_REGS1) { /* $change_module(New) */ +static Int change_module(USES_REGS1) { /* $change_module(N) */ Term mod = Deref(ARG1); LookupModule(mod); CurrentModule = mod; @@ -347,8 +375,8 @@ static Int new_system_module( USES_REGS1 ) Yap_Error(TYPE_ERROR_ATOM, t, NULL); return false; } - me = LookupSystemModule( t ); - me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); + if ((me = LookupSystemModule( t ) )) + me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); return me != NULL; } diff --git a/C/or_absmi_insts.h b/C/or_absmi_insts.h index 9031bb8b0..b4b765c03 100644 --- a/C/or_absmi_insts.h +++ b/C/or_absmi_insts.h @@ -32,7 +32,7 @@ Op(either, Osblp); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - low_level_trace(try_or, (PredEntry *)PREG, NULL); + low_level_trace(try_or, PREG->y_u.Osblp.p0, NULL); } #endif #ifdef COROUTINING diff --git a/C/save.c b/C/save.c index db3ff53b9..3817a9504 100755 --- a/C/save.c +++ b/C/save.c @@ -19,7 +19,8 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90"; #endif -#include "config.h" +#include "absmi.h" +#include "alloc.h" #if _MSC_VER || defined(__MINGW32__) #if HAVE_WINSOCK2_H #include @@ -27,14 +28,12 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90"; #include #include #endif -#include "absmi.h" -#include "alloc.h" #if USE_DL_MALLOC #include "dlmalloc.h" #endif -#include "yapio.h" #include "YapText.h" #include "sshift.h" +#include "yapio.h" #include "Foreign.h" #if HAVE_STRING_H #include diff --git a/C/scanner.c b/C/scanner.c index b008a0295..a9c55faa0 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -151,7 +151,7 @@ double-quoting. The implementation of YAP represents strings as lists of integers. Since YAP 4.3.0 there is no static limit on string size. -Escape sequences can be used to include the non-printable characters +Escape sequences can be used anf include the non-printable characters `a` (alert), `b` (backspace), `r` (carriage return), `f` (form feed), `t` (horizontal tabulation), `n` (new line), and `v` (vertical tabulation). Escape sequences also be @@ -563,6 +563,46 @@ typedef struct scanner_extra_alloc { void *filler; } ScannerExtraBlock; +static TokEntry * +CodeSpaceError(TokEntry *t, TokEntry *p, TokEntry *l) +{ + LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; + LOCAL_ErrorMessage = "Code Space Overflow"; + if (t) { + t->Tok = eot_tok; + t->TokInfo = TermOutOfHeapError; + } + /* serious error now */ + return l; + } + +static TokEntry * +TrailSpaceError(TokEntry *t, TokEntry *l) +{ + LOCAL_ErrorMessage = "Trail Overflow"; + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; + if (t) { + t->Tok = eot_tok; + t->TokInfo = TermOutOfTrailError; + } + return l; +} + + static TokEntry * +AuxSpaceError(TokEntry *p, TokEntry *l, const char *msg) +{ + /* huge atom or variable, we are in trouble */ + LOCAL_ErrorMessage = (char *)msg; + LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; + Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); + if (p) { + p->Tok = eot_tok; + p->TokInfo = TermOutOfAuxspaceError; + } + /* serious error now */ + return l; +} + static void InitScannerMemory(void) { CACHE_REGS LOCAL_ErrorMessage = NULL; @@ -1160,7 +1200,8 @@ Term Yap_scan_num(StreamDesc *inp) { e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); e->TokPos = GetCurInpPos(inp); e->TokNext = ef; - ef->Tok = Ord(kind = eot_tok); + ef->Tok = Ord(kind = eot_tok); + ef->TokInfo = TermSyntaxError; ef->TokPos = GetCurInpPos(inp); ef->TokNext = NULL; LOCAL_tokptr = tokptr; @@ -1180,8 +1221,10 @@ Term Yap_scan_num(StreamDesc *inp) { LOCAL_ErrorMessage = "Stack Overflow"; \ LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \ LOCAL_Error_Size = 0L; \ - if (p) \ + if (p) { \ p->Tok = Ord(kind = eot_tok); \ + p->TokInfo = TermOutOfStackError; \ + } \ /* serious error now */ \ return l; \ } @@ -1199,8 +1242,6 @@ const char *Yap_tokRep(TokEntry *tokptr) { case Number_tok: if ((b = Yap_TermToString(info, buf, sze, &length, &LOCAL_encoding, flags)) != buf) { - if (b) - free(b); return NULL; } return buf; @@ -1370,12 +1411,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); t->TokNext = NULL; if (t == NULL) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - if (p) - p->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return TrailSpaceError(p, l); } if (!l) l = t; @@ -1428,6 +1464,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } else { t->Tok = Ord(kind = eot_tok); mark_eof(inp_stream); + t->TokInfo = TermEof; } break; @@ -1445,14 +1482,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, for (; chtype(ch) <= NU; ch = getchr(inp_stream)) { if (charp == (char *)AuxSp - 1024) { huge_var_error: + return AuxSpaceError(p, l, "Code Space Overflow due to huge atom"); /* huge atom or variable, we are in trouble */ - LOCAL_ErrorMessage = "Code Space Overflow due to huge atom"; - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); - if (p) - p->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; } add_ch_to_buff(ch); } @@ -1474,12 +1505,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, ae = Yap_LookupAtom(TokImage); } if (ae == NIL) { - LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - LOCAL_ErrorMessage = "Code Space Overflow"; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return CodeSpaceError(t, p, l); } t->TokInfo = Unsigned(ae); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); @@ -1504,18 +1530,15 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, cherr = 0; if (!(ptr = AllocScannerMemory(4096))) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; - } + return TrailSpaceError(t, l); + } CHECK_SPACE(); if ((t->TokInfo = get_num(&cha, &cherr, inp_stream, ptr, 4096, 1)) == 0L) { - if (p) - p->Tok = Ord(kind = eot_tok); + if (p) { + p->Tok = eot_tok; + t->TokInfo = TermError; + } /* serious error now */ return l; } @@ -1527,12 +1550,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t->TokPos = GetCurInpPos(inp_stream); e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); if (e == NULL) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - if (p) - p->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return TrailSpaceError(p, l); + } else { e->TokNext = NULL; } @@ -1556,12 +1575,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t->TokPos = GetCurInpPos(inp_stream); e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); if (e2 == NULL) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - if (p) - p->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return TrailSpaceError(p, l); } else { e2->TokNext = NULL; } @@ -1587,11 +1601,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t->TokPos = GetCurInpPos(inp_stream); e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); if (e2 == NULL) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return TrailSpaceError(p, l); } else { e2->TokNext = NULL; } @@ -1649,6 +1659,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); mark_eof(inp_stream); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermEof; break; } else { add_ch_to_buff(ch); @@ -1657,14 +1668,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, ++len; if (charp > (char *)AuxSp - 1024) { /* Not enough space to read in the string. */ - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - LOCAL_ErrorMessage = - "not enough space to read in string or quoted atom"; - /* serious error now */ - Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); - t->Tok = Ord(kind = eot_tok); - return l; - } + return AuxSpaceError(t, l, "not enough space to read in string or quoted atom"); + } } if (wcharp) { *wcharp = '\0'; @@ -1682,6 +1687,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, "not enough heap space to read in string or quoted atom"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermOutOfHeapError; return l; } if (wcharp) { @@ -1711,13 +1717,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, t->TokInfo = Unsigned(Yap_LookupAtom(TokImage)); } if (!(t->TokInfo)) { - LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - LOCAL_ErrorMessage = "Code Space Overflow"; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; - } + return CodeSpaceError(t, p, l); + } Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = Name_tok); if (ch == '(') @@ -1728,6 +1729,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, case BS: if (ch == '\0') { t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermEof; return l; } else ch = getchr(inp_stream); @@ -1740,8 +1742,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, if (och == '.') { if (chtype(ch) == BS || chtype(ch) == EF || ch == '%') { t->Tok = Ord(kind = eot_tok); - if (chtype(ch) == EF) + if (chtype(ch) == EF) { mark_eof(inp_stream); + t->TokInfo = TermEof; + } else { + t->TokInfo = TermNewLine; + } return l; } } @@ -1768,6 +1774,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } if (chtype(ch) == EF) { t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermEof; break; } else { /* leave comments */ @@ -1787,8 +1794,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, enter_symbol: if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) { t->Tok = Ord(kind = eot_tok); - if (chtype(ch) == EF) + if (chtype(ch) == EF) { mark_eof(inp_stream); + t->TokInfo = TermEof; + } else { + t->TokInfo = TermNl; + } return l; } else { Atom ae; @@ -1810,22 +1821,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, ae = Yap_LookupAtom(TokImage); } if (ae == NIL) { - LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - LOCAL_ErrorMessage = "Code Space Overflow"; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; - } + return CodeSpaceError(t, p, l); + } t->TokInfo = Unsigned(ae); if (t->TokInfo == (CELL)NIL) { - LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - LOCAL_ErrorMessage = "Code Space Overflow"; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; - } + return CodeSpaceError(t, p, l); + } Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = Name_tok); if (ch == '(') @@ -1882,12 +1883,14 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, LOCAL_ErrorMessage = "not enough heap space to read in quasi quote"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermOutOfHeapError; return l; } if (cur_qq) { LOCAL_ErrorMessage = "quasi quote in quasi quote"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermOutOfHeapError; free(qq); return l; } else { @@ -1925,6 +1928,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, free(cur_qq); cur_qq = NULL; t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermError; return l; } cur_qq = NULL; @@ -1946,6 +1950,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, "not enough heap space to read in a quasi quoted atom"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermError; return l; } charp = TokImage; @@ -1968,6 +1973,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); mark_eof(inp_stream); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermOutOfHeapError; break; } else { charp = (char *)put_utf8((unsigned char *)charp, ch); @@ -1975,13 +1981,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } if (charp > (char *)AuxSp - 1024) { /* Not enough space to read in the string. */ - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - LOCAL_ErrorMessage = - "not enough space to read in string or quoted atom"; - /* serious error now */ - Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); - t->Tok = Ord(kind = eot_tok); - return l; + return AuxSpaceError(t, l, "not enough space to read in string or quoted atom"); } } len = charp - TokImage; @@ -1990,6 +1990,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, LOCAL_ErrorMessage = "not enough heap space to read in quasi quote"; Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermOutOfHeapError; return l; } strncpy(mp, TokImage, len + 1); @@ -2004,12 +2005,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, qq->end.linepos = inp_stream->linepos - 1; qq->end.charno = inp_stream->charcount - 1; if (!(t->TokInfo)) { - LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - LOCAL_ErrorMessage = "Code Space Overflow"; - if (p) - t->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; + return CodeSpaceError(t, p, l); } Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); solo_flag = FALSE; @@ -2021,13 +2017,19 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, case EF: mark_eof(inp_stream); t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermEof; return l; default: + { + char err[1024]; + snprintf( err, 1023, "\n++++ token: unrecognised char %c (%d), type %c\n", ch, ch, chtype(ch) ); #if DEBUG - fprintf(stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch)); + fprintf(stderr, "%s", err); #endif + } t->Tok = Ord(kind = eot_tok); + t->TokInfo = TermEof; } #if DEBUG if (GLOBAL_Option[2]) @@ -2037,12 +2039,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, /* insert an error token to inform the system of what happened */ TokEntry *e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry)); if (e == NULL) { - LOCAL_ErrorMessage = "Trail Overflow"; - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - p->Tok = Ord(kind = eot_tok); - /* serious error now */ - return l; - } + return TrailSpaceError(p, l); + } p->TokNext = e; e->Tok = Error_tok; e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage)); diff --git a/C/stack.c b/C/stack.c index 88e99f2cc..67b0539fa 100644 --- a/C/stack.c +++ b/C/stack.c @@ -1924,6 +1924,8 @@ static Term build_bug_location(yamop *codeptr, PredEntry *pe) { } else p[4] = MkIntTerm(0); } + } else { + p[4] = MkIntTerm(0); } } } else if (pe->OpcodeOfPred == UNDEF_OPCODE) { diff --git a/C/stdpreds.c b/C/stdpreds.c index 841dbe14f..88ca4fc49 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -13,255 +13,7 @@ * comments: General-purpose C implemented system predicates * * * * Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ -** -* $Log: not supported by cvs2svn $ -* Revision 1.131 2008/06/12 10:55:52 vsc -* fix syntax error messages -* -* Revision 1.130 2008/04/06 11:53:02 vsc -* fix some restore bugs -* -* Revision 1.129 2008/03/15 12:19:33 vsc -* fix flags -* -* Revision 1.128 2008/02/15 12:41:33 vsc -* more fixes to modules -* -* Revision 1.127 2008/02/13 10:15:35 vsc -* fix some bugs from yesterday plus improve support for modules in -* operators. -* -* Revision 1.126 2008/02/07 23:09:13 vsc -* don't break ISO standard in current_predicate/1. -* Include Nicos flag. -* -* Revision 1.125 2008/01/23 17:57:53 vsc -* valgrind it! -* enable atom garbage collection. -* -* Revision 1.124 2007/11/26 23:43:08 vsc -* fixes to support threads and assert correctly, even if inefficiently. -* -* Revision 1.123 2007/11/06 17:02:12 vsc -* compile ground terms away. -* -* Revision 1.122 2007/10/18 08:24:16 vsc -* fix global variables -* -* Revision 1.121 2007/10/10 09:44:24 vsc -* some more fixes to make YAP swi compatible -* fix absolute_file_name (again) -* fix setarg -* -* Revision 1.120 2007/10/08 23:02:15 vsc -* minor fixes -* -* Revision 1.119 2007/04/18 23:01:16 vsc -* fix deadlock when trying to create a module with the same name as a -* predicate (for now, just don't lock modules). obs Paulo Moura. -* -* Revision 1.118 2007/02/26 10:41:40 vsc -* fix prolog_flags for chr. -* -* Revision 1.117 2007/01/28 14:26:37 vsc -* WIN32 support -* -* Revision 1.116 2006/12/13 16:10:23 vsc -* several debugger and CLP(BN) improvements. -* -* Revision 1.115 2006/11/28 13:46:41 vsc -* fix wide_char support for name/2. -* -* Revision 1.114 2006/11/27 17:42:03 vsc -* support for UNICODE, and other bug fixes. -* -* Revision 1.113 2006/11/16 14:26:00 vsc -* fix handling of infinity in name/2 and friends. -* -* Revision 1.112 2006/11/08 01:56:47 vsc -* fix argument order in db statistics. -* -* Revision 1.111 2006/11/06 18:35:04 vsc -* 1estranha -* -* Revision 1.110 2006/10/10 14:08:17 vsc -* small fixes on threaded implementation. -* -* Revision 1.109 2006/09/15 19:32:47 vsc -* ichanges for QSAR -* -* Revision 1.108 2006/09/01 20:14:42 vsc -* more fixes for global data-structures. -* statistics on atom space. -* -* Revision 1.107 2006/08/22 16:12:46 vsc -* global variables -* -* Revision 1.106 2006/08/07 18:51:44 vsc -* fix garbage collector not to try to garbage collect when we ask for large -* chunks of stack in a single go. -* -* Revision 1.105 2006/06/05 19:36:00 vsc -* hacks -* -* Revision 1.104 2006/05/19 14:31:32 vsc -* get rid of IntArrays and FloatArray code. -* include holes when calculating memory usage. -* -* Revision 1.103 2006/05/18 16:33:05 vsc -* fix info reported by memory manager under DL_MALLOC and SYSTEM_MALLOC -* -* Revision 1.102 2006/04/28 17:53:44 vsc -* fix the expand_consult patch -* -* Revision 1.101 2006/04/28 13:23:23 vsc -* fix number of overflow bugs affecting threaded version -* make current_op faster. -* -* Revision 1.100 2006/02/05 02:26:35 tiagosoares -* MYDDAS: Top Level Functionality -* -* Revision 1.99 2006/02/05 02:17:54 tiagosoares -* MYDDAS: Top Level Functionality -* -* Revision 1.98 2005/12/17 03:25:39 vsc -* major changes to support online event-based profiling -* improve error discovery and restart on scanner. -* -* Revision 1.97 2005/11/22 11:25:59 tiagosoares -* support for the MyDDAS interface library -* -* Revision 1.96 2005/10/28 17:38:49 vsc -* sveral updates -* -* Revision 1.95 2005/10/21 16:09:02 vsc -* SWI compatible module only operators -* -* Revision 1.94 2005/09/08 22:06:45 rslopes -* BEAM for YAP update... -* -* Revision 1.93 2005/08/04 15:45:53 ricroc -* TABLING NEW: support to limit the table space size -* -* Revision 1.92 2005/07/20 13:54:27 rslopes -* solved warning: cast from pointer to integer of different size -* -* Revision 1.91 2005/07/06 19:33:54 ricroc -* TABLING: answers for completed calls can now be obtained by loading (new -*option) or executing (default) them from the trie data structure. -* -* Revision 1.90 2005/07/06 15:10:14 vsc -* improvements to compiler: merged instructions and fixes for -> -* -* Revision 1.89 2005/05/26 18:01:11 rslopes -* *** empty log message *** -* -* Revision 1.88 2005/04/27 20:09:25 vsc -* indexing code could get confused with suspension points -* some further improvements on oveflow handling -* fix paths in Java makefile -* changs to support gibbs sampling in CLP(BN) -* -* Revision 1.87 2005/04/07 17:48:55 ricroc -* Adding tabling support for mixed strategy evaluation (batched and local -*scheduling) -* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -*-DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the -*Makefile or --enable-tabling in configure. -* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all -*tabled predicates to MODE (batched, local or default). -* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of -*predicate PRED to MODE (batched or local). -* -* Revision 1.86 2005/03/13 06:26:11 vsc -* fix excessive pruning in meta-calls -* fix Term->int breakage in compiler -* improve JPL (at least it does something now for amd64). -* -* Revision 1.85 2005/03/02 19:48:02 vsc -* Fix some possible errors in name/2 and friends, and cleanup code a bit -* YAP_Error changed. -* -* Revision 1.84 2005/03/02 18:35:46 vsc -* try to make initialization process more robust -* try to make name more robust (in case Lookup new atom fails) -* -* Revision 1.83 2005/03/01 22:25:09 vsc -* fix pruning bug -* make DL_MALLOC less enthusiastic about walking through buckets. -* -* Revision 1.82 2005/02/21 16:50:04 vsc -* amd64 fixes -* library fixes -* -* Revision 1.81 2005/02/08 04:05:35 vsc -* fix mess with add clause -* improves on sigsegv handling -* -* Revision 1.80 2005/01/05 05:32:37 vsc -* Ricardo's latest version of profiler. -* -* Revision 1.79 2004/12/28 22:20:36 vsc -* some extra bug fixes for trail overflows: some cannot be recovered that -*easily, -* some can. -* -* Revision 1.78 2004/12/08 04:45:03 vsc -* polish changes to undefp -* get rid of a few warnings -* -* Revision 1.77 2004/12/05 05:07:26 vsc -* name/2 should accept [] as a valid list (string) -* -* Revision 1.76 2004/12/05 05:01:25 vsc -* try to reduce overheads when running with goal expansion enabled. -* CLPBN fixes -* Handle overflows when allocating big clauses properly. -* -* Revision 1.75 2004/12/02 06:06:46 vsc -* fix threads so that they at least start -* allow error handling to work with threads -* replace heap_base by Yap_heap_base, according to Yap's convention for globals. -* -* Revision 1.74 2004/11/19 22:08:43 vsc -* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever -*appropriate. -* -* Revision 1.73 2004/11/19 17:14:14 vsc -* a few fixes for 64 bit compiling. -* -* Revision 1.72 2004/11/18 22:32:37 vsc -* fix situation where we might assume nonextsing double initialization of C -*predicates (use -* Hidden Pred Flag). -* $host_type was double initialized. -* -* Revision 1.71 2004/07/23 21:08:44 vsc -* windows fixes -* -* Revision 1.70 2004/06/29 19:04:42 vsc -* fix multithreaded version -* include new version of Ricardo's profiler -* new predicat atomic_concat -* allow multithreaded-debugging -* small fixes -* -* Revision 1.69 2004/06/16 14:12:53 vsc -* miscellaneous fixes -* -* Revision 1.68 2004/05/14 17:11:30 vsc -* support BigNums in interface -* -* Revision 1.67 2004/05/14 16:33:45 vsc -* add Yap_ReadBuffer -* -* Revision 1.66 2004/05/13 20:54:58 vsc -* debugger fixes -* make sure we always go back to current module, even during initizlization. -* -* Revision 1.65 2004/04/27 15:14:36 vsc -* fix halt/0 and halt/1 -* * +* * * * *************************************************************************/ #ifdef SCCS @@ -1008,12 +760,14 @@ static PredEntry *firstModulesPred(PredEntry *npp, ModEntry *m, Term task) { static Int cont_current_predicate(USES_REGS1) { UInt Arity; Term name, task; - Term t1 = ARG1, t2 = ARG2, t3 = ARG3; + Term t1 = ARG1, t2 = Deref(ARG2), t3 = ARG3; bool rc, will_cut = false; Functor f; PredEntry *pp; t1 = Yap_YapStripModule(t1, &t2); t3 = Yap_YapStripModule(t3, &t2); + t1 = Deref(t1); + t2 = Deref(t2); task = Deref(ARG4); pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); @@ -1102,17 +856,34 @@ static Int cont_current_predicate(USES_REGS1) { if (!pp) { if (!IsAtomTerm(t2)) { - Yap_Error(TYPE_ERROR_ATOM, t2, "current_predicate/2"); + Yap_Error(TYPE_ERROR_ATOM, t2, "module name"); } ModEntry *m = Yap_GetModuleEntry(t2); pp = firstModulePred(m->PredForME, task); - if (!pp) - cut_fail(); + if (!pp) { + /* try Prolog Module */ + if (task != TermUser) { + ModEntry *m = Yap_GetModuleEntry(TermProlog); + pp = firstModulePred(m->PredForME, task); + if (!pp) { + cut_fail(); + } + } + } } npp = firstModulePred(pp, task); - if (!npp) - will_cut = true; + if (!npp) { + if (pp->ModuleOfPred != PROLOG_MODULE && + task != TermUser) { + ModEntry *m = Yap_GetModuleEntry(TermProlog); + npp = firstModulePred(m->PredForME, task); + if (!npp) + will_cut = true; + } else { + will_cut = true; + } + } // just try next one else { EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp); @@ -1164,11 +935,13 @@ static Int cont_current_predicate(USES_REGS1) { } } if (Arity) { - rc = Yap_unify(t3, Yap_MkNewApplTerm(f, Arity)); + rc = Yap_unify(ARG3, Yap_MkNewApplTerm(f, Arity)); } else { - rc = Yap_unify(t3, name); + rc = Yap_unify(ARG3, name); } - rc = rc && Yap_unify(t2, ModToTerm(pp->ModuleOfPred)) && Yap_unify(t1, name); + rc = rc && (IsAtomTerm(t2) || + Yap_unify(ARG2, ModToTerm(pp->ModuleOfPred))) + && Yap_unify(ARG1, name); if (will_cut) { if (rc) cut_succeed(); diff --git a/C/tracer.c b/C/tracer.c index a599bfd1a..77c5d0f12 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -137,8 +137,8 @@ check_area(void) } */ -PredEntry *old_p[10000]; -Term old_x1[10000], old_x2[10000], old_x3[10000]; +//PredEntry *old_p[10000]; +//Term old_x1[10000], old_x2[10000], old_x3[10000]; // static CELL oldv; @@ -329,18 +329,23 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) { UNLOCK(Yap_low_level_trace_lock); return; } - if (pred->ModuleOfPred == 0 && !LOCAL_do_trace_primitives) { - UNLOCK(Yap_low_level_trace_lock); - return; + if (pred->ModuleOfPred == PROLOG_MODULE) { + if (!LOCAL_do_trace_primitives) { + UNLOCK(Yap_low_level_trace_lock); + return; + } + mname = "prolog"; + } else { + mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; } switch (port) { case enter_pred: - mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; arity = pred->ArityOfPE; - if (arity == 0) + if (arity == 0) { s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; - else + } else { s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE; + } /* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) return; */ send_tracer_message("CALL: ", s, arity, mname, args); diff --git a/C/yap-args.c b/C/yap-args.c index b367159f7..59a54d4ef 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -19,6 +19,7 @@ #include "config.h" #include "Yap.h" #include "YapHeap.h" +#include "YapInterface.h" #if HAVE_UNISTD_H #include #endif @@ -28,8 +29,8 @@ #include #include #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ -#ifdef HAVE_UNISTD_H -#undef HAVE_UNISTD_H +#ifdef HAVE_UNISTD_H +#undef HAVE_UNISTD_H #endif #endif @@ -44,78 +45,77 @@ #include #endif -void YAP_SetOutputMessage(void); -int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap); - #if (DefTrailSpace < MinTrailSpace) #undef DefTrailSpace -#define DefTrailSpace MinTrailSpace +#define DefTrailSpace MinTrailSpace #endif #if (DefStackSpace < MinStackSpace) #undef DefStackSpace -#define DefStackSpace MinStackSpace +#define DefStackSpace MinStackSpace #endif #if (DefHeapSpace < MinHeapSpace) #undef DefHeapSpace -#define DefHeapSpace MinHeapSpace +#define DefHeapSpace MinHeapSpace #endif -#define DEFAULT_NUMBERWORKERS 1 -#define DEFAULT_SCHEDULERLOOP 10 -#define DEFAULT_DELAYEDRELEASELOAD 3 +#define DEFAULT_NUMBERWORKERS 1 +#define DEFAULT_SCHEDULERLOOP 10 +#define DEFAULT_DELAYEDRELEASELOAD 3 -static void -print_usage(void) -{ - fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n"); - fprintf(stderr," -? Shows this screen\n"); - fprintf(stderr," -b Boot file \n"); - fprintf(stderr," -dump-runtime-variables\n"); - fprintf(stderr," -f initialization file or \"none\"\n"); - fprintf(stderr," -g Run Goal Before Top-Level \n"); - fprintf(stderr," -z Run Goal Before Top-Level \n"); - fprintf(stderr," -q start with informational messages off\n"); - fprintf(stderr," -l load Prolog file\n"); - fprintf(stderr," -L run Prolog file and exit\n"); - fprintf(stderr," -p extra path for file-search-path\n"); - fprintf(stderr," -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", - DefHeapSpace, MinHeapSpace); - fprintf(stderr," -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", - DefStackSpace, MinStackSpace); - fprintf(stderr," -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", - DefTrailSpace, MinTrailSpace); - 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"); - fprintf(stderr," -J2 Mixed mode for all predicates\n"); - fprintf(stderr," -J3 Compile all user predicates\n"); - fprintf(stderr," -J4 Compile all predicates\n"); +static void print_usage(void) { + fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n"); + fprintf(stderr, " -? Shows this screen\n"); + fprintf(stderr, " -b Boot file \n"); + fprintf(stderr, " -dump-runtime-variables\n"); + fprintf(stderr, " -f initialization file or \"none\"\n"); + fprintf(stderr, " -g Run Goal Before Top-Level \n"); + fprintf(stderr, " -z Run Goal Before Top-Level \n"); + fprintf(stderr, " -q start with informational messages off\n"); + fprintf(stderr, " -l load Prolog file\n"); + fprintf(stderr, " -L run Prolog file and exit\n"); + fprintf(stderr, " -p extra path for file-search-path\n"); + fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", + DefHeapSpace, MinHeapSpace); + fprintf(stderr, + " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", + DefStackSpace, MinStackSpace); + fprintf(stderr, + " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", + DefTrailSpace, MinTrailSpace); + 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"); + fprintf(stderr, " -J2 Mixed mode for all predicates\n"); + fprintf(stderr, " -J3 Compile all user predicates\n"); + fprintf(stderr, " -J4 Compile all predicates\n"); #ifdef TABLING - fprintf(stderr," -ts Maximum table space area in Mbytes (default: unlimited)\n"); + fprintf(stderr, + " -ts Maximum table space area in Mbytes (default: unlimited)\n"); #endif /* TABLING */ -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) - fprintf(stderr," -w Number of workers (default: %d)\n", - DEFAULT_NUMBERWORKERS); - fprintf(stderr," -sl Loop scheduler executions before look for hiden shared work (default: %d)\n", +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + fprintf(stderr, " -w Number of workers (default: %d)\n", + DEFAULT_NUMBERWORKERS); + fprintf(stderr, " -sl Loop scheduler executions before look for hiden " + "shared work (default: %d)\n", DEFAULT_SCHEDULERLOOP); - fprintf(stderr," -d Value of delayed release of load (default: %d)\n", - DEFAULT_DELAYEDRELEASELOAD); + fprintf(stderr, " -d Value of delayed release of load (default: %d)\n", + DEFAULT_DELAYEDRELEASELOAD); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - /* nf: Preprocessor */ + /* nf: Preprocessor */ /* fprintf(stderr," -DVar=Name Persistent definition\n"); */ - fprintf(stderr,"\n"); + fprintf(stderr, "\n"); } -static int -myisblank(int c) -{ +static int myisblank(int c) { switch (c) { case ' ': case '\t': @@ -127,47 +127,34 @@ myisblank(int c) } } -static char * -add_end_dot(char arg[]) -{ +static char *add_end_dot(char arg[]) { int sz = strlen(arg), i; i = sz; - while (i && myisblank(arg[--i])); + while (i && myisblank(arg[--i])) + ; if (i && arg[i] != ',') { - char *p = (char *)malloc(sz+2); + char *p = (char *)malloc(sz + 2); if (!p) return NULL; - strncpy(p,arg,sz); + strncpy(p, arg, sz); p[sz] = '.'; - p[sz+1] = '\0'; + p[sz + 1] = '\0'; return p; } return arg; } -static int -dump_runtime_variables(void) -{ - fprintf(stdout,"CC=\"%s\"\n",C_CC); - fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR); - fprintf(stdout,"YAP_LIBS=\"%s\"\n",C_LIBS); - fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",SO_EXT); - fprintf(stdout,"YAP_VERSION=%s\n",YAP_NUMERIC_VERSION); +static int dump_runtime_variables(void) { + fprintf(stdout, "CC=\"%s\"\n", C_CC); + fprintf(stdout, "YAP_ROOTDIR=\"%s\"\n", YAP_ROOTDIR); + fprintf(stdout, "YAP_LIBS=\"%s\"\n", C_LIBS); + fprintf(stdout, "YAP_SHLIB_SUFFIX=\"%s\"\n", SO_EXT); + fprintf(stdout, "YAP_VERSION=%s\n", YAP_NUMERIC_VERSION); exit(0); return 1; } -/* - * proccess command line arguments: valid switches are: -b boot -s - * stack area size (K) -h heap area size -a aux stack size -e - * emacs_mode -m -DVar=Value reserved memory for alloc IF DEBUG -p if you - * want to check out startup IF MAC -mpw if we are using the mpw - * shell - */ - -int -YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) -{ +X_API int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) { char *p; int BootMode = YAP_BOOT_FROM_SAVED_CODE; unsigned long int *ssize; @@ -204,359 +191,372 @@ YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) iap->ErrorCause = NULL; iap->QuietMode = FALSE; - while (--argc > 0) - { - p = *++argv; - if (*p == '-') - switch (*++p) - { - case 'b': - BootMode = YAP_BOOT_FROM_PROLOG; - iap->YapPrologBootFile = *++argv; - argc--; - break; - case '?': - print_usage(); - exit(EXIT_SUCCESS); - case 'q': - iap->QuietMode = TRUE; - break; -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) - case 'w': - ssize = &(iap->NumberWorkers); - goto GetSize; - case 'd': - if (!strcmp("dump-runtime-variables",p)) - return dump_runtime_variables(); - ssize = &(iap->DelayedReleaseLoad); - goto GetSize; + while (--argc > 0) { + p = *++argv; + if (*p == '-') + switch (*++p) { + case 'b': + BootMode = YAP_BOOT_FROM_PROLOG; + iap->YapPrologBootFile = *++argv; + argc--; + break; + case '?': + print_usage(); + exit(EXIT_SUCCESS); + case 'q': + iap->QuietMode = TRUE; + break; +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + case 'w': + ssize = &(iap->NumberWorkers); + goto GetSize; + case 'd': + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); + ssize = &(iap->DelayedReleaseLoad); + goto GetSize; #else - case 'd': - if (!strcmp("dump-runtime-variables",p)) - return dump_runtime_variables(); + case 'd': + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - case 'F': - /* just ignore for now */ - argc--; - argv++; - break; - case 'f': - iap->FastBoot = TRUE; - if (argc > 1 && argv[1][0] != '-') { - argc--; - argv++; - if (strcmp(*argv,"none")) { - iap->YapPrologRCFile = *argv; - } - break; - } - break; - // execution mode - case 'J': - switch (p[1]) { - case '0': - iap->ExecutionMode = YAPC_INTERPRETED; - break; - case '1': - iap->ExecutionMode = YAPC_MIXED_MODE_USER; - break; - case '2': - iap->ExecutionMode = YAPC_MIXED_MODE_ALL; - break; - case '3': - iap->ExecutionMode = YAPC_COMPILE_USER; - break; - case '4': - iap->ExecutionMode = YAPC_COMPILE_ALL; - break; - default: - fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c%c ]\n", *p, p[1]); - exit(EXIT_FAILURE); - } - p++; - break; - case 'G': - ssize = &(iap->MaxGlobalSize); - goto GetSize; - break; - case 's': - case 'S': - ssize = &(iap->StackSize); -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS) - if (p[1] == 'l') { - p++; - ssize = &(iap->SchedulerLoop); - } + case 'F': + /* just ignore for now */ + argc--; + argv++; + break; + case 'f': + iap->FastBoot = TRUE; + if (argc > 1 && argv[1][0] != '-') { + argc--; + argv++; + if (strcmp(*argv, "none")) { + iap->YapPrologRCFile = *argv; + } + break; + } + break; + // execution mode + case 'J': + switch (p[1]) { + case '0': + iap->ExecutionMode = YAPC_INTERPRETED; + break; + case '1': + iap->ExecutionMode = YAPC_MIXED_MODE_USER; + break; + case '2': + iap->ExecutionMode = YAPC_MIXED_MODE_ALL; + break; + case '3': + iap->ExecutionMode = YAPC_COMPILE_USER; + break; + case '4': + iap->ExecutionMode = YAPC_COMPILE_ALL; + break; + default: + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", + *p, p[1]); + exit(EXIT_FAILURE); + } + p++; + break; + case 'G': + ssize = &(iap->MaxGlobalSize); + goto GetSize; + break; + case 's': + case 'S': + ssize = &(iap->StackSize); +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + if (p[1] == 'l') { + p++; + ssize = &(iap->SchedulerLoop); + } #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - goto GetSize; - case 'a': - case 'A': - ssize = &(iap->AttsSize); - goto GetSize; - case 'T': - ssize = &(iap->MaxTrailSize); - goto get_trail_size; - case 't': - ssize = &(iap->TrailSize); + goto GetSize; + case 'a': + case 'A': + ssize = &(iap->AttsSize); + goto GetSize; + case 'T': + ssize = &(iap->MaxTrailSize); + goto get_trail_size; + case 't': + ssize = &(iap->TrailSize); #ifdef TABLING - if (p[1] == 's') { - p++; - ssize = &(iap->MaxTableSpaceSize); - } + if (p[1] == 's') { + p++; + ssize = &(iap->MaxTableSpaceSize); + } #endif /* TABLING */ - get_trail_size: - if (*++p == '\0') - { - if (argc > 1) - --argc, p = *++argv; - else - { - fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch(ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - i *= 1024*1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - iap->YapPrologTopLevelGoal = add_end_dot(*argv); - } else { - *ssize = i; - } - } - break; - case 'h': - case 'H': - ssize = &(iap->HeapSize); - GetSize: - if (*++p == '\0') - { - if (argc > 1) - --argc, p = *++argv; - else - { - fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch(ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - case 'G': - i *= 1024*1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) - { - fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]); - Yap_exit(1); - } - *ssize = i; - } - break; -#ifdef DEBUG - case 'P': - YAP_SetOutputMessage(); - if (p[1] != '\0') { - while (p[1] != '\0') { - int ch = p[1]; - if (ch >= 'A' && ch <= 'Z') - ch += ('a'-'A'); - if (ch >= 'a' && ch <= 'z') - GLOBAL_Option[ch - 96] = 1; - } - } - break; -#endif - case 'L': - if (p[1] && p[1] >= '0' && p[1] <= '9') /* hack to emulate SWI's L local option */ - { - ssize = &(iap->MaxStackSize); - goto GetSize; - } - iap->QuietMode = TRUE; - iap->HaltAfterConsult = TRUE; - case 'l': - p++; - if (!*++argv) { - fprintf(stderr,"%% YAP unrecoverable error: missing load file name\n"); - exit(1); - } else if (!strcmp("--",*argv)) { - /* shell script, the next entry should be the file itself */ - iap->YapPrologRCFile = argv[1]; - argc = 1; - break; - } else { - iap->YapPrologRCFile = *argv; - argc--; - } - if (*p) { - /* we have something, usually, of the form: - -L -- - FileName - ExtraArgs - */ - /* being called from a script */ - while (*p && (*p == ' ' || *p == '\t')) - p++; - if (p[0] == '-' && p[1] == '-') { - /* ignore what is next */ - argc = 1; - } - } - break; - /* run goal before top-level */ - case 'g': - if ((*argv)[0] == '\0') - iap->YapPrologGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr," [ YAP unrecoverable error: missing initialization goal for option 'g' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologGoal = *argv; - } - break; - /* run goal as top-level */ - case 'z': - if ((*argv)[0] == '\0') - iap->YapPrologTopLevelGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr," [ YAP unrecoverable error: missing goal for option 'z' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologTopLevelGoal = add_end_dot(*argv); - } - break; - case 'n': - if (!strcmp("nosignals", p)) { - iap->PrologShouldHandleInterrupts = FALSE; - break; - } - break; - case '-': - if (!strcmp("-nosignals", p)) { - iap->PrologShouldHandleInterrupts = FALSE; - break; - } else if (!strncmp("-home=",p,strlen("-home="))) { - GLOBAL_Home = p+strlen("-home="); - } else if (!strncmp("-cwd=",p,strlen("-cwd="))) { -#if __WINDOWS__ - if (_chdir( p+strlen("-cwd=") ) < 0) { -#else - if (chdir( p+strlen("-cwd=") ) < 0) { -#endif - fprintf(stderr," [ YAP unrecoverable error in setting cwd: %s ]\n", strerror(errno)); - } - } else if (!strncmp("-stack=",p,strlen("-stack="))) { - ssize = &(iap->StackSize); - p+=strlen("-stack="); - goto GetSize; - } else if (!strncmp("-trail=",p,strlen("-trail="))) { - ssize = &(iap->TrailSize); - p+=strlen("-trail="); - goto GetSize; - } else if (!strncmp("-heap=",p,strlen("-heap="))) { - ssize = &(iap->HeapSize); - p+=strlen("-heap="); - goto GetSize; - } else if (!strncmp("-goal=",p,strlen("-goal="))) { - iap->YapPrologGoal = p+strlen("-goal="); - } else if (!strncmp("-top-level=",p,strlen("-top-level="))) { - iap->YapPrologTopLevelGoal = p+strlen("-top-level="); - } else if (!strncmp("-table=",p,strlen("-table="))) { - ssize = &(iap->MaxTableSpaceSize); - p +=strlen( "-table="); - goto GetSize; - } else if (!strncmp("-",p,strlen("-="))) { - ssize = &(iap->MaxTableSpaceSize); - p +=strlen( "-table="); - /* skip remaining arguments */ - argc = 1; - } + get_trail_size: + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; break; - case 'p': - if ((*argv)[0] == '\0') - iap->YapPrologAddPath = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr," [ YAP unrecoverable error: missing paths for option 'p' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologAddPath = *argv; - } - break; - /* nf: Begin preprocessor code */ - case 'D': - { - char *var, *value; - ++p; - var = p; - if (var == NULL || *var=='\0') - break; - while(*p!='=' && *p!='\0') ++p; - if ( *p=='\0' ) break; - *p='\0'; - ++p; - value=p; - if ( *value == '\0' ) break; - if (iap->def_c == YAP_MAX_YPP_DEFS) - break; - iap->def_var[iap->def_c]=var; - iap->def_value[iap->def_c]=value; - ++(iap->def_c); - break; - } - /* End preprocessor code */ - default: - { - fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p); - print_usage(); - exit(EXIT_FAILURE); - } - } - else { - iap->SavedState = p; + case 'g': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + iap->YapPrologTopLevelGoal = add_end_dot(*argv); + } else { + *ssize = i; + } + } + break; + case 'h': + case 'H': + ssize = &(iap->HeapSize); + GetSize: + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + case 'G': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + fprintf( + stderr, + "[ YAP unrecoverable error: illegal size specification %s ]", + argv[-1]); + Yap_exit(1); + } + *ssize = i; + } + break; +#ifdef DEBUG + case 'P': + YAP_SetOutputMessage(); + if (p[1] != '\0') { + while (p[1] != '\0') { + int ch = p[1]; + if (ch >= 'A' && ch <= 'Z') + ch += ('a' - 'A'); + if (ch >= 'a' && ch <= 'z') + GLOBAL_Option[ch - 96] = 1; + } + } + break; +#endif + case 'L': + if (p[1] && p[1] >= '0' && + p[1] <= '9') /* hack to emulate SWI's L local option */ + { + ssize = &(iap->MaxStackSize); + goto GetSize; + } + iap->QuietMode = TRUE; + iap->HaltAfterConsult = TRUE; + case 'l': + p++; + if (!*++argv) { + fprintf(stderr, + "%% YAP unrecoverable error: missing load file name\n"); + exit(1); + } else if (!strcmp("--", *argv)) { + /* shell script, the next entry should be the file itself */ + iap->YapPrologRCFile = argv[1]; + argc = 1; + break; + } else { + iap->YapPrologRCFile = *argv; + argc--; + } + if (*p) { + /* we have something, usually, of the form: + -L -- + FileName + ExtraArgs + */ + /* being called from a script */ + while (*p && (*p == ' ' || *p == '\t')) + p++; + if (p[0] == '-' && p[1] == '-') { + /* ignore what is next */ + argc = 1; + } + } + break; + /* run goal before top-level */ + case 'g': + if ((*argv)[0] == '\0') + iap->YapPrologGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing " + "initialization goal for option 'g' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologGoal = *argv; + } + break; + /* run goal as top-level */ + case 'z': + if ((*argv)[0] == '\0') + iap->YapPrologTopLevelGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf( + stderr, + " [ YAP unrecoverable error: missing goal for option 'z' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologTopLevelGoal = add_end_dot(*argv); + } + break; + case 'n': + if (!strcmp("nosignals", p)) { + iap->PrologShouldHandleInterrupts = FALSE; + break; + } + break; + case '-': + if (!strcmp("-nosignals", p)) { + iap->PrologShouldHandleInterrupts = FALSE; + break; + } else if (!strncmp("-home=", p, strlen("-home="))) { + GLOBAL_Home = p + strlen("-home="); + } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { +#if __WINDOWS__ + if (_chdir(p + strlen("-cwd=")) < 0) { +#else + if (chdir(p + strlen("-cwd=")) < 0) { +#endif + fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", + strerror(errno)); + } + } else if (!strncmp("-stack=", p, strlen("-stack="))) { + ssize = &(iap->StackSize); + p += strlen("-stack="); + goto GetSize; + } else if (!strncmp("-trail=", p, strlen("-trail="))) { + ssize = &(iap->TrailSize); + p += strlen("-trail="); + goto GetSize; + } else if (!strncmp("-heap=", p, strlen("-heap="))) { + ssize = &(iap->HeapSize); + p += strlen("-heap="); + goto GetSize; + } else if (!strncmp("-goal=", p, strlen("-goal="))) { + iap->YapPrologGoal = p + strlen("-goal="); + } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { + iap->YapPrologTopLevelGoal = p + strlen("-top-level="); + } else if (!strncmp("-table=", p, strlen("-table="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + goto GetSize; + } else if (!strncmp("-", p, strlen("-="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + /* skip remaining arguments */ + argc = 1; + } + break; + case 'p': + if ((*argv)[0] == '\0') + iap->YapPrologAddPath = *argv; + else { + argc--; + if (argc == 0) { + fprintf( + stderr, + " [ YAP unrecoverable error: missing paths for option 'p' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologAddPath = *argv; + } + break; + /* nf: Begin preprocessor code */ + case 'D': { + char *var, *value; + ++p; + var = p; + if (var == NULL || *var == '\0') + break; + while (*p != '=' && *p != '\0') + ++p; + if (*p == '\0') + break; + *p = '\0'; + ++p; + value = p; + if (*value == '\0') + break; + if (iap->def_c == YAP_MAX_YPP_DEFS) + break; + iap->def_var[iap->def_c] = var; + iap->def_value[iap->def_c] = value; + ++(iap->def_c); + break; } + /* End preprocessor code */ + default: { + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", + *p); + print_usage(); + exit(EXIT_FAILURE); + } + } + else { + iap->SavedState = p; } -//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode); + } + //___androidlog_print(ANDROID_LOG_INFO, "YAP ", "boot mode %d", BootMode); return BootMode; } diff --git a/CMakeLists.txt b/CMakeLists.txt index d5cee0a3c..a4c24732c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -115,6 +115,7 @@ add_library(libYap ${STATIC_SOURCES} ${OPTYAP_SOURCES} ${HEADERS} + ${WINDLLS} $ $ $ @@ -169,7 +170,7 @@ set(YAP_STARTUP startup.yss) string(TIMESTAMP YAP_TIMESTAMP) string( SUBSTRING ${CMAKE_SHARED_LIBRARY_SUFFIX} 1 -1 SO_EXT ) # -include_directories (H include os OPTYap utf8proc JIT/HPP) +include_directories (H H/generated include os OPTYap utf8proc JIT/HPP) include_directories (BEFORE ${CMAKE_BINARY_DIR}) # rpath stuff, hopefully it works @@ -416,10 +417,21 @@ add_subDIRECTORY (packages/raptor) add_subDIRECTORY (packages/xml) -# add_subDIRECTORY (docs) +# please install doxygen for prolog first +# git clone http://www.github.com/vscosta/doxygen-yap +# cd doxygen-yap +# mkdir -p build +# cd build +# make; sudo make install +option (WITH_DOCS + "generate YAP docs" OFF) + + add_subDIRECTORY (docs) + # add_subDIRECTORY (packages/cuda) + #todo: use cmake target builds # option (USE_MAXPERFORMANCE # "try using the best flags for specific architecture" OFF) @@ -493,6 +505,11 @@ target_link_libraries(libYap ${CMAKE_DL_LIBS} ) +if(WIN32) + target_link_libraries(libYap wsock32 ws2_32 Shlwapi + ) +endif() + add_executable (yap-bin ${CONSOLE_SOURCES}) set_target_properties (yap-bin PROPERTIES OUTPUT_NAME yap) diff --git a/CXX/CMakeLists.txt b/CXX/CMakeLists.txt index ba026fd43..888bcb1c1 100644 --- a/CXX/CMakeLists.txt +++ b/CXX/CMakeLists.txt @@ -14,7 +14,9 @@ include_directories (H include ${CMAKE_BINARY_DIR} ${GMP_INCLUDE_DIR}) target_link_libraries(Yap++ libYap) install(TARGETS Yap++ - LIBRARY DESTINATION ${libdir} ) + LIBRARY DESTINATION ${libdir} + ARCHIVE DESTINATION ${libdir} + ) set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} ) #set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) diff --git a/CXX/yapi.hh b/CXX/yapi.hh index 525f79667..4a6cb9917 100644 --- a/CXX/yapi.hh +++ b/CXX/yapi.hh @@ -1,6 +1,8 @@ #define YAP_CPP_INTERFACE 1 + + //! @{ /** diff --git a/GitSHA1.c b/GitSHA1.c index 56e2ac8f9..fb8965832 100644 --- a/GitSHA1.c +++ b/GitSHA1.c @@ -1,2 +1,2 @@ -#define GIT_SHA1 "713e9dc9d83c385f5bdd57c8cfa4c7771a6cdb12" +#define GIT_SHA1 "703ac357357858351b27cb33b12830193e591282" const char g_GIT_SHA1[] = GIT_SHA1; diff --git a/H/Foreign.h b/H/Foreign.h index 68803ebff..41e32c823 100644 --- a/H/Foreign.h +++ b/H/Foreign.h @@ -37,7 +37,7 @@ #undef NO_DYN #endif /* __AIX */ -#if HAVE_DLOPEN +#ifdef HAVE_DLOPEN #define LOAD_DL 1 #ifdef NO_DYN #undef NO_DYN diff --git a/H/Yap.h b/H/Yap.h index 58ca4a732..8b4a3d2ce 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -590,12 +590,13 @@ typedef enum #else #define YAPEnterCriticalSection() \ { \ - LOCAL_PrologMode |= CritMode; \ + LOCAL_PrologMode |= CritMode;/* printf("%d, %s:%d\n",LOCAL_CritLocks+1,__FILE__,__LINE__);*/ \ LOCAL_CritLocks++; \ } #define YAPLeaveCriticalSection() \ { \ LOCAL_CritLocks--; \ + /*printf("%d, %s:%d\n",LOCAL_CritLocks,__FILE__,__LINE__);*/ \ if (!LOCAL_CritLocks) { \ LOCAL_PrologMode &= ~CritMode; \ if (LOCAL_PrologMode & AbortMode) { \ diff --git a/H/YapFlags.h b/H/YapFlags.h index 74c1d1ca5..d9f9e11e6 100644 --- a/H/YapFlags.h +++ b/H/YapFlags.h @@ -88,9 +88,9 @@ static inline bool isfloat(Term inp) { return false; } -INLINE_ONLY inline EXTERN bool ro(Term inp); +static inline bool ro(Term inp); -INLINE_ONLY inline EXTERN bool ro(Term inp) { +static inline bool ro(Term inp) { if (IsVarTerm(inp)) { Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag: value must be %s", "bound"); @@ -114,9 +114,9 @@ INLINE_ONLY inline EXTERN bool aro(Term inp) { return false; } -// INLINE_ONLY inline EXTERN bool boolean( Term inp ); +// INLINE_ONLY inline EXTERN bool booleanFlag( Term inp ); -static inline bool boolean(Term inp) { +static inline bool booleanFlag(Term inp) { if (inp == TermTrue || inp == TermFalse || inp == TermOn || inp == TermOff) return true; if (IsVarTerm(inp)) { @@ -151,6 +151,17 @@ static bool synerr(Term inp) { static inline bool filler(Term inp) { return true; } +static inline bool list_filler(Term inp) { + if (IsVarTerm(inp) || + IsPairTerm(inp) || + inp == TermNil) + return true; + + Yap_Error(TYPE_ERROR_LIST, inp, + "set_prolog_flag in {codes,string}"); + + return false; } + static bool bqs(Term inp) { if (inp == TermCodes || inp == TermString || inp == TermSymbolChar) return true; diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index 9e50f99de..22f7123fc 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -42,12 +42,12 @@ opportunity. Initial value is 10,000. May be changed. A value of 0 (zero) disables atom garbage collection. */ YAP_FLAG(ALLOW_ASSERT_FOR_STATIC_PREDICATES, - "allow_assert_for_static_predicates", true, boolean, "true", + "allow_assert_for_static_predicates", true, booleanFlag, "true", NULL), /**< `allow asserting and retracting clauses of static predicates. */ /* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, - "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< + "allow_variable_name_as_functor", true, booleanFlag, "false" , NULL ), /\**< `allow_variable_name_as_functor` */ /* allow @@ -76,15 +76,15 @@ It is `true` by default, but it is disabled by packages like CLP(BN) and ProbLog. */ #if __APPLE__ - YAP_FLAG(APPLE_FLAG, "apple", false, boolean, "true", NULL), /**< `apple` + YAP_FLAG(APPLE_FLAG, "apple", false, booleanFlag, "true", NULL), /**< `apple` - Read-only boolean flag that unifies with `true` if YAP is + Read-only booleanFlag flag that unifies with `true` if YAP is running on an Apple machine. */ #endif YAP_FLAG(ARCH_FLAG, "arch", false, isatom, YAP_ARCH, NULL), YAP_FLAG(ARGV_FLAG, "argv", false, argv, "?-", NULL), - YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, boolean, + YAP_FLAG(ARITHMETIC_EXCEPTIONS_FLAG, "arithmetic_exceptions", true, booleanFlag, "true", NULL), YAP_FLAG(BACKQUOTED_STRING_FLAG, "backquoted_string", true, isatom, "string", ), /**> @@ -94,7 +94,7 @@ token is converted to a list of atoms, `chars`, to a list of integers, the corresponding behavior. The default value is `string` */ - YAP_FLAG(BOUNDED_FLAG, "bounded", false, boolean, "false", + YAP_FLAG(BOUNDED_FLAG, "bounded", false, booleanFlag, "false", NULL), /**< `bounded` is iso Read-only flag telling whether integers are bounded. The value depends @@ -105,36 +105,36 @@ on whether YAP uses the GMP library or not. YAP_FLAG(C_LDFLAGS_FLAG, "c_ldflags", false, isatom, C_LDFLAGS, NULL), YAP_FLAG(C_LIBPLSO_FLAG, "c_libplso", false, isatom, C_LIBPLSO, NULL), YAP_FLAG(C_LIBS_FLAG, "c_libs", false, isatom, C_LIBS, NULL), - YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, boolean, "false", + YAP_FLAG(CHAR_CONVERSION_FLAG, "char_conversion", true, booleanFlag, "false", NULL), /**< `char_conversion is iso` Writable flag telling whether a character conversion table is used when reading terms. The default value for this flag is `off` except in `sicstus` and `iso` language modes, where it is `on`. */ - YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, boolean, "true", + YAP_FLAG(CHARACTER_ESCAPES_FLAG, "character_escapes", true, booleanFlag, "true", NULL), /**< `character_escapes is iso ` Writable flag telling whether a character escapes are enables, `true`, or disabled, `false`. The default value for this flag is `true`. */ YAP_FLAG(COLON_SETS_CALLING_CONTEXT_FLAG, "colon_sets_calling_context", - true, boolean, "true", NULL), + true, booleanFlag, "true", NULL), YAP_FLAG(COMPILED_AT_FLAG, "compiled_at", false, isatom, YAP_COMPILED_AT, NULL), /**< `compiled_at ` Read-only flag that gives the time when the main YAP binary was compiled. It is obtained staight from the __TIME__ macro, as defined in the C99. */ - YAP_FLAG(DEBUG_FLAG, "debug", true, boolean, "false", + YAP_FLAG(DEBUG_FLAG, "debug", true, booleanFlag, "false", NULL), /**< `debug is iso ` If _Value_ is unbound, tell whether debugging is `true` or `false`. If _Value_ is bound to `true` enable debugging, and if it is bound to `false` disable debugging. */ - YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, boolean, "true", NULL), - YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, boolean, "true", + YAP_FLAG(DEBUG_INFO_FLAG, "debug_info", true, booleanFlag, "true", NULL), + YAP_FLAG(DEBUG_ON_ERROR_FLAG, "debug_on_error", true, booleanFlag, "true", NULL), YAP_FLAG(DEBUGGER_PRINT_OPTIONS_FLAG, "debugger_print_options", true, list_option, @@ -144,7 +144,7 @@ it is bound to `false` disable debugging. If bound, set the argument to the `write_term/3` options the debugger uses to write terms. If unbound, show the current options. */ - YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, boolean, + YAP_FLAG(DEBUGGER_SHOW_CONTEXT_FLAG, "debugger_show_context", true, booleanFlag, "false", NULL), YAP_FLAG(DIALECT_FLAG, "dialect", false, ro, "yap", NULL), /**< `dialect ` @@ -152,13 +152,13 @@ debugger uses to write terms. If unbound, show the current options. Read-only flag that always returns `yap`. */ YAP_FLAG(DISCONTIGUOUS_WARNINGS_FLAG, "discontiguous_warnings", true, - boolean, "true", NULL), /**< `discontiguous_warnings ` + booleanFlag, "true", NULL), /**< `discontiguous_warnings ` If `true` (default `true`) YAP checks for definitions of the same predicate that are separated by clauses for other predicates. This may indicate that different procedures have the sam*e name. */ - YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, boolean, + YAP_FLAG(DOLLAR_AS_LOWER_CASE_FLAG, "dollar_as_lower_case", true, booleanFlag, "false", NULL), /**< `dollar_as_lower_case ` If `off` (default) consider the character `$` a control character, if @@ -178,12 +178,12 @@ the corresponding behavior. The default value is `codes`. */ Read-only flag. It unifies with an atom that gives the original program path. */ - YAP_FLAG(FAST_FLAG, "fast", true, boolean, "false", NULL), /**< `fast ` + YAP_FLAG(FAST_FLAG, "fast", true, booleanFlag, "false", NULL), /**< `fast ` If `on` allow fast machine code, if `off` (default) disable it. Only available in experimental implemexbntations. */ - YAP_FLAG(FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, boolean, + YAP_FLAG(FILE_NAME_VARIABLES_FLAG, "file_name_variables", true, booleanFlag, "true", NULL), YAP_FLAG(FLOAT_FORMAT_FLAG, "float_format", true, isatom, "%15e", NULL), /**< + `float_format ` @@ -195,7 +195,7 @@ available in experimental implemexbntations. printed, `%g` will print all floats using 6 digits instead of the default 15. */ - YAP_FLAG(GC_FLAG, "gc", true, boolean, "on", NULL), /**< `gc` + YAP_FLAG(GC_FLAG, "gc", true, booleanFlag, "on", NULL), /**< `gc` If `on` allow garbage collection (default), if `off` disable it. */ @@ -216,7 +216,7 @@ collection and stack shifts. Last, if `very_verbose` give detailed information on data-structures found during the garbage collection process, namely, on choice-points. */ - YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true, boolean, + YAP_FLAG(GENERATE_DEBUGGING_INFO_FLAG, "generate_debug_info", true, booleanFlag, "true", NULL), /**< `generate_debug_info ` If `true` (default) generate debugging information for @@ -226,7 +226,7 @@ source mode is disabled. */ YAP_FLAG(GMP_VERSION_FLAG, "gmp_version", false, isatom, "4.8.12", NULL), - YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, boolean, + YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, booleanFlag, "false", NULL), YAP_FLAG(HOME_FLAG, "home", false, isatom, YAP_ROOTDIR, NULL), /**< home ` @@ -264,7 +264,7 @@ the `-L` flag. Read-only flag telling the rounding function used for integers. Takes the value `toward_zero` for the current version of YAP. */ - YAP_FLAG(ISO_FLAG, "iso", true, boolean, "false", NULL), + YAP_FLAG(ISO_FLAG, "iso", true, booleanFlag, "false", NULL), YAP_FLAG(LANGUAGE_FLAG, "language", true, isatom, "yap", NULL), /**< `language ` @@ -289,26 +289,26 @@ Read-only flag telling the maximum arity of a functor. Takes the value "INT_MIN", NULL), YAP_FLAG(N_OF_INTEGER_KEYS_IN_DB_FLAG, "n_of_integer_keys_in_db", false, ro, "256", NULL), - YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, boolean, "false", NULL), - YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, boolean, + YAP_FLAG(OCCURS_CHECK_FLAG, "occurs_check", true, booleanFlag, "false", NULL), + YAP_FLAG(OPEN_EXPANDS_FILENAME_FLAG, "open_expands_filename", true, booleanFlag, "true", NULL), /**< `open_expands_filename ` If `true` the open/3 builtin performs filename-expansion before opening a file (SICStus Prolog like). If `false` it does not (SWI-Prolog like). */ - YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, boolean, + YAP_FLAG(OPEN_SHARED_OBJECT_FLAG, "open_shared_object", true, booleanFlag, "true", NULL), /**< `open_shared_object ` If true, `open_shared_object/2` and friends are implemented, providing access to shared libraries (`.so` files) or to dynamic link libraries (`.DLL` files). */ - YAP_FLAG(OPTIMISE_FLAG, "optimise", true, boolean, "false", NULL), + YAP_FLAG(OPTIMISE_FLAG, "optimise", true, booleanFlag, "false", NULL), YAP_FLAG(OS_ARGV_FLAG, "os_argv", false, os_argv, "?-", NULL), YAP_FLAG(PID_FLAG, "pid", false, ro, "0", NULL), - YAP_FLAG(PIPE_FLAG, "pipe", true, boolean, "true", NULL), - YAP_FLAG(PROFILING_FLAG, "profiling", true, boolean, "false", + YAP_FLAG(PIPE_FLAG, "pipe", true, booleanFlag, "true", NULL), + YAP_FLAG(PROFILING_FLAG, "profiling", true, booleanFlag, "false", NULL), /**< `profiling ` If `off` (default) do not compile call counting information for @@ -325,10 +325,12 @@ toplevel. Default is groundness, YAP prompts for alternatives if and only if the query contains variables. The alternative, default in SWI-Prolog is determinism which implies the system prompts for alternatives if the goal succeeded while leaving choicepoints. */ - YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, boolean, "true", + YAP_FLAG(QUASI_QUOTATIONS_FLAG, "quasi_quotations", true, booleanFlag, "true", NULL), - YAP_FLAG(READLINE_FLAG, "readline", true, boolean, "true", NULL), - YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, boolean, "true", NULL), + YAP_FLAG(READLINE_FLAG, "readline", true, booleanFlag, "false", Yap_InitReadline), /**< `readline(boolean, changeable)` + +enable the use of the readline library for console interactions, true by default if readline was found. */ + YAP_FLAG(REPORT_ERROR_FLAG, "report_error", true, booleanFlag, "true", NULL), YAP_FLAG(SHARED_OBJECT_EXTENSION_FLAG, "shared_object_extension", false, isatom, SO_EXT, NULL), /**< `shared_object_extension ` @@ -341,20 +343,20 @@ Name of the environment variable used by the system to search for shared objects. */ - YAP_FLAG(SIGNALS_FLAG, "signals", true, boolean, "true", + YAP_FLAG(SIGNALS_FLAG, "signals", true, booleanFlag, "true", NULL), /**< `signals` If `true` (default) YAP handles Signals such as `^C` (`SIGINT`). */ - YAP_FLAG(SOURCE_FLAG, "source", true, boolean, "true", NULL), /**< `source` + YAP_FLAG(SOURCE_FLAG, "source", true, booleanFlag, "true", NULL), /**< `source` If `true` maintain the source for all clauses. Notice that this is trivially supported for facts, and always supported for dynamic code. */ - YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, boolean, "false", + YAP_FLAG(STRICT_ISO_FLAG, "strict_iso", true, booleanFlag, "false", NULL), /**< `strict_iso ` If _Value_ is unbound, tell whether strict ISO compatibility mode @@ -398,7 +400,7 @@ Sets or reads the tabling mode for all tabled predicates. Please */ YAP_FLAG(THREADS_FLAG, "threads", false, ro, "MAX_THREADS", NULL), YAP_FLAG(TIMEZONE_FLAG, "timezone", false, ro, "18000", NULL), - YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, boolean, + YAP_FLAG(TOPLEVEL_PRINT_ANON_FLAG, "toplevel_print_anon", true, booleanFlag, "true", NULL), YAP_FLAG(TOPLEVEL_PRINT_OPTIONS_FLAG, "toplevel_print_options", true, list_option, "[quoted(true),numbervars(true),portrayed(true)]", @@ -412,10 +414,10 @@ backtracked into. */ YAP_FLAG(TOPLEVEL_PROMPT_FLAG, "toplevel_prompt", true, isatom, "?- ", mkprompt), - YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, boolean, "true", NULL), + YAP_FLAG(TTY_CONTROL_FLAG, "tty_control", true, booleanFlag, "true", NULL), YAP_FLAG(UNIX_FLAG, "unix", false, ro, "true", NULL), /**< `unix` - Read-only Boolean flag that unifies with `true` if YAP is + Read-only BooleanFlag flag that unifies with `true` if YAP is running on an Unix system. Defined if the C-compiler used to compile this version of YAP either defines `__unix__` or `unix`. */ @@ -448,7 +450,7 @@ are `error`, `fail`, and `warning`. Yap includes the following extensions: `fast_fail` does not invoke any handler. */ YAP_FLAG(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG, - "variable_names_may_end_with_quotes", true, boolean, "false", + "variable_names_may_end_with_quotes", true, booleanFlag, "false", NULL), YAP_FLAG(VERBOSE_FLAG, "verbose", true, isatom, "normal", NULL), /**< `verbose ` @@ -459,9 +461,9 @@ disable printing these messages. It is `normal` by default except if YAP is booted with the `-q` or `-L` flag. */ - YAP_FLAG(VERBOSE_AUTOLOAD_FLAG, "verbose_autoload", true, boolean, "false", + YAP_FLAG(VERBOSE_AUTOLOAD_FLAG, "verbose_autoload", true, booleanFlag, "false", NULL), - YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, boolean, + YAP_FLAG(VERBOSE_FILE_SEARCH_FLAG, "verbose_file_search", true, booleanFlag, "false", NULL), /**< `verbose_file_search ` If `true` allow printing of informational messages when @@ -505,11 +507,11 @@ xan be used to identify versions that differ on small (or large) updates. #if __WINDOWS__ YAP_FLAG(WINDOWS_FLAG, "windows", false, ro, "true", NULL), /**< `windows ` - Read-only boolean flag that unifies with `true` if YAP is + Read-only booleanFlag flag that unifies with `true` if YAP is running on an Windows machine. */ #endif - YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, boolean, "false", + YAP_FLAG(WRITE_STRINGS_FLAG, "write_strings", true, booleanFlag, "false", NULL), /**< `write_strings ` Writable flag telling whether the system should write lists of diff --git a/H/YapHandles.h b/H/YapHandles.h index a4daff7a2..c330ab7f1 100755 --- a/H/YapHandles.h +++ b/H/YapHandles.h @@ -15,7 +15,16 @@ #ifndef YAP_HANDLES_H #define YAP_HANDLES_H 1 + #include "Regs.h" +#include "Yatom.h" + +#define LOCAL_CurHandle LOCAL_CurSlot +#define REMOTE_CurHandle REMOTE_CurSlot +#define LOCAL_NHandles LOCAL_NSlots +#define REMOTE_NHandles REMOTE_NSlots +#define LOCAL_HandleBase LOCAL_SlotBase +#define REMOTE_HanvdleBase SlotBase /** @groupdef term_t_slots @@ -30,7 +39,7 @@ garbage-collection. automatically released at the end of a function. Hence, slots should always be used as local variables. -Slots are organized as follows: +Handles are organized as follows: ---- Offset of next pointer in chain (tagged as an handle_t) ---- Number of entries (tagged as handle_t), in the example TAG(INT,4) Entry @@ -39,7 +48,7 @@ Entry Entry ---- Number of entries (tagged as handle_t), in the example TAG(INT,4) -Slots are not known to the yaam. Instead, A new set of slots is created when the +Handles are not known to the yaam. Instead, A new set of slots is created when the emulator calls user C-code. (see YAP_Execute* functions). They are also created: @@ -58,105 +67,119 @@ functions are then exported through corresponding FLI C-functions /// @brief reboot the slot system. /// Used when wwe start from scratch (Reset). -#define Yap_RebootSlots(wid) Yap_RebootSlots__(wid PASS_REGS) +#define Yap_RebootHandles(wid) Yap_RebootHandles__(wid PASS_REGS) +#define Yap_RebootSlots(wid) Yap_RebootHandles__(wid PASS_REGS) -static inline void Yap_RebootSlots__(int wid USES_REGS) { - // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); - REMOTE_CurSlot(wid) = 1; +static inline void Yap_RebootHandles__(int wid USES_REGS) { + // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle); + REMOTE_CurHandle(wid) = 1; } /// @brief declares a new set of slots. -/// Used to tell how many slots we had when we entered a segment of code. -//#define Yap_StartSlots() ( -// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurSlot)?Yap_StartSlots__(PASS_REGS1): +/// Used to tell how many slots we have so d=dara when we entered a segment of code. +//#define Yap_StartHandles() ( +// printf("[<<<%s,%s,%d-%ld\n",__FILE__,__FUNCTION__,__LINE__,LOCAL_CurHandle)?Yap_StartHandles__(PASS_REGS1): //-1) -#define Yap_StartSlots() Yap_StartSlots__(PASS_REGS1) +#define Yap_StartHandles() Yap_StartHandles__(PASS_REGS1) +#define Yap_StartSlots() Yap_StartHandles__(PASS_REGS1) -INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1); -INLINE_ONLY inline EXTERN yhandle_t Yap_StartSlots__(USES_REGS1) { - // // fprintf(stderr, " StartSlots = %ld", LOCAL_CurSlot); +INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1); +INLINE_ONLY inline EXTERN yhandle_t Yap_StartHandles__(USES_REGS1) { + // // fprintf(stderr, " StartHandles = %ld", LOCAL_CurHandle); // fprintf(stderr,"SS %s:%d\n", __FILE__, __LINE__);; - if (LOCAL_CurSlot < 0) { - Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartSlots = %ld", LOCAL_CurSlot); + if (LOCAL_CurHandle < 0) { + Yap_Error(SYSTEM_ERROR_INTERNAL, 0L, " StartHandles = %ld", LOCAL_CurHandle); } - return LOCAL_CurSlot; + return LOCAL_CurHandle; } -/// @brief reset slots to a well-known position in the stack -//#define Yap_CloseSlots(slot) ( printf("- %s,%s,%d -//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseSlots__(slot +/// @brief reset the nmber of slots _slot_ to the number existing before the call that produce _slot_ +///(eg, Yap_StartHandles(), YAP_NewHandles(), or YAP_PushHandle) +//#define Yap_CloseHandles(slot) ( printf("- %s,%s,%d +//%ld>>>]\n",__FILE__,__FUNCTION__,__LINE__, slot)?Yap_CloseHandles__(slot // PASS_REGS):-1) -#define Yap_CloseSlots(slot) Yap_CloseSlots__(slot PASS_REGS) +#define Yap_CloseHandles(slot) Yap_CloseHandles__(slot PASS_REGS) +#define Yap_CloseSlots(slot) Yap_CloseHandles__(slot PASS_REGS) -INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS); -INLINE_ONLY inline EXTERN void Yap_CloseSlots__(yhandle_t slot USES_REGS) { - // fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__);; - LOCAL_CurSlot = slot; +INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN void Yap_CloseHandles__(yhandle_t slot USES_REGS) { + // fprintf(stderr,"CS %s:%d\n", __FILE__, __LINE__); + LOCAL_CurHandle = slot; } -#define Yap_CurrentSlot() Yap_CurrentSlot__(PASS_REGS1) +#define Yap_CurrentHandle() Yap_CurrentHandle__(PASS_REGS1) +#define Yap_CurrentSlot() Yap_CurrentHandle__(PASS_REGS1) + /// @brief report the current position of the slots, assuming that they occupy /// the top of the stack. -INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1); -INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentSlot__(USES_REGS1) { - return LOCAL_CurSlot; +INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1); +INLINE_ONLY inline EXTERN yhandle_t Yap_CurrentHandle__(USES_REGS1) { + return LOCAL_CurHandle; } -#define Yap_GetFromSlot(slot) Yap_GetFromSlot__(slot PASS_REGS) +#define Yap_GetFromHandle(slot) Yap_GetFromHandle__(slot PASS_REGS) +#define Yap_GetFromSlot(slot) Yap_GetFromHandle__(slot PASS_REGS) + /// @brief read from a slot. -INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS); -INLINE_ONLY inline EXTERN Term Yap_GetFromSlot__(yhandle_t slot USES_REGS) { +INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term Yap_GetFromHandle__(yhandle_t slot USES_REGS) { // fprintf(stderr, "GS %s:%d\n", __FILE__, __LINE__); - return Deref(LOCAL_SlotBase[slot]); + return Deref(LOCAL_HandleBase[slot]); } -#define Yap_GetDerefedFromSlot( slot ) Yap_GetDerefedFromSlot__(slot PASS_REGS) +#define Yap_GetDerefedFromHandle( slot ) Yap_GetDerefedFromHandle__(slot PASS_REGS) +#define Yap_GetDerefedFromSlot( slot ) Yap_GetDerefedFromHandle__(slot PASS_REGS) + /// @brief read from a slot. but does not try to dereference the slot. -INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS); -INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromSlot__(yhandle_t slot USES_REGS) { +INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term Yap_GetDerefedFromHandle__(yhandle_t slot USES_REGS) { // fprintf(stderr,"GDS %s:%d\n", __FILE__, __LINE__); - return LOCAL_SlotBase[slot]; + return LOCAL_HandleBase[slot]; } -#define Yap_GetPtrFromSlot( slot ) Yap_GetPtrFromSlot__(slot PASS_REGS) +#define Yap_GetPtrFromHandle( slot ) Yap_GetPtrFromHandle__(slot PASS_REGS) +#define Yap_GetPtrFromSlot( slot ) Yap_GetPtrFromHandle__(slot PASS_REGS) /// @brief read the object in a slot. but do not try to dereference the slot. -INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS); -INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromSlot__(yhandle_t slot USES_REGS) { +INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN Term *Yap_GetPtrFromHandle__(yhandle_t slot USES_REGS) { // fprintf(stderr,"GPS %s:%d\n", __FILE__, __LINE__); - return (Term *)LOCAL_SlotBase[slot]; + return (Term *)LOCAL_HandleBase[slot]; } -#define Yap_AddressFromSlot(slot) Yap_AddressFromSlot__(slot PASS_REGS) +#define Yap_AddressFromHandle(slot) Yap_AddressFromHandle__(slot PASS_REGS) +#define Yap_AddressFromSlot(slot) Yap_AddressFromHandle__(slot PASS_REGS) -INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS); -INLINE_ONLY inline EXTERN CELL *Yap_AddressFromSlot__(yhandle_t slot USES_REGS) { +INLINE_ONLY inline EXTERN CELL *Yap_AddressFromHandle__(yhandle_t slot USES_REGS); +INLINE_ONLY inline EXTERN CELL *Yap_AddressFromHandle__(yhandle_t slot USES_REGS) { /// @brief get the memory address of a slot - return LOCAL_SlotBase + slot; + return LOCAL_HandleBase + slot; } -#define Yap_PutInSlot(slot, t) Yap_PutInSlot__(slot, t PASS_REGS) +#define Yap_PutInSlot(slot, t) Yap_PutInHandle__(slot, t PASS_REGS) +#define Yap_PutInHandle(slot, t) Yap_PutInHandle__(slot, t PASS_REGS) /// @brief store term in a slot -INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS); -INLINE_ONLY inline EXTERN void Yap_PutInSlot__(yhandle_t slot, Term t USES_REGS) { +INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot, Term t USES_REGS); +INLINE_ONLY inline EXTERN void Yap_PutInHandle__(yhandle_t slot, Term t USES_REGS) { // fprintf(stderr,"PS %s:%d\n", __FILE__, __LINE__); - LOCAL_SlotBase[slot] = t; + LOCAL_HandleBase[slot] = t; } #ifndef max #define max(X, Y) (X > Y ? X : Y) #endif +#define ensure_handles ensure_slots INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) { - if (LOCAL_CurSlot + N >= LOCAL_NSlots) { - size_t inc = max(16 * 1024, LOCAL_NSlots / 2); // measured in cells + if (LOCAL_CurHandle + N >= LOCAL_NHandles) { + size_t inc = max(16 * 1024, LOCAL_NHandles / 2); // measured in cells inc = max(inc, N + 16); // measured in cells - LOCAL_SlotBase = - (CELL *)realloc(LOCAL_SlotBase, (inc + LOCAL_NSlots) * sizeof(CELL)); - LOCAL_NSlots += inc; - if (!LOCAL_SlotBase) { - unsigned long int kneeds = ((inc + LOCAL_NSlots) * sizeof(CELL)) / 1024; + LOCAL_HandleBase = + (CELL *)realloc(LOCAL_HandleBase, (inc + LOCAL_NHandles) * sizeof(CELL)); + LOCAL_NHandles += inc; + if (!LOCAL_HandleBase) { + unsigned long int kneeds = ((inc + LOCAL_NHandles) * sizeof(CELL)) / 1024; Yap_Error( SYSTEM_ERROR_INTERNAL, 0 /* TermNil */, "Out of memory for the term handles (term_t) aka slots, l needed", @@ -166,75 +189,95 @@ INLINE_ONLY inline EXTERN void ensure_slots(int N USES_REGS) { } /// @brief create a new slot with term t - // #define Yap_InitSlot(t) - // (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurSlot,__FILE__, __FUNCTION__, __LINE__) - // ? Yap_InitSlot__(t PASS_REGS) + // #define Yap_InitHandle(t) + // (printf("+%d %ld %s,%s,%d>>>]\n", 1, LOCAL_CurHandle,__FILE__, __FUNCTION__, __LINE__) + // ? Yap_InitHandle__(t PASS_REGS) // : -1) -#define Yap_InitSlot(t) Yap_InitSlot__(t PASS_REGS) +#define Yap_InitHandle(t) Yap_InitHandle__(t PASS_REGS) +#define Yap_PushHandle(t) Yap_InitHandle__(t PASS_REGS) +#define Yap_InitSlot(t) Yap_InitHandle__(t PASS_REGS) -INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS); -INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlot__(Term t USES_REGS) { - yhandle_t old_slots = LOCAL_CurSlot; +INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandle__(Term t USES_REGS) { + yhandle_t old_slots = LOCAL_CurHandle; ensure_slots(1 PASS_REGS); - LOCAL_SlotBase[old_slots] = t; - LOCAL_CurSlot++; + LOCAL_HandleBase[old_slots] = t; + LOCAL_CurHandle++; return old_slots; } -//#define Yap_NewSlots(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurSlot,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewSlots__(n PASS_REGS):-1) -#define Yap_NewSlots(n) Yap_NewSlots__(n PASS_REGS) +//#define Yap_NewHandles(n) ( printf("+%d %ld %s,%s,%d>>>]\n",n,LOCAL_CurHandle,__FILE__,__FUNCTION__,__LINE__) ?Yap_NewHandles__(n PASS_REGS):-1) +#define Yap_NewHandles(n) Yap_NewHandles__(n PASS_REGS) +#define Yap_NewSlots(n) Yap_NewHandles__(n PASS_REGS) -INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS); -INLINE_ONLY inline EXTERN yhandle_t Yap_NewSlots__(int n USES_REGS) { - yhandle_t old_slots = LOCAL_CurSlot; +INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_NewHandles__(int n USES_REGS) { + yhandle_t old_slots = LOCAL_CurHandle; int i; //fprintf(stderr, "NS %s:%d\n", __FILE__, __LINE__); ensure_slots(n PASS_REGS); for (i = 0; i < n; i++) { - LOCAL_SlotBase[old_slots + i] = MkVarTerm(); + LOCAL_HandleBase[old_slots + i] = MkVarTerm(); } - LOCAL_CurSlot += n; + LOCAL_CurHandle += n; return old_slots; } -//#define Yap_InitSlots(n, ts) - // (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurSlot, __FILE__, __FUNCTION__, __LINE__) - // ? Yap_InitSlots__(n, ts PASS_REGS) +//#define Yap_InitHandles(n, ts) + // (printf("+%d %d %s,%s,%d>>>]\n", n, LOCAL_CurHandle, __FILE__, __FUNCTION__, __LINE__) + // ? Yap_InitHandles__(n, ts PASS_REGS) // : -1) -#define Yap_InitSlots(n, ts) Yap_InitSlots__(n, ts PASS_REGS) +#define Yap_InitHandles(n, ts) Yap_InitHandles__(n, ts PASS_REGS) +#define Yap_InitSlots(n, ts) Yap_InitHandles__(n, ts PASS_REGS) /// @brief create n new slots with terms ts[] -INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS); -INLINE_ONLY inline EXTERN yhandle_t Yap_InitSlots__(int n, Term *ts USES_REGS) { - yhandle_t old_slots = LOCAL_CurSlot; +INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n, Term *ts USES_REGS); +INLINE_ONLY inline EXTERN yhandle_t Yap_InitHandles__(int n, Term *ts USES_REGS) { + yhandle_t old_slots = LOCAL_CurHandle; int i; ensure_slots(n PASS_REGS); for (i = 0; i < n; i++) - LOCAL_SlotBase[old_slots + i] = ts[i]; - LOCAL_CurSlot += n; + LOCAL_HandleBase[old_slots + i] = ts[i]; + LOCAL_CurHandle += n; return old_slots; } -#define Yap_RecoverSlots(n, ts) Yap_RecoverSlots__(n, ts PASS_REGS) +#define Yap_RecoverHandles(n, ts) Yap_RecoverHandles__(n, ts PASS_REGS) +#define Yap_RecoverSlots(n, ts) Yap_RecoverHandles__(n, ts PASS_REGS) /// @brief Succeeds if it is to recover the space allocated for $n$ contiguos -/// slots starting at topSlot. -static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS); -static inline bool Yap_RecoverSlots__(int n, yhandle_t topSlot USES_REGS) { - if (topSlot + n < LOCAL_CurSlot) +/// slots starting at topHandle. +static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS); +static inline bool Yap_RecoverHandles__(int n, yhandle_t topHandle USES_REGS) { + if (topHandle + n < LOCAL_CurHandle) return false; #ifdef DEBUG - if (n > LOCAL_CurSlot) { + if (n > LOCAL_CurHandle) { Yap_Error(SYSTEM_ERROR_INTERNAL, 0, - "Inconsistent slot state in Yap_RecoverSlots.", 0); + "Inconsistent slot state in Yap_RecoverHandles.", 0); return false; } #endif - LOCAL_CurSlot -= n; - //fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurSlot, __FILE__, __LINE__); + LOCAL_CurHandle -= n; + //fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__); return true; } +#define Yap_PopSlot( ts) Yap_PopHandle__( ts PASS_REGS) +#define Yap_PopHandle( ts) Yap_PopHandle__( ts PASS_REGS) + +/// @brief recovers the element at position $n$ dropping any other elements p +static inline Term Yap_PopHandle__( yhandle_t topHandle USES_REGS); +static inline Term Yap_PopHandle__( yhandle_t topHandle USES_REGS) { + if (LOCAL_CurHandle < topHandle) + return TermNil; + else { + LOCAL_CurHandle = topHandle; + //fprintf(stderr,"RS %ld %s:%d\n", LOCAL_CurHandle, __FILE__, __LINE__);≈ + return Deref(LOCAL_HandleBase[topHandle]); + + } +} #endif diff --git a/H/YapHeap.h b/H/YapHeap.h index 3eb2e2bdb..2ae217a46 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -161,14 +161,14 @@ typedef struct various_codes { /* memory allocation and management */ special_functors funcs; -#include "heap/hstruct.h" +#include "struct.h" } all_heap_codes; -#include "heap/hglobals.h" +#include "hglobals.h" -#include "heap/dhstruct.h" -#include "heap/dglobals.h" +#include "dhstruct.h" +#include "dglobals.h" #else typedef struct various_codes { /* memory allocation and management */ @@ -184,17 +184,17 @@ typedef struct various_codes { #define EXTERNAL extern #endif -#include "heap/h0struct.h" +#include "h0struct.h" -#include "heap/h0globals.h" +#include "h0globals.h" #endif -#include "heap/hlocals.h" +#include "hlocals.h" -#include "heap/dlocals.h" +#include "dlocals.h" /* ricardo diff --git a/H/YapLFlagInfo.h b/H/YapLFlagInfo.h index 6efa0cec4..4b057f434 100644 --- a/H/YapLFlagInfo.h +++ b/H/YapLFlagInfo.h @@ -20,10 +20,10 @@ @ingroup Flags */ -YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, boolean, "false" , NULL ), +YAP_FLAG( AUTOLOAD_FLAG, "autoload", true, booleanFlag, "false" , NULL ), YAP_FLAG( BREAK_LEVEL_FLAG, "break_level", true, nat, "0" , NULL ), YAP_FLAG( ENCODING_FLAG, "encoding", true, isatom, "utf-8" , getenc ), -YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, boolean, "true" , NULL ), /**< `fileerrors` +YAP_FLAG( FILEERRORS_FLAG, "fileerrors", true, booleanFlag, "true" , NULL ), /**< `fileerrors` If `on` `fileerrors` is `on`, if `off` (default) `fileerrors` is disabled. @@ -32,7 +32,7 @@ YAP_FLAG( LANGUAGE_MODE_FLAG, "language_mode", true, isatom, "yap" , NULL ), /* wweter native mode or trying to emulate a different Prolog. */ -YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, boolean, "true" , NULL ), /**< `redefine_warnings ` +YAP_FLAG( REDEFINE_WARNINGS_FLAG, "redefine_warnings", true, booleanFlag, "true" , NULL ), /**< `redefine_warnings ` If _Value_ is unbound, tell whether warnings for procedures defined in several different files are `on` or @@ -40,11 +40,11 @@ in several different files are `on` or and if it is bound to `off` disable them. The default for YAP is `off`, unless we are in `sicstus` or `iso` mode. */ -YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, boolean, "true" , NULL ), /**< `single_var_warnings` +YAP_FLAG( SINGLE_VAR_WARNINGS_FLAG, "single_var_warnings", true, booleanFlag, "true" , NULL ), /**< `single_var_warnings` If `true` (default `true`) YAP checks for singleton variables when loading files. A singleton variable is a variable that appears ony once in a clause. The name must start with a capital letter, variables whose name starts with underscore are never considered singleton. */ -YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, boolean, "false" , NULL ), /**< `stack_dump_on_error ` +YAP_FLAG( STACK_DUMP_ON_ERROR_FLAG, "stack_dump_on_error", true, booleanFlag, "false" , NULL ), /**< `stack_dump_on_error ` If `true` show a stack dump when YAP finds an error. The default is `off`. diff --git a/H/Yapproto.h b/H/Yapproto.h index 84fd6ff0f..6a6175ba3 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -176,7 +176,8 @@ void Yap_RestartYap(int); void Yap_exit(int); bool Yap_Warning(const char *s, ...); bool Yap_PrintWarning(Term t); -int Yap_HandleError(const char *msg, ...); +bool Yap_HandleError__(const char *file, const char *function, int lineno, const char *s, ...); +#define Yap_HandleError(...) Yap_HandleError__(__FILE__, __FUNCTION__, __LINE__, __VA_ARGS__) int Yap_SWIHandleError(const char *, ...); void Yap_InitErrorPreds(void); @@ -295,6 +296,7 @@ extern void Yap_DebugErrorPuts(const char *s); extern void Yap_DebugWriteIndicator(struct pred_entry *ap); void Yap_PlWriteToStream(Term, int, int); /* depth_lim.c */ +bool Yap_InitReadline(Term t); void Yap_InitItDeepenPreds(void); struct AliasDescS *Yap_InitStandardAliases(void); @@ -485,7 +487,7 @@ struct AtomEntryStruct *Yap_lookupBlob(void *blob, size_t len, void *type, void Yap_init_optyap_preds(void); /* pl-file.c */ -// struct PL_local_data *Yap_InitThreadIO(int wid); +// struct PL_local_data *Yap_InitThreadIO(int wid); void Yap_flush(void); /* pl-yap.c */ @@ -495,3 +497,10 @@ Atom Yap_source_file_name(void); void Yap_install_blobs(void); yamop *Yap_gcP(void); + +#if !HAVE_STRNCAT +#define strncat(X, Y, Z) strcat(X, Y) +#endif +#if !HAVE_STRNCPY +#define strncpy(X, Y, Z) strcpy(X, Y) +#endif diff --git a/H/Yatom.h b/H/Yatom.h index 3cdffe2eb..08d1dfb9b 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -38,7 +38,21 @@ INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a) { INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p); -INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); } + + + + + + + + + + + + + + + INLINE_ONLY inline EXTERN Atom AbsAtom(AtomEntry *p) { return (Atom)(p); } INLINE_ONLY inline EXTERN AtomEntry *RepAtom(Atom a); @@ -554,6 +568,7 @@ typedef uint64_t pred_flags_t; #define StatePredFlags (InUsePredFlag|CountPredFlag|SpiedPredFlag|IndexedPredFlag ) #define is_system(pe) (pe->PredFlags & SystemPredFlags) #define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag) +#define is_foreign(pe) (pe->PredFlags & ForeignPredFlags) #define is_static(pe) (pe->PredFlags & CompiledPredFlag) #define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag) #ifdef TABLING @@ -1586,7 +1601,7 @@ INLINE_ONLY EXTERN inline void AddPropToAtom(AtomEntry *ae, PropEntry *p) { INLINE_ONLY inline EXTERN const char *AtomName(Atom at); /** - * AtomName: get a string with the name of an Atom. Assumes 8 bit + * AtomName(Atom at): get a string with the name of an Atom. Assumes 8 bit *representation. * * @param at the atom @@ -1600,7 +1615,7 @@ INLINE_ONLY inline EXTERN const char *AtomName(Atom at) { INLINE_ONLY inline EXTERN const char *AtomTermName(Term t); /** - * AtomTermName: get a string with the name of a term storing an Atom. Assumes 8 + * AtomTermName(Term t): get a string with the name of a term storing an Atom. Assumes 8 *bit representation. * * @param t the atom term diff --git a/H/eval.h b/H/eval.h index 4ba8a4273..0d4a9a2a3 100644 --- a/H/eval.h +++ b/H/eval.h @@ -17,6 +17,8 @@ /** +@file eval.h + @defgroup arithmetic Arithmetic in YAP @ingroup builtins @@ -27,8 +29,6 @@ + See @ref arithmetic_operators for what arithmetic operations are supported in YAP - @tableofcontents - YAP supports several different numeric types:
  • Tagged integers

    @@ -93,14 +93,20 @@ exceptions: @exception "evaluation_error(undefined( V ), Call)" result is not defined (nan) @exception "evaluation_error(overflow( V ), Call)" result is arithmetic overflow + @tableofcontents + @secreflist @refitem is/2 @refitem isnan/1 @endsecreflist +@{ **/ +#ifndef EVAL_H +#define EVAL_H 1 + #include /* C library used to implement floating point functions */ @@ -682,3 +688,7 @@ p_plus(Term t1, Term t2 USES_REGS) { #ifndef DBL_EPSILON /* normal for IEEE 64-bit double */ #define DBL_EPSILON 0.00000000000000022204 #endif + +/// @} + +#endif diff --git a/H/heap/dglobals.h b/H/generated/dglobals.h similarity index 100% rename from H/heap/dglobals.h rename to H/generated/dglobals.h diff --git a/H/heap/dhstruct.h b/H/generated/dhstruct.h similarity index 100% rename from H/heap/dhstruct.h rename to H/generated/dhstruct.h index 79f0fe3ac..43bcf1450 100644 --- a/H/heap/dhstruct.h +++ b/H/generated/dhstruct.h @@ -120,12 +120,12 @@ #define Yap_ExecutionMode Yap_heap_regs->Yap_ExecutionMode_ +#define PredsInHashTable Yap_heap_regs->PredsInHashTable_ +#define PredHashTableSize Yap_heap_regs->PredHashTableSize_ #define PredHash Yap_heap_regs->PredHash_ #if defined(YAPOR) || defined(THREADS) #define PredHashRWLock Yap_heap_regs->PredHashRWLock_ #endif -#define PredsInHashTable Yap_heap_regs->PredsInHashTable_ -#define PredHashTableSize Yap_heap_regs->PredHashTableSize_ #define CreepCode Yap_heap_regs->CreepCode_ #define UndefCode Yap_heap_regs->UndefCode_ diff --git a/H/heap/dlocals.h b/H/generated/dlocals.h similarity index 100% rename from H/heap/dlocals.h rename to H/generated/dlocals.h index 56e3e0da2..e5b3b6f04 100644 --- a/H/heap/dlocals.h +++ b/H/generated/dlocals.h @@ -25,14 +25,14 @@ +#define LOCAL_encoding LOCAL->encoding_ +#define REMOTE_encoding(wid) REMOTE(wid)->encoding_ #define LOCAL_newline LOCAL->newline_ #define REMOTE_newline(wid) REMOTE(wid)->newline_ #define LOCAL_AtPrompt LOCAL->AtPrompt_ #define REMOTE_AtPrompt(wid) REMOTE(wid)->AtPrompt_ #define LOCAL_Prompt LOCAL->Prompt_ #define REMOTE_Prompt(wid) REMOTE(wid)->Prompt_ -#define LOCAL_encoding LOCAL->encoding_ -#define REMOTE_encoding(wid) REMOTE(wid)->encoding_ #define LOCAL_quasi_quotations LOCAL->quasi_quotations_ #define REMOTE_quasi_quotations(wid) REMOTE(wid)->quasi_quotations_ #define LOCAL_default_priority LOCAL->default_priority_ diff --git a/H/heap/h0globals.h b/H/generated/h0globals.h similarity index 100% rename from H/heap/h0globals.h rename to H/generated/h0globals.h diff --git a/H/heap/h0struct.h b/H/generated/h0struct.h similarity index 99% rename from H/heap/h0struct.h rename to H/generated/h0struct.h index 6d49462c5..ad400497a 100644 --- a/H/heap/h0struct.h +++ b/H/generated/h0struct.h @@ -120,12 +120,12 @@ EXTERNAL UInt GLOBAL_flagCount; /* Anderson's JIT */ EXTERNAL yap_exec_mode Yap_ExecutionMode; /* The Predicate Hash Table: fast access to predicates. */ +EXTERNAL UInt PredsInHashTable; +EXTERNAL uint64_t PredHashTableSize; EXTERNAL struct pred_entry **PredHash; #if defined(YAPOR) || defined(THREADS) EXTERNAL rwlock_t PredHashRWLock; #endif -EXTERNAL UInt PredsInHashTable; -EXTERNAL UInt PredHashTableSize; /* Well-Known Predicates */ EXTERNAL struct pred_entry *CreepCode; EXTERNAL struct pred_entry *UndefCode; diff --git a/H/heap/hglobals.h b/H/generated/hglobals.h similarity index 100% rename from H/heap/hglobals.h rename to H/generated/hglobals.h diff --git a/H/heap/hlocals.h b/H/generated/hlocals.h similarity index 100% rename from H/heap/hlocals.h rename to H/generated/hlocals.h index 09a4f414f..6c24edf19 100644 --- a/H/heap/hlocals.h +++ b/H/generated/hlocals.h @@ -17,10 +17,10 @@ typedef struct worker_local { // Used by the prompts to check if they are after a newline, and then a // prompt should be output, or if we are in the middle of a line. // + encoding_t encoding_; bool newline_; Atom AtPrompt_; char Prompt_[MAX_PROMPT+1]; - encoding_t encoding_; bool quasi_quotations_; UInt default_priority_; bool eot_before_eof_; diff --git a/H/heap/hstruct.h b/H/generated/hstruct.h similarity index 99% rename from H/heap/hstruct.h rename to H/generated/hstruct.h index 80024643b..066d703cc 100755 --- a/H/heap/hstruct.h +++ b/H/generated/hstruct.h @@ -120,12 +120,12 @@ /* Anderson's JIT */ yap_exec_mode Yap_ExecutionMode_; /* The Predicate Hash Table: fast access to predicates. */ + UInt PredsInHashTable_; + uint64_t PredHashTableSize_; struct pred_entry **PredHash_; #if defined(YAPOR) || defined(THREADS) rwlock_t PredHashRWLock_; #endif - UInt PredsInHashTable_; - UInt PredHashTableSize_; /* Well-Known Predicates */ struct pred_entry *CreepCode_; struct pred_entry *UndefCode_; diff --git a/H/generated/i0globals.h b/H/generated/i0globals.h new file mode 100644 index 000000000..d0086b1a5 --- /dev/null +++ b/H/generated/i0globals.h @@ -0,0 +1,4 @@ + + /* This file, iglobals.h, was generated automatically by "yap -L misc/buildlocalglobal" + please do not update, update misc/GLOBALS instead */ + diff --git a/H/iatoms.h b/H/generated/iatoms.h similarity index 100% rename from H/iatoms.h rename to H/generated/iatoms.h diff --git a/H/heap/iglobals.h b/H/generated/iglobals.h similarity index 100% rename from H/heap/iglobals.h rename to H/generated/iglobals.h diff --git a/H/heap/ihstruct.h b/H/generated/ihstruct.h similarity index 99% rename from H/heap/ihstruct.h rename to H/generated/ihstruct.h index 271a6b289..aadf30020 100644 --- a/H/heap/ihstruct.h +++ b/H/generated/ihstruct.h @@ -120,12 +120,12 @@ Yap_ExecutionMode = INTERPRETED; + PredsInHashTable = 0; + PredHashTableSize = 0; InitPredHash(); #if defined(YAPOR) || defined(THREADS) #endif - PredsInHashTable = 0; - CreepCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomCreep,1),PROLOG_MODULE)); UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp,2),PROLOG_MODULE)); diff --git a/H/heap/ilocals.h b/H/generated/ilocals.h similarity index 100% rename from H/heap/ilocals.h rename to H/generated/ilocals.h index fa53fe070..fdeae89de 100755 --- a/H/heap/ilocals.h +++ b/H/generated/ilocals.h @@ -17,10 +17,10 @@ static void InitWorker(int wid) { + REMOTE_encoding(wid) = Yap_DefaultEncoding(); REMOTE_newline(wid) = true; REMOTE_AtPrompt(wid) = AtomNil; - REMOTE_encoding(wid) = Yap_DefaultEncoding(); REMOTE_quasi_quotations(wid) = false; REMOTE_default_priority(wid) = 1200; REMOTE_eot_before_eof(wid) = false; diff --git a/H/ratoms.h b/H/generated/ratoms.h similarity index 100% rename from H/ratoms.h rename to H/generated/ratoms.h diff --git a/H/heap/rglobals.h b/H/generated/rglobals.h similarity index 100% rename from H/heap/rglobals.h rename to H/generated/rglobals.h diff --git a/H/heap/rhstruct.h b/H/generated/rhstruct.h similarity index 100% rename from H/heap/rhstruct.h rename to H/generated/rhstruct.h index bb9c39931..ea538522e 100644 --- a/H/heap/rhstruct.h +++ b/H/generated/rhstruct.h @@ -120,13 +120,13 @@ + + RestorePredHash(); #if defined(YAPOR) || defined(THREADS) #endif - - CreepCode = PtoPredAdjust(CreepCode); UndefCode = PtoPredAdjust(UndefCode); SpyCode = PtoPredAdjust(SpyCode); diff --git a/H/heap/rlocals.h b/H/generated/rlocals.h similarity index 100% rename from H/heap/rlocals.h rename to H/generated/rlocals.h diff --git a/H/tatoms.h b/H/generated/tatoms.h similarity index 100% rename from H/tatoms.h rename to H/generated/tatoms.h diff --git a/H/rheap.h b/H/rheap.h index 20b7d8467..a8e9d5abc 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -968,16 +968,16 @@ static void RestoreBallTerm(int wid) { } } -#include "heap/rglobals.h" +#include "rglobals.h" -#include "heap/rlocals.h" +#include "rlocals.h" /* restore the failcodes */ static void restore_codes(void) { CACHE_REGS HeapTop = AddrAdjust(LOCAL_OldHeapTop); -#include "heap/rhstruct.h" +#include "rhstruct.h" RestoreWorker(worker_id PASS_REGS); } diff --git a/YAP/CMakeLists.txt b/YAP/CMakeLists.txt new file mode 100644 index 000000000..1182293e9 --- /dev/null +++ b/YAP/CMakeLists.txt @@ -0,0 +1,13 @@ +cmake_minimum_required(VERSION 2.8) + +## Use the variable PROJECT_NAME for changing the target name +set( PROJECT_NAME "HelloWorld" ) + +## Set our project name +project(${PROJECT_NAME}) + +## Use all the *.cpp files we found under this folder for the project +FILE(GLOB SRCS "*.cpp" "*.c") + +## Define the executable +add_executable(${PROJECT_NAME} ${SRCS}) diff --git a/YAP/YAP.project b/YAP/YAP.project new file mode 100644 index 000000000..cb323e7bb --- /dev/null +++ b/YAP/YAP.project @@ -0,0 +1,178 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + cmake .. -DCMAKE_BUILD_TYPE=Debug -DCMAKE_EXPORT_COMPILE_COMMANDS=1 + make clean && mingw32-make -j4 + make clean + make -j4 + + + + None + $(WorkspacePath)/build-debug + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + cmake .. -G "MinGW Makefiles" -DCMAKE_BUILD_TYPE=Debug -DCMAKE_EXPORT_COMPILE_COMMANDS=1 + mingw32-make clean && mingw32-make -j4 + mingw32-make clean + mingw32-make -j4 + + + + None + $(WorkspacePath)/build-debug + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + cmake .. -DCMAKE_EXPORT_COMPILE_COMMANDS=1 + make clean && make -j4 + make clean + make -j4 + + + + None + $(WorkspacePath)/build-release + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + cmake .. -G "MinGW Makefiles" -DCMAKE_EXPORT_COMPILE_COMMANDS=1 + mingw32-make clean && mingw32-make -j4 + mingw32-make clean + mingw32-make -j4 + + + + None + $(WorkspacePath)/build-release + + + + + + + + + + + + + + + + + + + + diff --git a/YAP/main.cpp b/YAP/main.cpp new file mode 100644 index 000000000..94f3a7b86 --- /dev/null +++ b/YAP/main.cpp @@ -0,0 +1,7 @@ +#include + +int main(int argc, char **argv) +{ + std::cout << "Hello World" << std::endl; + return 0; +} diff --git a/cmake/Sources.cmake b/cmake/Sources.cmake index 71198919d..edcf9413f 100644 --- a/cmake/Sources.cmake +++ b/cmake/Sources.cmake @@ -126,26 +126,26 @@ set(C_INTERFACE_SOURCES H/compile.h H/corout.h H/dlmalloc.h - H/heap/dglobals.h - H/heap/dlocals.h - H/heap/dhstruct.h + H/generated/dglobals.h + H/generated/dlocals.h + H/generated/dhstruct.h H/eval.h H/heapgc.h - H/heap/hglobals.h - H/heap/hlocals.h - H/heap/hstruct.h - H/heap/iglobals.h - H/heap/ihstruct.h - H/heap/ilocals.h + H/generated/hglobals.h + H/generated/hlocals.h + H/generated/hstruct.h + H/generated/iglobals.h + H/generated/ihstruct.h + H/generated/ilocals.h H/index.h H/inline-only.h H/iswiatoms.h H/qly.h H/rclause.h - H/heap/rglobals.h - H/heap/rlocals.h + H/generated/rglobals.h + H/generated/rlocals.h H/rheap.h - H/heap/rhstruct.h + H/generated/rhstruct.h H/threads.h H/tracer.h H/trim_trail.h @@ -155,7 +155,9 @@ set(C_INTERFACE_SOURCES H/YapLFlagInfo.h H/YapText.h H/cut_c.h - H/iatoms.h H/ratoms.h H/tatoms.h + H/generated/iatoms.h + H/generated/ratoms.h + H/generated/tatoms.h CXX/yapdb.hh CXX/yapi.hh BEAM/eam.h BEAM/eamamasm.h diff --git a/cmake/disallow.cmake b/cmake/disallow.cmake new file mode 100644 index 000000000..5f4678947 --- /dev/null +++ b/cmake/disallow.cmake @@ -0,0 +1,18 @@ +function (disallow_intree_builds) + # Adapted from LLVM's/UTF8proc toplevel CMakeLists.txt file + if( CMAKE_SOURCE_DIR STREQUAL CMAKE_BINARY_DIR AND NOT MSVC_IDE ) + message(SYSTEM_ERROR_FATAL " + In-source builds are not allowed. Please create a directory + and run cmake from there. Building in a subdirectory is + fine, e.g.: + + mkdir build + cd build + cmake .. + + This process created the file `CMakeCache.txt' and the + directory `CMakeFiles'. Please delete them. + + ") + endif() +endfunction() diff --git a/docs/CMakeLists.txt b/docs/CMakeLists.txt index b54395933..38caa2c4d 100644 --- a/docs/CMakeLists.txt +++ b/docs/CMakeLists.txt @@ -28,10 +28,10 @@ yap.md # add a target to generate API documentation with Doxygen find_package(Doxygen) -option(WITH_DOCUMENTATION "Create and install the HTML based API documentation (requires Doxygen)" ${DOXYGEN_FOUND}) +option(WITH_DOCS "Create and install the HTML based API documentation (requires Doxygen)" ${DOXYGEN_FOUND}) -if(WITH_DOCUMENTATION) +if (WITH_DOCS) if(NOT DOXYGEN_FOUND) message(FATAL_ERROR "Doxygen is needed to build the documentation.") endif() diff --git a/docs/Doxyfile b/docs/Doxyfile index 113bf0381..b56d7949a 100644 --- a/docs/Doxyfile +++ b/docs/Doxyfile @@ -8,9 +8,9 @@ # # All text after a single hash (#) is considered a comment and will be ignored. # The format is: -# TAG = value [value, ...] +# TAG = value [value, file.] # For lists, items can also be appended using: -# TAG += value [value, ...] +# TAG += value [value, file.] # Values that contain spaces should be placed between quotes (\" \"). #--------------------------------------------------------------------------- @@ -407,7 +407,7 @@ TYPEDEF_HIDES_STRUCT = NO # code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small # doxygen will become slower. If the cache is too large, memory is wasted. The # cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range -# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# is 0file9, the default is 0, corresponding to a cache size of 2^16=65536 # symbols. At the end of a run doxygen will report the cache usage and suggest # the optimal cache size from a speed point of view. # Minimum value: 0, maximum value: 9, default value: 0. @@ -636,8 +636,8 @@ GENERATE_BUGLIST = YES GENERATE_DEPRECATEDLIST= YES # The ENABLED_SECTIONS tag can be used to enable conditional documentation -# sections, marked by \if ... \endif and \cond -# ... \endcond blocks. +# sections, marked by \if file. \endif and \cond +# file. \endcond blocks. ENABLED_SECTIONS = @@ -1094,6 +1094,7 @@ HTML_FILE_EXTENSION = .html # This tag requires that the tag GENERATE_HTML is set to YES. HTML_HEADER = + #/Users/vsc/git/yap-6.3/docs/web/bootstrap/header.html # The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each @@ -1105,6 +1106,7 @@ HTML_HEADER = # This tag requires that the tag GENERATE_HTML is set to YES. HTML_FOOTER = + #/Users/vsc/git/yap-6.3/docs/web/bootstrap/footer.html # The HTML_STYLESHEET tag can be used to specify a user-defined cascading style @@ -1118,6 +1120,7 @@ HTML_FOOTER = # This tag requires that the tag GENERATE_HTML is set to YES. HTML_STYLESHEET = + #/Users/vsc/git/yap-6.3/docs/web/bootstrap/customdoxygen.css # The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined @@ -1131,7 +1134,9 @@ HTML_STYLESHEET = # list). For an example see the documentation. # This tag requires that the tag GENERATE_HTML is set to YES. -HTML_EXTRA_STYLESHEET = /Users/vsc/git/yap-6.3/docs/solarized-light.css +HTML_EXTRA_STYLESHEET = + +# /Users/vsc/git/yap-6.3/docs/solarized-light.css # The HTML_EXTRA_FILES tag can be used to specify one or more extra images or # other source files which should be copied to the HTML output directory. Note @@ -1142,6 +1147,7 @@ HTML_EXTRA_STYLESHEET = /Users/vsc/git/yap-6.3/docs/solarized-light.css # This tag requires that the tag GENERATE_HTML is set to YES. HTML_EXTRA_FILES = + #/Users/vsc/git/yap-6.3/docs/web/bootstrap/doxy-boot.js # The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen @@ -1489,7 +1495,7 @@ MATHJAX_FORMAT = HTML-CSS # output directory using the MATHJAX_RELPATH option. The destination directory # should contain the MathJax.js script. For instance, if the mathjax directory # is located at the same level as the HTML output directory, then -# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# MATHJAX_RELPATH should be file/mathjax. The default value points to the MathJax # Content Delivery Network so you can quickly see the result without installing # MathJax. However, it is strongly recommended to install a local copy of # MathJax from http://www.mathjax.org before deployment. @@ -1886,7 +1892,7 @@ MAN_LINKS = NO # captures the structure of the code including all documentation. # The default value is: NO. -GENERATE_XML = NO +GENERATE_XML = YES # The XML_OUTPUT tag is used to specify where the XML pages will be put. If a # relative path is entered the value of OUTPUT_DIRECTORY will be put in front of @@ -2069,7 +2075,7 @@ SKIP_FUNCTION_MACROS = YES # a tag file without this location is as follows: # TAGFILES = file1 file2 ... # Adding location for the tag files is done as follows: -# TAGFILES = file1=loc1 "file2 = loc2" ... +# TAGFILES = file1=loc1 "file2 = loc2" file. # where loc1 and loc2 can be relative or absolute paths or URLs. See the # section "Linking to external documentation" for more information about the use # of tag files. diff --git a/docs/yap.md b/docs/yap.md index 02a8eb8f0..e40bf33ea 100644 --- a/docs/yap.md +++ b/docs/yap.md @@ -774,6 +774,8 @@ YAP Built-ins {#builtins} + @ref YAP_Terms + @ref InputOutput + + + @ref AbsoluteFileName + @ref YAPOS @@ -806,6 +808,9 @@ language. Next, we discuss how to use the most important ones. The YAP Library {#library} =============== +@defgroup library YAP library files +@{ + Library files reside in the library_directory path (set by the `LIBDIR` variable in the Makefile for YAP). Several files in the library are originally from the public-domain Edinburgh Prolog library. @@ -861,10 +866,14 @@ The YAP Library {#library} - @ref wgraphs - @ref wundgraphs - @ref ypp +@} The YAP Packages {#packages} ================ +@defgroup packages YAP packages files +@{ + + @ref real + @ref BDDs @@ -891,10 +900,16 @@ Leuven packages ported from SWI-Prolog: + @subpage clpqr +@} Compatibility {#swi} ============= + +@defgroup swi Compatibility +@{ + + YAP has been designed to be as compatible as possible with other Prolog systems, originally with C-Prolog\cite x and SICStus Prolog~\cite x . More recent work on YAP has striven at making YAP @@ -1075,9 +1090,15 @@ architectures. Otherwise, YAP follows IEEE arithmetic. Please inform the authors on other incompatibilities that may still exist. +@} + Foreign Language interface for YAP {#fli} ================================== +@defgroup fli Foreigd Code Interfacing + +@{ + YAP provides the user with three facilities for writing predicates in a language other than Prolog. Under Unix systems, most language implementations were linkable to `C`, and the first interface exported the YAP machinery to the C language. YAP also implements most of the SWI-Prolog foreign language interface. @@ -1088,4 +1109,9 @@ being designed to work with the swig (www.swig.orgv) interface compiler. + The @ref swi-c-interface emulates Jan Wielemaker's SWI foreign language interface. -+ The @ref yap-cplus-interface is desiged to interface with the SWI ackage \cite x Object-Oriented systems. ++ The @ref yap-cplus-interface is desiged to interface with the SWIG package by using Object-Oriented concepts + ++ The @ref LoadInterface handles the setup of foreign files + +@} + diff --git a/docs/yapdocs.yap b/docs/yapdocs.yap index e6be5829d..e1730909f 100644 --- a/docs/yapdocs.yap +++ b/docs/yapdocs.yap @@ -1820,80 +1820,10 @@ Given the packaged stream position term _StreamPosition_, unify */ -/** @pred tell(+ _S_) - - -If _S_ is a currently opened stream for output, it becomes the -current output stream. If _S_ is an atom it is taken to be a -filename. If there is no output stream currently associated with it, -then it is opened for output, and the new output stream created becomes -the current output stream. If it is not possible to open the file, an -error occurs. If there is a single opened output stream currently -associated with the file, then it becomes the current output stream; if -there are more than one in that condition, one of them is chosen. - -Whenever _S_ is a stream not currently opened for output, an error -may be reported, depending on the state of the file_errors flag. The -predicate just fails, if _S_ is neither a stream nor an atom. - - -*/ - -/** @pred telling(- _S_) - - -The current output stream is unified with _S_. - - -*/ - -/** @pred told - - -Closes the current output stream, and the user's terminal becomes again -the current output stream. It is important to remember to close streams -after having finished using them, as the maximum number of -simultaneously opened streams is 17. - - -*/ - -/** @pred see(+ _S_) - - -If _S_ is a currently opened input stream then it is assumed to be -the current input stream. If _S_ is an atom it is taken as a -filename. If there is no input stream currently associated with it, then -it is opened for input, and the new input stream thus created becomes -the current input stream. If it is not possible to open the file, an -error occurs. If there is a single opened input stream currently -associated with the file, it becomes the current input stream; if there -are more than one in that condition, then one of them is chosen. - -When _S_ is a stream not currently opened for input, an error may be -reported, depending on the state of the `file_errors` flag. If - _S_ is neither a stream nor an atom the predicates just fails. - - -*/ - -/** @pred seeing(- _S_) - - -The current input stream is unified with _S_. - - -*/ - -/** @pred seen - - -Closes the current input stream (see 6.7.). - */ /** @defgroup InputOutput_of_Terms Handling Input/Output of Terms @ingroup YAPBuiltins @@ -4244,7 +4174,7 @@ is sometimes useful. As in other Prolog systems, YAP has several primitives that allow updating Prolog terms. Note that these primitives are also backtrackable. -The `setarg/3` primitive allows updating any argument of a Prolog +The setarg/3 primitive allows updating any argument of a Prolog compound terms. The `mutable` family of predicates provides mutable variables. They should be used instead of `setarg/3`, as they allow the encapsulation of accesses to updatable diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index 8115af8e2..af648dba7 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -69,13 +69,6 @@ typedef int _Bool; #define __WINDOWS__ 1 #endif #endif -#ifndef X_API -#if (defined(_MSC_VER) || defined(__MINGW32__)) && defined(PL_KERNEL) -#define X_API __declspec(dllexport) -#else -#define X_API -#endif -#endif #include "pl-types.h" @@ -100,7 +93,7 @@ stuff. #endif #ifdef HAVE_DECLSPEC -# ifdef PL_KERNEL +# ifdef _YAP_NOT_INSTALLED_ #define PL_EXPORT(type) __declspec(dllexport) type #define PL_EXPORT_DATA(type) __declspec(dllexport) type #define install_t void diff --git a/include/YapDefs.h b/include/YapDefs.h index d253c9108..fe615a65a 100755 --- a/include/YapDefs.h +++ b/include/YapDefs.h @@ -370,7 +370,8 @@ typedef enum stream_f { RepError_Prolog_f = 0x400000, /**< handle representation error as Prolog terms */ RepError_Xml_f = 0x800000, /**< handle representation error as XML objects */ DoNotCloseOnAbort_Stream_f= 0x1000000, /**< do not close the stream after an abort event */ - Readline_Stream_f= 0x2000000 /**< the stream is a readline stream */ + Readline_Stream_f= 0x2000000, /**< the stream is a readline stream */ + FreeOnClose_Stream_f= 0x4000000 /**< the stream buffer should be releaed on close */ } estream_f; typedef uint64_t stream_flags_t; diff --git a/include/YapErrors.h b/include/YapErrors.h index 2afc8ae15..5147f4f5d 100644 --- a/include/YapErrors.h +++ b/include/YapErrors.h @@ -1,18 +1,39 @@ + +/// +/// @file YapErrors.h +/// +/// @adddtogroup YapError +/// +/// The file YapErrors.h contains a list with all the error classes known internally to the YAP system. + BEGIN_ERROR_CLASSES() +/// base case ECLASS(NO_ERROR, "no_error", 0) +/// bad domain, first argument often is the predicate. ECLASS(DOMAIN_ERROR, "domain_error", 2) +/// bad arithmetic ECLASS(EVALUATION_ERROR, "evaluation_error", 2) +/// missing object (I/O mostly) ECLASS(EXISTENCE_ERROR, "existence_error", 2) -ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0) +/// should be bound +ECLASS(INSTANTIATION_ERROR_CLASS, "instantiation_error", 0) +/// bad access, I/O ECLASS(PERMISSION_ERROR, "permission_error", 3) -ECLASS(REPRESENTATION_ERROR, "representation_error", 2) +/// something that could not be represented into a type +ECLASS(REPRESENTATION_ERROR, "representation_error", 2) +/// not enough .... ECLASS(RESOURCE_ERROR, "resource_error", 2) -ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 2) -ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2) +/// bad text +ECLASS(SYNTAX_ERROR_CLASS, "syntax_error", 1) +/// OS or internal +ECLASS(SYSTEM_ERROR_CLASS, "system_error", 2) +/// bad typing ECLASS(TYPE_ERROR, "type_error", 2) +/// should be unbound ECLASS(UNINSTANTIATION_ERROR_CLASS, "uninstantiation_error", 1) -ECLASS(EVENT, "event", 2) +/// escape hatch +ECLASS(EVENT, "event", 2) END_ERROR_CLASSES(); @@ -20,10 +41,10 @@ BEGIN_ERRORS() /* ISO_ERRORS */ -E0(YAP_NO_ERROR, NO_ERROR) +E0(YAP_NO_ERROR, NO_ERROR) /// default state E(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, DOMAIN_ERROR, - "absolute_file_name_option") + "absolute_file_name_option") E(DOMAIN_ERROR_ARRAY_OVERFLOW, DOMAIN_ERROR, "array_overflow") E(DOMAIN_ERROR_ARRAY_TYPE, DOMAIN_ERROR, "array_type") E(DOMAIN_ERROR_FILE_ERRORS, DOMAIN_ERROR, "file_errors") diff --git a/include/YapInterface.h b/include/YapInterface.h index 0132f0c7b..12de0bebf 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -20,10 +20,10 @@ @defgroup ChYInterface Foreign Language interface to YAP - +@brief Core interface to YAP. +q */ - #ifndef _yap_c_interface_h #define _yap_c_interface_h 1 @@ -31,7 +31,7 @@ #define __YAP_PROLOG__ 1 #ifndef YAPVERSION -#define YAPVERSION 60000 //> default versison +#define YAPVERSION 60000 #endif #include "YapDefs.h" @@ -40,8 +40,62 @@ #include #endif +#if HAVE_STDBOOL_H +#include +#endif + #include +/* + __BEGIN_DECLS should be used at the beginning of the C declarations, + so that C++ compilers don't mangle their names. __END_DECLS is used + at the end of C declarations. +*/ +#undef __BEGIN_DECLS +#undef __END_DECLS +#ifdef __cplusplus +# define __BEGIN_DECLS extern "C" { +# define __END_DECLS } +#else +# define __BEGIN_DECLS /* empty */ +# define __END_DECLS /* empty */ +#endif /* _cplusplus */ + +__BEGIN_DECLS + +/** + * X_API macro + * + * brif + * + * @param _WIN32 + * + * @return + */ +#if defined(_WIN32) +#if YAP_H +#define X_API __declspec(dllexport) +#else +#define X_API __declspec(dllimport) +#endif +#else +#define X_API +#endif + +#ifndef Int_FORMAT + +#if _WIN64 +#define Int_FORMAT "%I64d" +#define Int_ANYFORMAT "%I64i" +#define UInt_FORMAT "%I64u" +#else +#define Int_FORMAT "%ld" +#define Int_ANYFORMAT "%li" +#define UInt_FORMAT "%lu" +#endif + +#endif /* portable form of formatted output for Prolog terms */ + /** @defgroup c-interface YAP original C-interface @@ -79,31 +133,6 @@ system. */ -/* - __BEGIN_DECLS should be used at the beginning of the C declarations, - so that C++ compilers don't mangle their names. __END_DECLS is used - at the end of C declarations. -*/ -#undef __BEGIN_DECLS -#undef __END_DECLS -#ifdef __cplusplus -# define __BEGIN_DECLS extern "C" { -# define __END_DECLS } -#else -# define __BEGIN_DECLS /* empty */ -# define __END_DECLS /* empty */ -#endif /* _cplusplus */ - -__BEGIN_DECLS - -#if defined(_MSC_VER) && defined(YAP_EXPORTS) -#define X_API __declspec(dllexport) -#else -#define X_API -#endif - -__END_DECLS - /** * * Using the compiler: @@ -1563,68 +1592,12 @@ the future we plan to split this library into several smaller libraries */ -#define _yap_c_interface_h 1 - -#define __YAP_PROLOG__ 1 - -#ifndef YAPVERSION -#define YAPVERSION 60000 -#endif - -#include "YapDefs.h" - -#if HAVE_STDARG_H -#include -#endif - -#if HAVE_STDBOOL_H -#include -#endif - -#include - -/* - __BEGIN_DECLS should be used at the beginning of the C declarations, - so that C++ compilers don't mangle their names. __END_DECLS is used - at the end of C declarations. -*/ -#undef __BEGIN_DECLS -#undef __END_DECLS -#ifdef __cplusplus -# define __BEGIN_DECLS extern "C" { -# define __END_DECLS } -#else -# define __BEGIN_DECLS /* empty */ -# define __END_DECLS /* empty */ -#endif /* _cplusplus */ - -__BEGIN_DECLS - -#if defined(_MSC_VER) && defined(YAP_EXPORTS) -#define X_API __declspec(dllexport) -#else -#define X_API -#endif - -#ifndef Int_FORMAT - -#if _WIN64 -#define Int_FORMAT "%I64d" -#define Int_ANYFORMAT "%I64i" -#define UInt_FORMAT "%I64u" -#else -#define Int_FORMAT "%ld" -#define Int_ANYFORMAT "%li" -#define UInt_FORMAT "%lu" -#endif - -#endif /* portable form of formatted output for Prolog terms */ - /* Primitive Functions */ #define YAP_Deref(t) (t) -extern X_API YAP_Term YAP_A(int); +X_API +extern YAP_Term YAP_A(int); #define YAP_ARG1 YAP_A(1) #define YAP_ARG2 YAP_A(2) #define YAP_ARG3 YAP_A(3) @@ -2146,8 +2119,28 @@ extern X_API YAP_Term YAP_ImportTerm(char *); extern X_API int YAP_RequiresExtraStack(size_t); -extern X_API int -YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap); +/** + * YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap) + * + * @param [in] argc the number of arguments to YAP + * @param [in] argv the array of arguments to YAP + * @param [in,out] argc the array with processed settings YAP + * + * @return + *//* + * proccess command line arguments: valid switches are: + * -b boot file + * -l load file + * -L load file, followed by exit. + * -s stack area size (K) + * -h heap area size + * -a aux stack size + * -e emacs_mode -m + * -DVar=Value + * reserved memory for alloc IF DEBUG + * -P only in development versions + */ + extern X_API int YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap); extern X_API YAP_Int YAP_AtomToInt(YAP_Atom At); diff --git a/include/c_interface.c b/include/c_interface.c new file mode 100644 index 000000000..8b1378917 --- /dev/null +++ b/include/c_interface.c @@ -0,0 +1 @@ + diff --git a/include/clause_list.h b/include/clause_list.h index a7efe29f4..5268911c9 100644 --- a/include/clause_list.h +++ b/include/clause_list.h @@ -1,10 +1,4 @@ -#if defined(_MSC_VER) && defined(YAP_EXPORTS) -#define X_API __declspec(dllexport) -#else -#define X_API -#endif - struct ClauseList { @@ -14,14 +8,14 @@ struct ClauseList }; typedef struct ClauseList *clause_list_t; -X_API clause_list_t Yap_ClauseListInit(clause_list_t in); + clause_list_t Yap_ClauseListInit(clause_list_t in); -X_API int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred); -X_API void Yap_ClauseListClose(clause_list_t cl); -X_API int Yap_ClauseListDestroy(clause_list_t cl); -X_API void *Yap_ClauseListToClause(clause_list_t cl); -X_API void *Yap_ClauseListCode(clause_list_t cl); -X_API void *Yap_FAILCODE(void); + int Yap_ClauseListExtend(clause_list_t cl, void * clause, void *pred); + void Yap_ClauseListClose(clause_list_t cl); + int Yap_ClauseListDestroy(clause_list_t cl); + void *Yap_ClauseListToClause(clause_list_t cl); + void *Yap_ClauseListCode(clause_list_t cl); + void *Yap_FAILCODE(void); #define Yap_ClauseListCount(cl) ((cl)->n) diff --git a/library/examples/matrix.yap b/library/examples/mat.yap similarity index 100% rename from library/examples/matrix.yap rename to library/examples/mat.yap diff --git a/library/lammpi/CMakeLists.txt b/library/lammpi/CMakeLists.txt index ff6a134a8..c340dd8cd 100644 --- a/library/lammpi/CMakeLists.txt +++ b/library/lammpi/CMakeLists.txt @@ -82,6 +82,7 @@ if (MPI_C_FOUND) install(TARGETS yap_mpi LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) endif (MPI_C_FOUND) diff --git a/library/lineutils.yap b/library/lineutils.yap index bd237dec6..7fc826db0 100644 --- a/library/lineutils.yap +++ b/library/lineutils.yap @@ -8,7 +8,7 @@ * */ -:- module(line_utils, +:- module(lineutils, [search_for/2, search_for/3, scan_natural/3, @@ -244,7 +244,8 @@ split_unquoted(_, [], []) --> []. split_quoted( [0'"], More) --> %0'" "\"". -split_quoted( [0'\\ ,C|New], More) --> %0'" +split_quoted( [0'\\ ,C|New], More) --> + %0'" "\\", [C], split_quoted(New, More). diff --git a/library/matlab/CMakeLists.txt b/library/matlab/CMakeLists.txt index 8295d320b..69bfcbfb4 100644 --- a/library/matlab/CMakeLists.txt +++ b/library/matlab/CMakeLists.txt @@ -17,7 +17,8 @@ if (MATLAB_FOUND) target_link_libraries(matlab libYap $(MATLAB_LIBRARIES) ) install(TARGETS matlab - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) endif (MATLAB_FOUND) diff --git a/library/matrix/CMakeLists.txt b/library/matrix/CMakeLists.txt index 4544b4fea..d567f9055 100644 --- a/library/matrix/CMakeLists.txt +++ b/library/matrix/CMakeLists.txt @@ -6,5 +6,7 @@ target_link_libraries(matrix libYap) set_target_properties (matrix PROPERTIES PREFIX "") install(TARGETS matrix - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} + ) diff --git a/library/random/CMakeLists.txt b/library/random/CMakeLists.txt index 5b585c9e4..d964d6e00 100644 --- a/library/random/CMakeLists.txt +++ b/library/random/CMakeLists.txt @@ -6,5 +6,6 @@ target_link_libraries(yap_random libYap) set_target_properties (yap_random PROPERTIES PREFIX "") install(TARGETS yap_random - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/library/regex/CMakeLists.txt b/library/regex/CMakeLists.txt index 801149770..8075970ad 100644 --- a/library/regex/CMakeLists.txt +++ b/library/regex/CMakeLists.txt @@ -18,5 +18,6 @@ target_link_libraries(regexp libYap ${REGEX_SOURCES}) set_target_properties (regexp PROPERTIES PREFIX "") install(TARGETS regexp - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/library/rltree/CMakeLists.txt b/library/rltree/CMakeLists.txt index 50cc6555b..0fd6553ac 100644 --- a/library/rltree/CMakeLists.txt +++ b/library/rltree/CMakeLists.txt @@ -11,5 +11,6 @@ target_link_libraries(yap_rl libYap) set_target_properties (yap_rl PROPERTIES PREFIX "") install(TARGETS yap_rl - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/library/splay.yap b/library/splay.yap index f8ac26cc4..8dfad8d82 100644 --- a/library/splay.yap +++ b/library/splay.yap @@ -184,8 +184,6 @@ where _LeftTree_ contains all items in _Tree_ less than greater than _Key_. This operations destroys _Tree_. */ - */ - splay_access(V, Item, Val, Tree, NewTree):- bst(access(V), Item, Val, Tree, NewTree). diff --git a/library/system/CMakeLists.txt b/library/system/CMakeLists.txt index fe76e1e4b..cf1199e00 100644 --- a/library/system/CMakeLists.txt +++ b/library/system/CMakeLists.txt @@ -28,7 +28,8 @@ target_link_libraries(sys libYap) set_target_properties (sys PROPERTIES PREFIX "") install(TARGETS sys - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) configure_file ("sys_config.h.cmake" "sys_config.h" ) diff --git a/library/system/sys_config.h b/library/system/sys_config.h new file mode 100644 index 000000000..17e29d49d --- /dev/null +++ b/library/system/sys_config.h @@ -0,0 +1,31 @@ +/* Define to 1 if you have the header file. */ +#ifndef HAVE_APACHE2_UTIL_MD5_H +/* #undef HAVE_APACHE2_UTIL_MD5_H */ +#endif + +/* Define to 1 if you have the header file. */ +#ifndef HAVE_APR_1_APR_MD5_H +#define HAVE_APR_1_APR_MD5_H 1 +#endif + + +/* Define to 1 if you have the header file. */ +#ifndef HAVE_OPENSSL_MD5_H +/* #undef HAVE_OPENSSL_MD5_H */ +#endif + +/* Define to 1 if you have the header file. */ +#ifndef HAVE_OPENSSL_RIPEMD_H +/* #undef HAVE_OPENSSL_RIPEMD_H */ +#endif + +/* "Define if you have the crypt function." */ +#ifndef HAVE_CRYPT +/* #undef HAVE_CRYPT */ +#endif + +/* Define to 1 if you have the header file. */ +#ifndef HAVE_CRYPT_H +/* #undef HAVE_CRYPT_H */ +#endif + diff --git "a/OPTYap/\n" b/library/systest.yap similarity index 100% rename from "OPTYap/\n" rename to library/systest.yap diff --git a/library/tries/CMakeLists.txt b/library/tries/CMakeLists.txt index 967fff528..6066da28a 100644 --- a/library/tries/CMakeLists.txt +++ b/library/tries/CMakeLists.txt @@ -12,7 +12,8 @@ target_link_libraries(tries libYap) set_target_properties (tries PROPERTIES PREFIX "") install(TARGETS tries - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls}) set ( ITRIES_SOURCES @@ -28,5 +29,6 @@ target_link_libraries(itries libYap) set_target_properties (itries PROPERTIES PREFIX "") install(TARGETS itries - LIBRARY DESTINATION ${dlls} ) + LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index c28079154..05a0ad313 100644 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -130,12 +130,12 @@ UInt GLOBAL_flagCount Yap_InitFlags(true) RestoreFlags(GLOBAL_flagCount) yap_exec_mode Yap_ExecutionMode =INTERPRETED void /* The Predicate Hash Table: fast access to predicates. */ +UInt PredsInHashTable =0 void +uint64_t PredHashTableSize =0 void struct pred_entry **PredHash InitPredHash() RestorePredHash() #if defined(YAPOR) || defined(THREADS) rwlock_t PredHashRWLock void #endif -UInt PredsInHashTable =0 void -uint64_t PredHashTableSize =0 void /* Well-Known Predicates */ diff --git a/misc/analysis/graphs.yap b/misc/analysis/graphs.yap deleted file mode 100644 index 580a13ae7..000000000 --- a/misc/analysis/graphs.yap +++ /dev/null @@ -1,161 +0,0 @@ -pl_graphs(Dir - Mod) :- - atom( Dir ), - format(' ************* GRAPH: ~a ***********************/~n', [Dir]), - atom_concat([Dir,'/*'], Pattern), % */ - expand_file_name( Pattern, Files ), - member( File, Files ), - ( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ) -> - build_graph( File , Mod ) - ; - exists_directory( File ), - \+ atom_concat(_, '/.', File), - \+ atom_concat(_, '/..', File), - \+ atom_concat(_, '/.git', File), - pl_graphs( File - Mod ) - ), - fail. -pl_graphs(_). - -%% -% pl_graph( File, Mod) -% adds a node to the file graph and marks which files are modules -% -% main side-effect facts like edge( F0-Mod:File ) -% exported( F-M , N/A ) or exported(F- M. Op ), -% module_on ( M, File ) -% pred ( M :N/A ) -% -build_graph(F, Mod) :- - % writeln(F), - preprocess_file( F, PF ), - catch( open(PF, read, S, [scripting(true)]), _, fail ), - repeat, - nb_getval( current_module, MR ), - catch(read_term( S, T, [term_position(Pos),module(MR),comments(Cs)] ), Throw, (writeln(Throw))), - ( - T == end_of_file - -> - !,% also, clo ops defined in the module M, if M \= Mod - % ( sub_atom(F,_,_,_,'/matrix.yap') -> start_low_level_trace ; nospyall ), - close(S) - ; - stream_position_data( line_count, Pos, Line ), - maplist( comment, Cs ), - nb_setval( line, Line ), - nb_getval( current_module, MC0 ), - ( Mod == prolog -> MC = prolog ; MC = MC0 ), - get_graph( T, F, Pos, MC ), - fail - ). - - -get_graph( V , _F, _Pos, _M ) :- - var( V ), - !, - error( instantiation_error ). -get_graph( T, _F, _Pos, _M0 ) :- - var(T), - !. -get_graph( M:T, F, _Pos, _M0 ) :- !, - get_graph( T, F, _Pos, M ). -get_graph( ( M:H :- B), F, _Pos, M0 ) :- - !, - get_graph( (H :- M0:B), F, _Pos, M ). -get_graph( ( M:H --> B), F, _Pos, M0 ) :- - !, - get_graph( ( H --> M0:B), F, _Pos, M ). -get_graph( ( A, _ --> B), F, _Pos, M ) :- - get_graph( ( A --> B), F, _Pos, M ). -get_graph( (H --> B), F, _Pos, M ) :- - !, - functor( H, N, Ar), - Ar2 is Ar+2, - add_deps( B, M, M:N/Ar2, F, _Pos, 2 ). -get_graph( (H :- B), F, _Pos, M ) :- - !, - functor( H, N, Ar), - add_deps( B, M, M:N/Ar, F, _Pos, 0 ). -%% switches to new file n -get_graph( (:-include( Fs ) ), F, _Pos, M ) :- - !, - source_graphs( M, F, Fs ). -get_graph( (?- _ ), _F, _Pos, _M ) :- !. -get_graph( (:- _ ), _F, _Pos, _M ) :- !. - -source_graphs( M, F, Fs ) :- - maplist( source_graph( M, F ), Fs ), !. -source_graphs( M, F, Fs ) :- - search_file( Fs, F, pl, NF ), - build_graph( NF , M ), !. - -add_deps(V, _M, _P, _F, _Pos, _) :- - var(V), !. -add_deps(M1:G, _M, _P, _F, _Pos,L) :- - !, - always_strip_module(M1:G, M2, G2), - add_deps(G2, M2, _P, _F, _Pos, L). -add_deps((A,B), M, P, F, _Pos, L) :- - !, - add_deps(A, M, P, F, _Pos, L), - add_deps(B, M, P, F, _Pos, L). -add_deps((A;B), M, P, F, _Pos, L) :- !, - add_deps(A, M, P, F, _Pos, L), - add_deps(B, M, P, F, _Pos, L). -add_deps((A|B), M, P, F, _Pos, L) :- !, - add_deps(A, M, P, F, _Pos, L), - add_deps(B, M, P, F, _Pos, L). -add_deps((A->B), M, P, F, _Pos, L) :- !, - add_deps(A, M, P, F, _Pos, L), - add_deps(B, M, P, F, _Pos, L). -add_deps((A*->B), M, P, F, _Pos, L) :- !, - add_deps(A, M, P, F, _Pos, L), - add_deps(B, M, P, F, _Pos, L). -add_deps(once(A), M, P, F, _Pos, L) :- !, - add_deps(A, M, P, F, _Pos, L). -add_deps({A}, M, P, F, _Pos, 2) :- !, - add_deps(A, M, P, F, _Pos, 0). -add_deps([_|_], M, P, F, Pos, 2) :- - !, - put_dep( (F-M:P :- prolog:'C'/3 ), Pos ). -add_deps(String, _M, _P, _F, _Pos, _) :- string(String), !. -add_deps([], _M, _P, _F, _Pos, 2) :- !. -add_deps(!, _M, _P, _F, _Pos, _) :- !. -add_deps(true, _M, _P, _F, _Pos, 0) :- !. -add_deps(false, _M, _P, _F, _Pos, 0) :- !. -add_deps(fail, _M, _P, _F, _Pos, 0) :- !. -add_deps(repeat, _M, _P, _F, _Pos, 0) :- !. -add_deps(A, M, P, F, Pos, L) :- - % we're home, M:N/Ar -> P=M1:N1/A1 - functor(A, N, Ar0), - Ar is Ar0+L, - put_dep( ( F-M:P :- F-M:N/Ar ), Pos ). - -put_dep( (Target :- F0-M:Goal ), Pos ) :- -exported( ( F0-M:Goal :- F1-M1:N/Ar ) ), !, - %follow ancestor chain -ancestor( ( F1-M1:N/Ar :- FA-MA:NA/Ar ) ), -put_dep( ( Target :- FA-MA:NA/Ar ), Pos ). - % the base case, copying from the same module ( but maybe not same file 0. -put_dep( ( Target :- _F-M:N/Ar ) , _ ) :- -m_exists(M:N/Ar, F0), -!, -assert_new( edge( ( Target :- F0-M:N/Ar ) ) ). - % prolog is visible ( but maybe not same file ). -put_dep( ( Target :- _F-_prolog:N/Ar ), _ ) :- -m_exists(prolog:N/Ar, F0), -!, -assert_new( edge( ( Target :- F0-prolog:N/Ar ) ) ). -put_dep( ( _Target :- _F-Mod:_N/_Ar ), _Pos) :- -var( Mod ), !. -put_dep( ( Target :- F-Mod:N/Ar ), Pos) :- -atom( Mod ), -stream_position_data( line_count, Pos, Line ), -assert_new( undef( (Target :- F-Mod:N/Ar ), Line) ). - -ancestor( ( Younger :- Older) ) :- -exported( ( Mid :- Older ) ), !, -ancestor( ( Younger :- Mid) ). -ancestor( (Older :- Older) ). - -m_exists(P, F) :- private( F, P ), !. -m_exists(P, F) :- public( F, P ). diff --git a/misc/analysis/load.yap b/misc/analysis/load.yap deleted file mode 100644 index a0539e0b4..000000000 --- a/misc/analysis/load.yap +++ /dev/null @@ -1,694 +0,0 @@ -/*********************************************************** - - load a program into a graph, but do not actually consult it. - - ***********************************************************/ - -load( D, _OMAP ) :- - working_directory(_, D), - fail. -load( _, _Map ) :- - % from libraries outside the current directories - assert( node( attributes, woken_att_do/4, 'library/atts.yap', prolog ) ), - fail. -load( _ , Dirs ) :- - dirs( Dirs ), - %%% phase 1: find modules - nb_setval( current_module, user ), - nb_setval( private, false ), - nb_setval( file_entry, user:user ), - init_loop( Dirs ), - maplist( pl_interfs, Dirs ), - %%% phase 2: find C-code predicates - maplist( c_preds, Dirs ). - -dirs( Roots ) :- - member( Root-_, Roots ), -% (Root = 'OPTYap' -> start_low_level_trace ; true ), - absolute_file_name( Root, FRoot ), - rdir( FRoot ), - fail. -dirs( _Roots ). - -rdir( FRoot ) :- - absolute_file_name( FRoot, [glob(*), solutions(all), file_errors(fail)], File ), - \+ doskip( File ), - ( - file_property( File, type(directory) ) - -> - rdir( File ) - ; - assert_new( dir( FRoot, File )) - ), - fail. -rdir(_). - -c_preds(Dir - Mod) :- - atom( Dir ), - absolute_file_name( Dir, [glob(*), solutions(all), file_errors(fail)], File ), - ( ( sub_atom(File,_,_,0,'.c') - ; - sub_atom(File,_,_,0,'.i') - ; - sub_atom(File,_,_,0,'.C') - ; - sub_atom(File,_,_,0,'.cpp') - ; - sub_atom(File,_,_,0,'.icc') - ; - sub_atom(File,_,_,0,'.h') - ) -> - \+ doskip( File ), - c_file( File , Mod ) - ; - exists_directory( File ), - \+ doskip( File ), - c_preds( File - Mod ) - ), - fail. -c_preds(_). - - -c_file(F, _Mod) :- - consulted( F, _ ), - !. -c_file(F, Mod) :- - % writeln(F), - assert( consulted( F, Mod ) ), - nb_setval( current_module, Mod ), - open(F, read, S, [alias(c_file)]), - repeat, - read_line_to_string( S, String ), - ( String == end_of_file - -> - !, - close(S) - ; - sub_string(String, _, _, _, `PL_extension`), - %writeln(Fields), - c_ext(S, Mod, F), - fail - ; - split_string(String, `,; ()\t\"\'`, Fields), %' - %writeln(Fields), - line_count(S, Lines), - c_line(Fields , Mod, F:Lines), - fail - ). - -c_line([`}`], Mod, _) :- !, - nb_setval( current_module, Mod ). -c_line(Line, _Mod, _) :- - append( _, [ `CurrentModule`, `=`, M|_], Line), - system_mod(M, _Mod, Mod, _), - nb_setval( current_module, Mod ). -c_line(Line, Mod, F: LineP) :- - break_line( Line, N/A, Fu), - assert( node( Mod, N/A, F-LineP, Fu ) ), - handle_pred( Mod, N, A, F ). - -c_ext( S, Mod, F ) :- - repeat, - read_line_to_string( S, String ), - ( - sub_string( String, _, _, _, `NULL` ), - ! - ; - split_string(String, `,; (){}\t\"\'`, [`FRG`, NS,AS,FS|_]), %' - atom_string(N,NS), - atom_string(Fu,FS), - number_string(A, AS), - stream_property( S, position( Pos ) ), - stream_position_data( line_count, Pos, Line ), - assert( node( Mod , N/A, F-Line, Fu ) ), - handle_pred( Mod, N, A, F ) - ; - split_string(String, `,; (){}\t\"\'`, [NS,AS,FS|_]), %' - atom_string(N,NS), - atom_string(Fu,FS), - number_string(A, AS), - stream_property( S, position( Pos ) ), - stream_position_data( line_count, Pos, Line ), - Line0 is Line-1, - assert( node( Mod, N/A, F-Line0, Fu ) ), - handle_pred( Mod, N, A, F ) - ). - - -break_line( Line, N/A, c(Fu)) :- - take_line( Line, NS, AS, FS ), !, - atom_string(N,NS), - atom_string(Fu,FS), - number_string(A, AS). -break_line( Line, N/A, swi(Fu)) :- - take_line( Line, NS, AS, FS ), !, - atom_string(N,NS), - number_string(A, AS), - atomic_concat([`pl_`,FS,`_`,A,`_va`], Fu). -break_line( Line, N/A, bp(Fu)) :- - take_line( Line, NS, AS, FS ), !, - atom_string(N,NS), - number_string(A, AS), - atomic_concat([`pc_`,FS,`_`,A], Fu). -break_line( Line, N/A, c(FuE, FuB)) :- - take_line( Line, NS, AS, FSE, FSB ), !, - atom_string(N,NS), - atom_string(FuE,FSE), - atom_string(FuB,FSB), - number_string(A, AS). - -take_line( Line, NS, AS, FS ) :- - append( _, [ `Yap_InitCPred`, NS, AS, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `Yap_InitAsmPred`, NS, AS, _, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `Yap_InitCmpPred`, NS, AS, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `YAP_UserCPredicate`, NS, FS, AS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `PRED`, NS0, AS, FS|_], Line), !, - append( [`pl_`, NS0, AS, `_va`], NS ). -take_line( Line, NS, AS, FS ) :- - append( _, [ `PRED_IMPL`, NS0, AS, FS|_], Line), !, - append( [`pl_`, NS0, AS, `_va`], NS ). -take_line( Line, NS, AS, FS ) :- - append( _, [ `PL_register_foreign`, NS, AS, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `PRED_DEF`, NS0, AS, FS|_], Line), !, - append( [`pl_`, NS0, AS, `_va`], NS ). -take_line( Line, NS, AS, FS ) :- - append( _, [ `FRG`, NS, AS, FS|_], Line), !. - % from odbc -take_line( Line, NS, AS, FS ) :- - append( _, [ `NDET`, NS, AS, FS|_], Line), !. -take_line( Line, NS, AS, FS ) :- - append( _, [ `DET`, NS, AS, FS|_], Line), !. - - -take_line( Line, AS, FS ) :- - append( _, [ `REGISTER_CPRED`, FS, AS], Line), !. - - -take_line( Line, NS, AS, FSE, FSB ) :- - append( _, [ `Yap_InitCPredBack`, NS, AS, _, FSE, FSB|_], Line), !. - -system_mod(`ATTRIBUTES_MODULE`, _, attributes, user ). -system_mod(`HACKS_MODULE`, _, '$hacks' , sys ). -system_mod(`USER_MODULE`, _, user, user ). -system_mod(`DBLOAD_MODULE`, _, '$db_load', sys ). -system_mod(`GLOBALS_MODULE`, _, globals, sys ). -system_mod(`ARG_MODULE`, _, arg, sys ). -system_mod(`PROLOG_MODULE`, _ , prolog, sys ). -system_mod(`RANGE_MODULE`, _, range, user ). -system_mod(`SWI_MODULE`, _, swi, sys ). -system_mod(`OPERATING_SYSTEM_MODULE`, _, system , sys ). -system_mod(`TERMS_MODULE`, _, terms , sys). -system_mod(`SYSTEM_MODULE`, _, system, sys ). -system_mod(`IDB_MODULE`, _, idb, user ). -system_mod(`CHARSIO_MODULE`, _, charsio, sys ). -system_mod(`cm`, M, M, user ). - -call_c_files( File, Mod, _Fun, [CFile] ) :- - search_file( CFile, File, c, F ), - c_file(F, Mod). -call_c_files( File, Mod, _Fun, CFile ) :- - CFile \= [_|_], - search_file( CFile, File, c, F ), - c_file(F, Mod). - - -pl_interfs(Dir - Mod) :- - \+ doskip( Dir ), - format('% ************* ~a\n', [Dir]), - nb_setval( current_module, Mod ), - atom( Dir ), - directory_files( Dir , Files), - member( File, Files ), - atom_concat([Dir,'/',File], Path), - ( ( sub_atom(File,_,_,0,'.yap') ; sub_atom(File,_,_,0,'.pl') ; sub_atom(File,_,_,0,'.ypp') ) -> - ops_restore, - absolute_file_name( Path, APath ), - pl_interf( APath , Mod ) - ; - exists_directory( Path ), - \+ atom_concat(_, '/.', Path), - \+ atom_concat(_, '/..', Path), - \+ atom_concat(_, '/.git', Path), - absolute_file_name( Path, APath ), - \+ doskip( APath ), - pl_interfs( APath - Mod ) - ), - fail. -pl_interfs(_). - -%% - % pl_interf( File, Mod) - % adds a node to the file graph and marks which files are modules - % - % main side-effect facts like edge( F0-Mod:File ) - % exported( ( FMNATarget :- FMNASource ) ) ou exported(F-M, Op ), - % module_on ( M, File ) - % -pl_interf(F, _Mod) :- - module_on( F , _M, _Is), - !. -pl_interf(F, Mod) :- - consulted(F, Mod ), - !. -pl_interf(F, Mod) :- - % ( sub_atom(F,_,_,_,'matrix.yap') -> spy get_interf ; true ), - % ( sub_atom( F, _, _, 0, 'gecode.yap' ) -> spy user_deps; true ), - assert_new(consulted(F, Mod ) ), - nb_getval( private, Default ), - nb_setval( private, false ), - nb_getval( file_entry, OF:OMod ), - nb_setval( file_entry, F:Mod ), - preprocess_file( F, PF ), - catch( open(PF, read, S, [scripting(true)]) , _, fail ), - repeat, - nb_getval( current_module, MR ), - %( sub_atom(F,_,_,_,'e.yap') -> spy get_interf ; nospyall ), - catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (ypp(F,Throw), fail)), - ( - T == end_of_file - -> - !, - close(S), - ( - c_dep( F, Fc), - c_file( Fc, MR ), - fail - ; - build_graph( F, MR ), - fail - % cleanup - ; - module_on( F , _M, _Is) - -> - % also, close ops defined in the module M, if M \= Mod - nb_setval( current_module, Mod ), - nb_setval( private, Default ), - nb_setval( file_entry, OF:OMod ) - ; - true - ) - ; - nb_getval( current_module, MC0 ), - stream_position_data( line_count, Pos, Line ), - nb_setval( line, Line ), - ( Mod == prolog -> MC = prolog ; MC = MC0 ), - get_interf( T, F, MC ), - fail - ). - -get_interf( T, _F, _M0 ) :- - var(T), - !. -get_interf( T, _F, _M0 ) :- - % ( T = (:- op(_,_,_)) -> trace ; true ), - var(T), - !. -get_interf( M:T, F, _M0 ) :- !, - get_interf( T, F, M ). -get_interf( goal_expansion(G, M, _) , F, _M0 ) :- - nonvar( G ), - !, - ( var( M ) -> M1 = prolog ; M = M1 ), - functor( G, N, A ), - handle_pred( M1, N, A, F ). -get_interf( goal_expansion(G, _) , F, _M0 ) :- - nonvar( G ), - !, - functor( G, N, A ), - handle_pred( prolog, N, A, F ). -get_interf( ( M:H :- _B), F, _M ) :- -!, -get_interf( H, F, M ). -get_interf( ( goal_expansion(G, M, _) :- _) , F, _M0 ) :- -nonvar( G ), -!, -( var( M ) -> M1 = prolog ; M = M1 ), -functor( G, N, A ), -handle_pred( M1, N, A, F ). -get_interf( ( goal_expansion(G, _) :- _) , F, _M0 ) :- -nonvar( G ), -!, -functor( G, N, A ), -handle_pred( prolog, N, A, F ). -get_interf( ( M:H --> _B), F, _ ) :- -!, -get_interf( ( H --> _B), F, M ). -get_interf( ( A, _ --> _B), F, M ) :- -get_interf( ( A --> _B), F, M ). -get_interf( (H --> _B), F, M ) :- -!, -functor( H, N, Ar), -Ar2 is Ar+2, -functor( H2, N, Ar2), -get_interf( H2, F, M ). -get_interf( (H :- _B), F, M ) :- -!, -get_interf( H, F, M ). -%% switches to new file n -get_interf( (:- V ), _F, _M ) :- -var( V ), -!. -get_interf( (:- module( NM, Is ) ), F, _M ) :- -!, -assert(module_file( F, NM ) ), -nb_setval( current_module, NM ), -assert( module_on( F , NM, Is) ), -maplist( public(F, NM), Is ), -nb_setval( private, true ). -get_interf( (:- reexport( Loc, Is ) ), F, M ) :- -!, - % find the file -search_file( Loc, F, pl, NF ), -include_files( F, M, Is, NF ), - % extend the interface.rg -retract( module_on( F , M, Is0) ), -append( Is0, Is, NIs ), -assert( module_on( F , M, NIs) ), -maplist( public(F, M), NIs ). -get_interf( (:- use_module( Loc, Is ) ), F, M ) :- !, -!, -include_files( F, M, Is, Loc ). -get_interf( (:- use_module( Loc ) ), F, M ) :- !, -!, -include_files( F, M, Loc ). - % nb_getval(current_module,MM), writeln(NM:MM:M). -get_interf( (:- use_module( Loc, Is, _ ) ), F, M ) :- !, -!, -include_files( F, M, Is, Loc ). -get_interf( (:- consult( Files ) ), F, M ) :- -!, -include_files( F, M, Files ). -get_interf( (:- reconsult( Files ) ), F, M ) :- -!, -include_files( F, M, Files ). -get_interf( (:- ensure_loaded( Files ) ), F, M ) :- -!, -include_files( F, M, Files ). -get_interf( (:- include( Files ) ), F, M ) :- -!, -source_files( F, M, Files ). -get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :- -!, -include_files( F, M, Files ). -get_interf( ( :- ( G -> _ ; _ ) ) , F, M) :- -!, -get_interf( (:- G ) , F, M). -get_interf( (:- catch( G , _, _ ) ) , F, M) :- -!, -get_interf( (:- G ) , F, M). -get_interf( (:- initialization( G , now ) ) , F, M) :- -!, -get_interf( (:- G ) , F, M). -get_interf( (:- load_files( Files , [_|_] ) ), F, M ) :- -!, -include_files( F, M, Files ). -get_interf( (:- [F1|Fs] ), F, M ) :- -!, -include_files( F, M, [F1|Fs] ). - % don't actually use this one. -get_interf( (:- load_foreign_files(Fs, _, Fun) ), F, M ) :- -!, -call_c_files( F, M, Fun, Fs ). -get_interf( (:- load_foreign_library(F) ), F0, M ) :- -!, -always_strip_module(M:F, M1, F1), -call_c_files( F0, M1, '', F1 ). -get_interf( (:- load_foreign_library(F,Fun) ), F0, M ) :- -!, -always_strip_module(M:F, M1, F1), -call_c_files( F0, M1, Fun, F1 ). -get_interf( (:- use_foreign_library(F) ), F0, M ) :- -!, -always_strip_module(M:F, M1, F1), -call_c_files( F0, M1, '', F1 ). -get_interf( (:- system_module( _NM, _Publics, _Hiddens) ), _F, _M ) :- -!. -get_interf( (:- style_checker( _ ) ), _F, _M ) :- -!. -get_interf( (:- dynamic T), F, M ) :- -!, -declare_functors( T, F, M ). -get_interf( (:- multifile T), F, M ) :- % public? -!, -declare_functors( T, F, M ). -get_interf( (:- meta_predicate T), F, M ) :-!, -declare_terms( T, F, M ), % public? -!. -get_interf( (:- '$install_meta_predicate'( H, M) ), F, __M ) :- -!, -declare_functors( H, F, M ). -get_interf( (:- thread_local T), F, M ) :- -!, -declare_functors( T, F, M ). -get_interf( (:- op( X, Y, Z) ), F, M ) :- -!, -always_strip_module(M:Z, M1, Z1), -handle_op( F, M1, op( X, Y, Z1) ). -get_interf( (:- record( Records ) ), F, M ) :- -!, -handle_record( Records, F, M). -get_interf( (:- set_prolog_flag(dollar_as_lower_case,On) ), _F, _M ) :- -!, -set_prolog_flag(dollar_as_lower_case,On). -get_interf( (:- _ ), _F, _M ) :- !. -get_interf( (?- _ ), _F, _M ) :- !. -get_interf( V , _F, _M ) :- - var( V ), - !, - error( instantiation_error ). -get_interf( G , F, M ) :- - functor( G, N, A), - handle_pred( M, N, A, F ), - !. - - % support SWI package record -handle_record( (Records1, Records2), F, M ) :- - !, - handle_record( Records1, F, M ), - handle_record( Records2, F, M ). -handle_record( Record, F, M ) :- - Record =.. [Constructor|Fields], - atom_concat(Constructor, '_data', Data), - handle_pred( M, Data, 3, F), - atom_concat(default_, Constructor, New), - handle_pred( M, New, 1, F), - atom_concat(is_, Constructor, Is), - handle_pred( M, Is, 1, F), - atom_concat(make_, Constructor, Make), - handle_pred( M, Make, 2, F), - handle_pred( M, Make, 3, F), - atom_concat([set_, Constructor,'_fields'], Sets), - handle_pred( M, Sets, 3, F), - handle_pred( M, Sets, 4, F), - atom_concat([set_, Constructor,'_field'], Set), - handle_pred( M, Set, 3, F), - maplist( handle_record_field( Constructor, F, M) , Fields ). - -handle_record_field( Constructor, F, M, Name:_=_ ) :- - !, - handle_record_field_name( Constructor, F, M, Name). -handle_record_field( Constructor, F, M, Name:_ ) :- - !, - handle_record_field_name( Constructor, F, M, Name). -handle_record_field( Constructor, F, M, Name=_ ) :- - !, - handle_record_field_name( Constructor, F, M, Name). -handle_record_field( Constructor, F, M, Name ) :- - handle_record_field_name( Constructor, F, M, Name). - -handle_record_field_name( Constructor, F, M, Name) :- - atom_concat([ Constructor,'_', Name], Val), - handle_pred( M, Val, 2, F), - atom_concat([ set_, Name, '_of_', Constructor ], Set), - handle_pred( M, Set, 3, F), - handle_pred( M, Set, 2, F), - atom_concat([ nb_set_, Name, '_of_', Constructor ], Set), - handle_pred( M, Set, 3, F), - handle_pred( M, Set, 2, F). - -handle_pred( M, N, A, F ) :- - ( - system_mod( _, _, M, sys ) - -> - ( - atom_concat('$',_,N) - -> - private( F, M, N/A ) - ; - public( F, M, N/A ) - ) - ; - ( nb_getval( private, false ) - -> - public( F, M, N/A ) - ; - private( F, M, N/A ) - ) - ). - -handle_op( F, M, Op ) :- - ( nb_getval( private, false ) - -> - public( F, M, Op ) - ; - private( F, M, Op ) - ), - Op = op(X, Y, Z ), - ( ( M == user ; M == prolog ) - -> - op( X, Y, prolog:Z ) - ; - op( X, Y, M:Z ) - ). - -exported( NF, F, NM, M, op(X,Y,Z)) :- - !, - public( NF , NM:op(X,Y,Z) ), - handle_op( F, M , op(X,Y,Z) ). -exported( NF, F, NM, M, N/A) :- !, - % sink no more - retractall( exported(( _ :- F-M:N/A) ) ), - assert_new( exported( (F-M:N/A :- NF-NM:N/A )) ). -exported( NF, F, NM, M, N/A as NN) :- !, - % sink no more - retractall( exported(( _ :- F-M:N/A) ) ), - assert_new( exported( ( F-M:NN/A :- NF-NM:N/A ) ) ). -exported( NF, F, NM, M, N//A) :- !, - A2 is A+2, - % sink no more - retractall( exported(( _ :- F-M:N/A2) ) ), - assert_new( exported( (F-M:N/A2 :- NF-NM:N/A2) ) ). -exported( NF, F, NM, M, N//A as NN) :- !, - A2 is A+2, - % sink no more - retractall( exported(( _ :- F-M:N/A2) ) ), - assert_new( exported( ( F-M:NN/A2 :- NF-NM:N/A2 )) ). - -import_publics( F, ProducerMod, ConsumerMod ) :- - public(F, ProducerMod:op(X,Y,Z) ), - handle_op( F, ConsumerMod, op(X,Y,Z) ), - fail. -import_publics( _F, _ProducerMod, _ConsumerMod ). - -all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :- - public(ProducerFile, ProducerMod:op(X,Y,Z) ), - handle_op( ConsumerFile, ConsumerMod, op(X,Y,Z) ), - fail. -all_imported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod ) :- - public(ProducerFile, ProducerMod:N/A ), - exported( ProducerFile, ConsumerFile, ProducerMod, ConsumerMod, N/A ), - fail. -all_imported( _ProducerFile, _ConsumerFile, _ProducerMod, _ConsumerMod ). - - -include_files( F, M, Files ) :- - include_files( F, M, _Is, Files ). - -include_files( F, M, Is, Files ) :- - maplist( include_files( F, M, Is ), Files ), - !. -include_files( F, M, Is, -Files ) :- - !, - include_files( F, M, Is, Files). -include_files( F, M, Is, Files ) :- - !, - always_strip_module(M:Files, M1, NFiles), - include_file( F, M1, Is, NFiles ). -include_files( F, M, Is, Loc ) :- - include_file( F, M, Is, Loc ). - -include_file( F, M, Is, Loc ) :- - is_list( Loc ), !, - maplist( include_file( F, M, Is), Loc ). -include_file( F, M, Is0, Loc ) :- - nb_getval( private, Private ), - % find the file - once( search_file( Loc, F, pl, NF ) ), - % depth visit - pl_interf(NF, M), % should verify Is in _Is - % link b - ( module_on(NF, NM, Is) - -> - ( var(Is0) -> Is = Is0 ; true ), - maplist( exported( NF, F, NM, M) , Is0 ) - ; - all_imported( NF, F, NM, M) - ), - nb_setval( private, Private ). - - -source_files( F, M, Files ) :- - maplist( source_files( F, M ), Files ), - !. -source_files( F, M, Loc ) :- - source_file( F, M, Loc ). - -source_file( F, M, Loc ) :- - once( search_file( Loc, F, pl, NF ) ), - % depth visit - pl_source(NF, F, M). % should verify Is in _Is - -pl_source(F, F0, Mod) :- - % writeln( -F ), - preprocess_file( F, PF ), - catch( open(PF, read, S, []) , _, fail ), - repeat, - nb_getval( current_module, MR ), - %( sub_atom(F,_,_,_,'examples/matrix.yap') -> spy get_interf ; nospyall ), - catch( read_term( S, T, [module( MR ),term_position(Pos)] ), Throw, (writeln(F:MR:Throw), break, fail)), - ( - T == end_of_file - -> - !, - close(S) - ; - nb_getval( current_module, MC0 ), - stream_position_data( line_count, Pos, Line ), - nb_setval( line, Line ), - ( Mod == prolog -> MC = prolog ; MC = MC0 ), - get_interf( T, F0, MC ), - fail - ). - -declare_functors( T, _F, _M1) :- var(T), !, - error( unbound_variable ). -declare_functors( M:T, F, _M1) :- !, - declare_functors( T, F, M). -declare_functors( (T1,T2), F, M1) :- !, - declare_functors( T1, F, M1), - declare_functors( T2, F, M1). -declare_functors( Ts, F, M1) :- - maplist( declare_functor( F, M1), Ts ), !. -declare_functors( T, F, M1) :- - declare_functor( F, M1, T). - -declare_functor(File, M, N/A) :- - handle_pred( M, N, A, File ). - -declare_terms( T, _F, _M1) :- var(T), !, - error( unbound_variable ). -declare_terms( M:T, F, _M1) :- !, - declare_functors( T, F, M). -declare_terms( (N1,N2), F, M) :- - number(N1), - number(N2), - !, - declare_term( F, M, (N1,N2)). -declare_terms( (T1,T2), F, M1) :- !, - declare_terms( T1, F, M1), - declare_terms( T2, F, M1). -declare_terms( Ts, F, M1) :- - maplist( declare_term( F, M1), Ts ), !. -declare_terms( T, F, M1) :- - declare_term( F, M1, T). - -declare_term(F, M, S) :- - functor(S, N, A), - handle_pred( M, N, A, F ). diff --git a/misc/buildatoms b/misc/buildatoms index 3d650014f..7aba1cc13 100644 --- a/misc/buildatoms +++ b/misc/buildatoms @@ -13,9 +13,9 @@ main :- warning(Warning), - file_filter_with_init('misc/ATOMS','H/tatoms.h',gen_fields, Warning, ['tatoms.h']), - file_filter_with_init('misc/ATOMS','H/iatoms.h',gen_decl, Warning, ['iatoms.h']), - file_filter_with_init('misc/ATOMS','H/ratoms.h',gen_rcov, Warning, ['ratoms.h']). + file_filter_with_init('misc/ATOMS','H/heap/tatoms.h',gen_fields, Warning, ['tatoms.h']), + file_filter_with_init('misc/ATOMS','H/heap/iatoms.h',gen_decl, Warning, ['iatoms.h']), + file_filter_with_init('misc/ATOMS','H/heap/ratoms.h',gen_rcov, Warning, ['ratoms.h']). warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildatoms\"~n please do not update, update misc/ATOMS instead */~n~n'). diff --git a/misc/buildlocalglobal b/misc/buildlocalglobal index b16b6a3ff..a060ae784 100644 --- a/misc/buildlocalglobal +++ b/misc/buildlocalglobal @@ -30,7 +30,7 @@ main :- file_filter_with_initialization('misc/GLOBALS','H/heap/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']), file_filter_with_initialization('misc/GLOBALS','H/heap/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']), file_filter_with_initialization('misc/GLOBALS','H/heap/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']), - file_filter_with_initialization('misc/GLOBALS','H/heap/i0globals.h',gen_0init,Warning,['iglobals.h','GLOBALS']), +%% file_filter_with_initialization('misc/GLOBALS','H/heap/i0globals.h',gen_0init,Warning,['iglobals.h','GLOBALS']), file_filter_with_initialization('misc/LOCALS','H/heap/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']), file_filter_with_initialization('misc/LOCALS','H/heap/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']), file_filter_with_initialization('misc/LOCALS','H/heap/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']), diff --git a/misc/prolog.el b/misc/prolog.el index 75258756f..8f34a29b5 100644 --- a/misc/prolog.el +++ b/misc/prolog.el @@ -449,8 +449,8 @@ Legal values: "use_module" "volatile")) (yap ("block" "char_conversion" "discontiguous" "dynamic" "encoding" - "ensure_loaded" "export" "expects_dialect" "export_list" "import" - "meta_predicate" "module" "module_transparent" "multifile" "require" + "ensure_loaded" "export" "expects_dialect" "meta_predicate" "module" + "module_transparent" "multifile" "reexport" "table" "thread_local" "use_module" "wait")) (gnu ("built_in" "char_conversion" "discontiguous" "dynamic" "ensure_linked" @@ -652,7 +652,7 @@ nil means send actual operating system end of file." '((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:") (sicstus "| [ ?][- ] *") (swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") - (yap "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") + (yap "| [ ?][- ] *") (t "^ *\\?-")) "*Alist of prompts of the prolog system command line." :group 'prolog-inferior diff --git a/os/CMakeLists.txt b/os/CMakeLists.txt index f05d49a72..db549a2d3 100644 --- a/os/CMakeLists.txt +++ b/os/CMakeLists.txt @@ -36,14 +36,15 @@ set (YAPOS_HEADERS include_directories (../H ../include ../OPTYap . ${GMP_INCLUDE_DIR} ${PROJECT_BINARY_DIR}) + option (READLINE "GNU readline console" ON) + if (READLINE) + macro_optional_find_package (Readline ON) + macro_log_feature (READLINE_FOUND "libreadline" + "Readline line editing library" + "http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html") -macro_optional_find_package (Readline ON) -macro_log_feature (READLINE_FOUND "libreadline" - "Readline line editing library" - "http://cnswww.cns.cwru.edu/php/chet/readline/rltop.html") - -if (READLINE_FOUND) + if (READLINE_FOUND) # - Find the readline library # This module defines # READLINE_INCLUDE_DIR, path to readline/readline.h, etc. @@ -57,6 +58,8 @@ if (READLINE_FOUND) set(YAP_SYSTEM_OPTIONS "readline " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${READLINE_LIBRARIES} ) + check_library_exists( readline readline "" HAVE_LIBREADLINE ) + check_include_files( "stdio.h;readline/readline.h" HAVE_READLINE_READLINE_H ) check_include_files( "stdio.h;readline/history.h" HAVE_READLINE_HISTORY_H ) if (HAVE_READLINE_READLINE_H) @@ -80,6 +83,8 @@ if (READLINE_FOUND) endif() endif (READLINE_FOUND) +endif (READLINE) + set (POSITION_INDEPENDENT_CODE TRUE) add_library (libYAPOs OBJECT @@ -102,5 +107,4 @@ configure_file ("${PROJECT_SOURCE_DIR}/os/YapIOConfig.h.cmake" set( READLINE_LIBS ${READLINE_LIBRARIES} PARENT_SCOPE) - #set( CMAKE_REQUIRED_LIBRARIES ${CMAKE_REQUIRED_LIBRARIES} ${GMP_LIBRARIES} ) diff --git a/os/YapIOConfig.h.cmake b/os/YapIOConfig.h.cmake index f374e1916..b5ab16c19 100644 --- a/os/YapIOConfig.h.cmake +++ b/os/YapIOConfig.h.cmake @@ -1,6 +1,6 @@ /* Define if you have libreadline */ #ifndef HAVE_LIBREADLINE -#cmakedefine USE_READLINE ${USE_READLINE} +#cmakedefine HAVE_LIBREADLINE ${HAVE_LIBREADLINE} #endif /* Define to 1 if you have the header file. */ @@ -10,7 +10,11 @@ /* Define to 1 if you have the header file. */ #ifndef HAVE_READLINE_READLINE_H -#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H} +#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H} +#endif + +#if defined(HAVE_LIBREADLINE) && defined(HAVE_READLINE_READLINE_H) +#define USE_READLINE 1 #endif /* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if diff --git a/os/alias.c b/os/alias.c index a528e91e7..d4b403cb4 100644 --- a/os/alias.c +++ b/os/alias.c @@ -30,8 +30,8 @@ static char SccsId[] = "%W% %G%"; /** - * @group - * + * @defgroup Aliases + * @ingroup InputOutput * * Aliases: * This file defines the main operations on aliases, a second name for a file. Aliases are always diff --git a/os/charsio.c b/os/charsio.c index 4761e2e64..165eaead5 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -105,7 +105,10 @@ Int Yap_peek(int sno) { Int ch; s = GLOBAL_Stream + sno; - if (s->status & Readline_Stream_f) { +#if USE_READLINE + if (s->status & Readline_Stream_f + && trueGlobalPrologFlag(READLINE_FLAG) + ) { ch = Yap_ReadlinePeekChar(sno); if (ch == EOFCHAR) { s->stream_getc = EOFPeek; @@ -114,6 +117,7 @@ Int Yap_peek(int sno) { } return ch; } +#endif ocharcount = s->charcount; olinecount = s->linecount; olinepos = s->linepos; @@ -155,6 +159,7 @@ Int Yap_peek(int sno) { ungetc(c / 1 << 16, s->file); c %= 1 << 16; } + return c; } else if (s->encoding == ENC_UTF16_LE) { /* do the ungetc as if a write .. */ unsigned long int c = ch; @@ -238,7 +243,9 @@ static Int at_end_of_stream_0(USES_REGS1) { /* at_end_of_stream */ } static int yap_fflush(int sno) { +#if USE_READLINE Yap_ReadlineFlush(sno); +#endif if ((GLOBAL_Stream[sno].status & Output_Stream_f) && !(GLOBAL_Stream[sno].status & (Null_Stream_f | InMemory_Stream_f | Socket_Stream_f | Pipe_Stream_f | @@ -601,7 +608,7 @@ static Int put_char(USES_REGS1) { /* '$put'(Stream,N) */ return (TRUE); } -/** @pred tab(+ _N_) +/** @pred tab_1(+ _N_) Outputs _N_ spaces to the current output stream. diff --git a/os/chartypes.c b/os/chartypes.c index f8a9bdaa6..a2f047704 100644 --- a/os/chartypes.c +++ b/os/chartypes.c @@ -31,6 +31,10 @@ static char SccsId[] = "%W% %G%"; /// @addtogroup CharProps +/** + * @defgroup CharIO Character-Based Input/Output + * @ingroup InputOutput + */ /* * This file includes the definition of a character properties. diff --git a/os/console.c b/os/console.c index 02c05a344..42b09b13e 100644 --- a/os/console.c +++ b/os/console.c @@ -18,36 +18,23 @@ static char SccsId[] = "%W% %G%"; #endif +/** + * @file console.c + * @author VITOR SANTOS COSTA + * @date Wed Jan 20 00:56:23 2016 + * + * @brief + * + * + */ /* * This file includes the interface to the console IO, tty style. Refer also to the readline library. - * + * @defgroup console Support for console-based interaction. + * @ingroup InputOutput + */ -#include "Yap.h" -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#include -#if HAVE_UNISTD_H -#include -#endif -#if HAVE_STDARG_H -#include -#endif -#ifdef _WIN32 -#if HAVE_IO_H -/* Windows */ -#include -#endif -#if HAVE_SOCKET -#include -#endif -#include -#ifndef S_ISDIR -#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) -#endif -#endif -#include "iopreds.h" +#include "sysbits.h" static Int prompt( USES_REGS1 ); static Int prompt1( USES_REGS1 ); @@ -83,7 +70,8 @@ is_same_tty(FILE *f1, FILE *f2) #if HAVE_TTYNAME return(ttyname(fileno(f1)) == ttyname(fileno(f2))); #else - return; + // assume a single console, for now + return true; #endif } @@ -103,14 +91,18 @@ is_same_tty2 (USES_REGS1) void Yap_ConsoleOps( StreamDesc *s ) { + Yap_DefaultStreamOps( s ); /* the putc routine only has to check it is putting out a newline */ s->stream_putc = ConsolePutc; +#if USE_READLINE /* if a tty have a special routine to call readline */ - if (!Yap_ReadlineOps( s )) { - /* else just PlGet plus checking for prompt */ - s->stream_getc = ConsoleGetc; - } - Yap_DefaultStreamOps( s ); + if (( s->status & Readline_Stream_f) && + trueGlobalPrologFlag(READLINE_FLAG) ) { + if (Yap_ReadlineOps( s )) + return; + } +#endif + s->stream_getc = ConsoleGetc; } /* static */ @@ -144,7 +136,7 @@ ConsoleGetc(int sno) /* keep the prompt around, just in case, but don't actually show it in silent mode */ if (LOCAL_newline) { - if (silentMode()) { + if (!silentMode()) { char *cptr = LOCAL_Prompt, ch; /* use the default routine */ @@ -181,6 +173,13 @@ ConsoleGetc(int sno) return console_post_process_read_char(ch, s); } +/** @pred prompt1(+ _A__) + + +Changes YAP input prompt for the . + + +*/ static Int prompt1 ( USES_REGS1 ) @@ -198,7 +197,13 @@ prompt1 ( USES_REGS1 ) return (TRUE); } +/** @pred prompt(- _A_,+ _B_) + +Changes YAP input prompt from _A_ to _B_, active on *next* standard input interaction. + + +*/ static Int prompt ( USES_REGS1 ) { /* prompt(Old,New) */ @@ -211,7 +216,7 @@ prompt ( USES_REGS1 ) a = AtomOfTerm (t); if (strlen(RepAtom (a)->StrOfAE) > MAX_PROMPT) { Yap_Error(SYSTEM_ERROR_INTERNAL,t,"prompt %s is too long", RepAtom (a)->StrOfAE); - return(FALSE); + return false; } strncpy(LOCAL_Prompt, (char *)RepAtom (LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT); LOCAL_AtPrompt = a; @@ -223,7 +228,10 @@ Yap_GetCharForSIGINT(void) { CACHE_REGS int ch; - if ((ch = Yap_ReadlineForSIGINT()) == 0) +#if USE_READLINE + if (trueGlobalPrologFlag(READLINE_FLAG) || + (ch = Yap_ReadlineForSIGINT()) == 0) +#endif { /* ask for a new line */ fprintf(stderr, "Action (h for help): "); ch = getc(stdin); @@ -237,6 +245,7 @@ Yap_GetCharForSIGINT(void) void Yap_InitConsole(void) { + LOCAL_newline = true; Yap_InitCPred ("prompt", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag); diff --git a/os/edio.yap b/os/edio.yap index 1b5c52d11..cba6e023c 100644 --- a/os/edio.yap +++ b/os/edio.yap @@ -1,7 +1,37 @@ % % Edinburgh IO. +/** + * @file edio.yap + * @author VITOR SANTOS COSTA + * @date Wed Jan 20 01:07:02 2016 + * + * @brief Input/Output according to the DEC-10 Prolog. PLease consider using the ISO + * standard predicates for new code. + * + * +*/ + + % +/** @pred see(+ _S_) + + +If _S_ is a currently opened input stream then it is assumed to be +the current input stream. If _S_ is an atom it is taken as a +filename. If there is no input stream currently associated with it, then +it is opened for input, and the new input stream thus created becomes +the current input stream. If it is not possible to open the file, an +error occurs. If there is a single opened input stream currently +associated with the file, it becomes the current input stream; if there +are more than one in that condition, then one of them is chosen. + +When _S_ is a stream not currently opened for input, an error may be +reported, depending on the state of the `file_errors` flag. If + _S_ is neither a stream nor an atom the predicates just fails. + + +*/ see(user) :- !, set_input(user_input). see(F) :- var(F), !, '$do_error'(instantiation_error,see(F)). @@ -13,6 +43,13 @@ see(Stream) :- '$stream'(Stream), current_stream(_,read,Stream), !, set_input(Stream). see(F) :- open(F,read,Stream), set_input(Stream). +/** @pred seeing(- _S_) + + +The current input stream is unified with _S_. + + +*/ seeing(File) :- current_input(Stream), stream_property(Stream,file_name(NFile)), ( @@ -23,8 +60,33 @@ seeing(File) :- current_input(Stream), NFile = File ). +/** @pred seen + + +Closes the current input stream, as opened by see/1. Standard input +stream goes to the original ùser_input`. + + */ seen :- current_input(Stream), close(Stream), set_input(user). +/** @pred tell(+ _S_) + + +If _S_ is a currently opened stream for output, it becomes the +current output stream. If _S_ is an atom it is taken to be a +filename. If there is no output stream currently associated with it, +then it is opened for output, and the new output stream created becomes +the current output stream. If it is not possible to open the file, an +error occurs. If there is a single opened output stream currently +associated with the file, then it becomes the current output stream; if +there are more than one in that condition, one of them is chosen. + +Whenever _S_ is a stream not currently opened for output, an error +may be reported, depending on the state of the file_errors flag. The +predicate just fails, if _S_ is neither a stream nor an atom. + + +*/ tell(user) :- !, set_output(user_output). tell(F) :- var(F), !, '$do_error'(instantiation_error,tell(F)). @@ -43,12 +105,29 @@ tell(Stream) :- tell(F) :- open(F,append,Stream), set_output(Stream). - + +/** @pred telling(- _S_) + + +The current output stream is unified with _S_. + + +*/ telling(File) :- current_output(Stream), stream_property(Stream,file_name(NFile)), ( stream_property(user_output,file_name(NFile)) -> File = user ; File = NFile ). +/** @pred told + + +Closes the current output stream, and the user's terminal becomes again +the current output stream. It is important to remember to close streams +after having finished using them, as the maximum number of +simultaneously opened streams is 17. + + +*/ told :- current_output(Stream), !, set_output(user), diff --git a/os/files.c b/os/files.c index 43c480ee4..8203c90a1 100644 --- a/os/files.c +++ b/os/files.c @@ -24,75 +24,8 @@ static char SccsId[] = "%W% %G%"; * */ -#include "Yap.h" -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#include "eval.h" -#include "YapText.h" -#include -#if HAVE_STDARG_H -#include -#endif -#if HAVE_CTYPE_H -#include -#endif -#if HAVE_WCTYPE_H -#include -#endif -#if HAVE_LIMITS_H -#include -#endif -#if HAVE_SYS_PARAMS_H -#include -#endif -#if HAVE_SYS_TYPES_H -#include -#endif -#ifdef HAVE_SYS_STAT_H -#include -#endif -#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) -#include -#endif -#ifdef HAVE_UNISTD_H -#include -#endif -#if HAVE_STRING_H -#include -#endif -#if HAVE_LIBGEN_H -#include -#endif -#if HAVE_SIGNAL_H -#include -#endif -#if HAVE_FCNTL_H -/* for O_BINARY and O_TEXT in WIN32 */ -#include -#endif -#ifdef _WIN32 -#if HAVE_IO_H - /* Windows */ -#include -#endif -#endif -#if !HAVE_STRNCAT -#define strncat(X,Y,Z) strcat(X,Y) -#endif -#if !HAVE_STRNCPY -#define strncpy(X,Y,Z) strcpy(X,Y) -#endif -#if _MSC_VER || defined(__MINGW32__) -#if HAVE_SOCKET -#include -#endif -#include -#ifndef S_ISDIR -#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) -#endif -#endif -#include "iopreds.h" +#include "sysbits.h" + #if _MSC_VER || defined(__MINGW32__) #define SYSTEM_STAT _stat @@ -341,16 +274,35 @@ time_file(USES_REGS1) } else { const char *n = RepAtom(AtomOfTerm(tname))->StrOfAE; #if __WIN32 - FILETIME ftWrite; - if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, NULL)) == 0) + FILETIME ft; + HANDLE hdl; + Term rc; + + if ((hdl = CreateFile( n, 0, 0, NULL, OPEN_EXISTING, 0, 0)) == 0) return false; - if (GetFileTime(hdl, NULL,NULL,&ftWrite)) + if (GetFileTime(hdl, NULL,NULL,&ft)) return false; // Convert the last-write time to local time. // FileTimeToSystemTime(&ftWrite, &stUTC); // SystemTimeToTzSpecificLocalTime(NULL, &stUTC, &stLocal); CloseHandle( hdl ); - return Yap_unify(ARG2, MkIntegerTerm(ftWrite)); + ULONGLONG qwResult; + + // Copy the time into a quadword. + qwResult = (((ULONGLONG) ft.dwHighDateTime) << 32) + ft.dwLowDateTime; + #if SIZEOF_INT_P==8 + rc = MkIntegerTerm(qwResult); + #elif USE_GMP + char s[64]; + MP_INT rop; + + snprintf(s, 64, "%I64d", (long long int)n); + mpz_init_set_str (&rop, s, 10); + rc = Yap_MkBigNumTerm((void *)&rop) PASS_REGS); + #else + rc = MkIntegerTerm(ft.dwHighDateTime); +#endif + return Yap_unify(ARG2, rc); #elif HAVE_STAT struct SYSTEM_STAT ss; @@ -505,7 +457,7 @@ is_absolute_file_name ( USES_REGS1 ) at = AtomOfTerm(t); if (IsWideAtom(at)) { #if _WIN32 - return PathisRelativeW(RepAtom(at)->WStrOfAE[0]); + return PathIsRelativeW(RepAtom(at)->WStrOfAE); #else return RepAtom(at)->WStrOfAE[0] == '/'; #endif diff --git a/os/fmemopen.c b/os/fmemopen.c index 33f27b204..9e444db2d 100644 --- a/os/fmemopen.c +++ b/os/fmemopen.c @@ -14,7 +14,14 @@ // See the License for the specific language governing permissions and // limitations under the License. // +// +/** + * @file memopen.c + * @defgroup Memory Streams. + * @in. + * @return Description of returned value. + */ #ifdef __APPLE__ #include diff --git a/os/iopreds.c b/os/iopreds.c index ae750b2d8..e32f26518 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -18,9 +18,16 @@ static char SccsId[] = "%W% %G%"; #endif +/** + * @file iopreds.c + * @author VITOR SANTOS COSTA + * @date Wed Jan 20 00:45:56 2016 + * + * @brief main open and close predicates over generic streams. + * + */ /* - * This file includes the definition of a miscellania of standard predicates - * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, + * This file includes the definition of a miscellania of standard predicates * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * */ @@ -170,10 +177,10 @@ static void unix_upd_stream_info(StreamDesc *s) { Yap_socketStream(s); #if _MSC_VER || defined(__MINGW32__) { - if (_isatty(_fileno(s->u.file.file))) { + if (_isatty(_fileno(s->file))) { s->status |= Tty_Stream_f | Reset_Eof_Stream_f | Promptable_Stream_f; /* make all console descriptors unbuffered */ - setvbuf(s->u.file.file, NULL, _IONBF, 0); + setvbuf(s->file, NULL, _IONBF, 0); return; } #if _MSC_VER @@ -1009,11 +1016,7 @@ Int GetStreamFd(int sno) { } else #endif if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { -#if _MSC_VER || defined(__MINGW32__) - return ((Int)(GLOBAL_Stream[sno].u.pipe.hdl)); -#else return (GLOBAL_Stream[sno].u.pipe.fd); -#endif } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { return (-1); } @@ -1022,7 +1025,7 @@ Int GetStreamFd(int sno) { Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); } -static int binary_file(char *file_name) { +static int binary_file(const char *file_name) { #if HAVE_STAT #if _MSC_VER || defined(__MINGW32__) struct _stat ss; @@ -1229,20 +1232,52 @@ static void check_bom(int sno, StreamDesc *st) { return true; } + static bool + open_header( int sno, Atom open_mode) + { + if (open_mode == AtomWrite) { + const char *ptr; + const char s[] = "#!"; + int ch; + + ptr = s; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc( sno, ch ); + const char *b = Yap_FindExecutable(); + ptr = b; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc( sno, ch ); + const char *l = " -L --\n\n YAP script\n#\n# .\n"; + ptr = l; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc( sno, ch ); + + } else if (open_mode == AtomRead) { + // skip header + int ch; + while ((ch =Yap_peek(sno)) == '#' ) { + while ((ch = GLOBAL_Stream[sno].stream_wgetc( sno )) != 10 && ch != -1 ); + } + } + return true; + } + + #define OPEN_DEFS() \ - PAR("alias", isatom, OPEN_ALIAS), PAR("bom", boolean, OPEN_BOM), \ + PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \ PAR("buffer", isatom, OPEN_BUFFER), \ - PAR("close_on_abort", boolean, OPEN_CLOSE_ON_ABORT), \ + PAR("close_on_abort", booleanFlag, OPEN_CLOSE_ON_ABORT), \ PAR("create", isatom, OPEN_CREATE), \ PAR("encoding", isatom, OPEN_ENCODING), \ PAR("eof_action", isatom, OPEN_EOF_ACTION), \ - PAR("expand_filename", boolean, OPEN_EXPAND_FILENAME), \ + PAR("expand_filename", booleanFlag, OPEN_EXPAND_FILENAME), \ PAR("file_name", isatom, OPEN_FILE_NAME), PAR("input", ok, OPEN_INPUT), \ PAR("locale", isatom, OPEN_LOCALE), PAR("lock", isatom, OPEN_LOCK), \ PAR("mode", isatom, OPEN_MODE), PAR("output", ok, OPEN_OUTPUT), \ - PAR("representation_errors", boolean, OPEN_REPRESENTATION_ERRORS), \ - PAR("reposition", boolean, OPEN_REPOSITION), \ - PAR("type", isatom, OPEN_TYPE), PAR("wait", boolean, OPEN_WAIT), \ + PAR("representation_errors", booleanFlag, OPEN_REPRESENTATION_ERRORS), \ + PAR("reposition", booleanFlag, OPEN_REPOSITION), \ + PAR("script", booleanFlag, OPEN_SCRIPT), \ + PAR("type", isatom, OPEN_TYPE), PAR("wait", booleanFlag, OPEN_WAIT), \ PAR(NULL, ok, OPEN_END) #define PAR(x, y, z) z @@ -1267,7 +1302,7 @@ do_open(Term file_name, Term t2, char io_mode[8]; StreamDesc *st; bool avoid_bom = false, needs_bom = false; - char *fname; + const char *fname; stream_flags_t flags; FILE *fd; encoding_t encoding; @@ -1352,6 +1387,10 @@ do_open(Term file_name, Term t2, fname = Yap_AbsoluteFile(fname, LOCAL_FileNameBuf, ok); st->name = Yap_LookupAtom(fname); + // Skip scripts that start with !#/.. or similar + bool script = (args[OPEN_SCRIPT].used + ? args[OPEN_SCRIPT].tvalue == TermTrue + : false); // binary type if (args[OPEN_TYPE].used) { Term t = args[OPEN_TYPE].tvalue; @@ -1395,7 +1434,7 @@ do_open(Term file_name, Term t2, (!(flags & Binary_Stream_f) && binary_file(fname))) { UNLOCK(st->streamlock); if (errno == ENOENT) - return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG6, "%s: %s", fname, + return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname, strerror(errno))); else { return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s", @@ -1416,6 +1455,10 @@ do_open(Term file_name, Term t2, } else if ( open_mode == AtomRead && !avoid_bom ) { check_bom(sno, st); // can change encoding } + if (script) + open_header(sno, open_mode); + + UNLOCK(st->streamlock); { @@ -1423,10 +1466,109 @@ do_open(Term file_name, Term t2, return (Yap_unify(ARG3, t)); } } + +/** @pred open(+ _F_,+ _M_,- _S_) is iso + + +Opens the file with name _F_ in mode _M_ (`read`, `write` or +`append`), returning _S_ unified with the stream name. + +Yap allows 64 streams opened at the same time. If you need more, + redefine the MaxStreams constant. Each stream is either an input or + an output stream but not both. There are always 3 open streams: + user_input for reading, user_output for writing and user_error for + writing. If there is no ambiguity, the atoms user_input and + user_output may be referred to as `user`. + +The `file_errors` flag controls whether errors are reported when in +mode `read` or `append` the file _F_ does not exist or is not +readable, and whether in mode `write` or `append` the file is not +writable. + +*/ + + static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); } +/** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso + +Opens the file with name _F_ in mode _M_ (`read`, `write` or +`append`), returning _S_ unified with the stream name, and following +these options: + + + ++ `type(+ _T_)` is iso + + Specify whether the stream is a `text` stream (default), or a +`binary` stream. + ++ `reposition(+ _Bool_)` is iso + Specify whether it is possible to reposition the stream (`true`), or +not (`false`). By default, YAP enables repositioning for all +files, except terminal files and sockets. + ++ `eof(+ _Action_)` is iso + + Specify the action to take if attempting to input characters from a +stream where we have previously found an `end_of_file`. The possible +actions are `error`, that raises an error, `reset`, that tries to +reset the stream and is used for `tty` type files, and `eof_code`, +which generates a new `end_of_file` (default for non-tty files). + ++ `alias(+ _Name_)` is iso + + Specify an alias to the stream. The alias Name must be an atom. The +alias can be used instead of the stream descriptor for every operation +concerning the stream. + + The operation will fail and give an error if the alias name is already +in use. YAP allows several aliases for the same file, but only +one is returned by stream_property/2 + ++ `bom(+ _Bool_)` + + If present and `true`, a BOM (Byte Order Mark) was +detected while opening the file for reading or a BOM was written while +opening the stream. See BOM for details. + ++ `encoding(+ _Encoding_)` + +Set the encoding used for text. See Encoding for an overview of +wide character and encoding issues. + ++ `representation_errors(+ _Mode_)` + + Change the behaviour when writing characters to the stream that cannot +be represented by the encoding. The behaviour is one of `error` +(throw and Input/Output error exception), `prolog` (write `\u...\` +escape code or `xml` (write `\&#...;` XML character entity). +The initial mode is `prolog` for the user streams and +`error` for all other streams. See also Encoding. + ++ `expand_filename(+ _Mode_)` + + If _Mode_ is `true` then do filename expansion, then ask Prolog +to do file name expansion before actually trying to opening the file: +this includes processing `~` characters and processing `$` +environment variables at the beginning of the file. Otherwise, just try +to open the file using the given name. + + The default behavior is given by the Prolog flag +open_expands_filename. + ++ `script( + _Boolean_ )` YAP extension. + + The file may be a Prolog script. In `read` mode just check for + initial lines if they start with the hash symbol, and skip them. In + `write` mode output an header that can be used to launch the file by + calling `yap -l file -- $*`. Note that YAP will not set file + permissions as executable. In `append` mode ignore the flag. + + +*/ static Int open4(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS); } @@ -1605,6 +1747,12 @@ int Yap_GetFreeStreamDForReading(void) { return sno; } +/** + * @pred always_prompt_user + * + * Ensure that the stream always prompts before asking the standard input stream for data. + + */ static Int always_prompt_user(USES_REGS1) { StreamDesc *s = GLOBAL_Stream + StdInStream; @@ -1621,7 +1769,17 @@ static Int always_prompt_user(USES_REGS1) { return (TRUE); } -static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ +static Int close1/** @pred close(+ _S_) is iso + + +Closes the stream _S_. If _S_ does not stand for a stream +currently opened an error is reported. The streams user_input, +user_output, and user_error can never be closed. + + +*/ + +(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ Int sno = CheckStream( ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); if (sno < 0) @@ -1636,7 +1794,7 @@ static Int close1(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ } #define CLOSE_DEFS() \ - PAR("force", boolean, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END) + PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END) #define PAR(x, y, z) z @@ -1650,6 +1808,15 @@ typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t; static const param_t close_defs[] = {CLOSE_DEFS()}; #undef PAR +/** @pred close(+ _S_,+ _O_) is iso + +Closes the stream _S_, following options _O_. + +The only valid options are `force(true)` and `force(false)`. +YAP currently ignores these options. + + +*/ static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ Int sno = CheckStream( ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); @@ -1685,14 +1852,14 @@ Term read_line(int sno) { #define ABSOLUTE_FILE_NAME_DEFS() \ PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ - PAR("expand", boolean, ABSOLUTE_FILE_NAME_EXPAND), \ + PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \ PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \ PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \ PAR("glob", ok, ABSOLUTE_FILE_NAME_GLOB), \ PAR("relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO), \ PAR("solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS), \ - PAR("verbose_file_search", boolean, \ + PAR("verbose_file_search", booleanFlag, \ ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \ PAR(NULL, ok, ABSOLUTE_FILE_NAME_END) @@ -1838,7 +2005,9 @@ void Yap_InitIOPreds(void) { Yap_InitReadTPreds(); Yap_InitFormat(); Yap_InitRandomPreds(); - Yap_InitReadline(); +#if USE_READLINE + Yap_InitReadlinePreds(); +#endif Yap_InitSockets(); Yap_InitSignalPreds(); Yap_InitSysPreds(); diff --git a/os/iopreds.h b/os/iopreds.h index 5f9e7bf31..301b65c1f 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -13,6 +13,11 @@ static char SccsId[] = "%W% %G%"; #ifndef IOPREDS_H #define IOPREDS_H 1 +#if _WIN32 +#define USE_SOCKET 1 +#define HAVE_SOCKET 1 +#endif + #include #include "Yap.h" #include "Atoms.h" @@ -32,6 +37,15 @@ extern size_t Yap_page_size; #include +#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) +extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *); +#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) +extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *); + +extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, + encoding_t encoding, stream_flags_t flags, + Atom open_mode); + #if HAVE_SOCKET extern int Yap_sockets_io; @@ -50,14 +64,7 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */ af_unix /* or AF_FILE */ } socket_domain; -extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, - encoding_t encoding, stream_flags_t flags, - Atom open_mode); extern Term Yap_InitSocketStream(int, socket_info, socket_domain); -#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) -extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *); -#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) -extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *); extern int Yap_CheckSocketStream(Term, const char *); extern socket_domain Yap_GetSocketDomain(int); extern socket_info Yap_GetSocketStatus(int); @@ -181,11 +188,7 @@ typedef struct stream_desc } file; memHandle mem_string; struct { -#if defined(__MINGW32__) || defined(_MSC_VER) - HANDLE hdl; -#else int fd; -#endif } pipe; #if HAVE_SOCKET struct { @@ -276,6 +279,7 @@ Term Yap_scan_num(struct stream_desc *); void Yap_DefaultStreamOps( StreamDesc *st ); void Yap_PipeOps( StreamDesc *st ); void Yap_MemOps( StreamDesc *st ); +bool Yap_CloseMemoryStream( int sno ); void Yap_ConsolePipeOps( StreamDesc *st ); void Yap_SocketOps( StreamDesc *st ); void Yap_ConsoleSocketOps( StreamDesc *st ); @@ -294,7 +298,8 @@ void Yap_InitSockets( void ); void Yap_InitSocketLayer(void); void Yap_InitMems( void ); void Yap_InitConsole( void ); -void Yap_InitReadline( void ); +void Yap_InitReadlinePreds( void ); +bool Yap_InitReadline( Term ); void Yap_InitChtypes(void); void Yap_InitCharsio(void); void Yap_InitFormat(void); diff --git a/os/mem.c b/os/mem.c index 290975725..0da22fad9 100644 --- a/os/mem.c +++ b/os/mem.c @@ -64,6 +64,11 @@ FILE * open_memstream (char **buf, size_t *len); #define MAY_WRITE 1 #endif +#if _WIN32 +#undef MAY_WRITE +#undef MAY_READ +#endif + #if !MAY_READ static int MemGetc( int); @@ -253,13 +258,15 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou sno = GetFreeStreamD(); if (sno < 0) return -1; - if (!buf) { + st = GLOBAL_Stream+sno; + st->status = Output_Stream_f | InMemory_Stream_f; + if (!buf) { if (!nchars) { - nchars = Yap_page_size; + nchars = Yap_page_size; } buf = malloc( nchars ); + st->status |= FreeOnClose_Stream_f; } - st = GLOBAL_Stream+sno; st->nbuf = buf; if(!st->nbuf) { return -1; @@ -275,12 +282,11 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou Yap_DefaultStreamOps( st ); #if MAY_WRITE st->file = open_memstream(&st->nbuf, &st->nsize); - st->status = Output_Stream_f | InMemory_Stream_f|Seekable_Stream_f; + st->status |= Seekable_Stream_f; #else st->u.mem_string.pos = 0; - st->u.mem_string.buf = nbuf; + st->u.mem_string.buf = st->nbuf; st->u.mem_string.max_size = nchars; - st->status = Output_Stream_f | InMemory_Stream_f; #endif Yap_MemOps( st ); UNLOCK(st->streamlock); @@ -327,8 +333,8 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */ char * Yap_MemExportStreamPtr( int sno ) { - char *s; #if MAY_WRITE + char *s; if (fflush(GLOBAL_Stream[sno].file) == 0) { s = GLOBAL_Stream[sno].nbuf; @@ -336,7 +342,7 @@ Yap_MemExportStreamPtr( int sno ) } return NULL; #else - return &GLOBAL_Stream[sno].u.mem_string; + return GLOBAL_Stream[sno].u.mem_string.buf; #endif } @@ -360,7 +366,6 @@ peek_mem_write_stream ( USES_REGS1 ) i = GLOBAL_Stream[sno].nsize; } #else - size_t pos; ptr = GLOBAL_Stream[sno].u.mem_string.buf; i = GLOBAL_Stream[sno].u.mem_string.pos; #endif @@ -401,6 +406,35 @@ void #endif } +bool Yap_CloseMemoryStream( int sno ) +{ + if (!(GLOBAL_Stream[sno].status & Output_Stream_f) ) { +#if MAY_WRITE + fclose(GLOBAL_Stream[sno].file); + if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) + free( GLOBAL_Stream[sno].nbuf ); +#else + if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) + Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); + else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { + free(GLOBAL_Stream[sno].u.mem_string.buf); + } +#endif + } else { +#if MAY_READ + fclose(GLOBAL_Stream[sno].file); + Yap_FreeAtomSpace(GLOBAL_Stream[sno].nbuf); +#else + if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) + Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); + else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { + free(GLOBAL_Stream[sno].u.mem_string.buf); + } +#endif + } + return true; +} + void Yap_InitMems( void ) { diff --git a/os/open_memstream.c b/os/open_memstream.c index 44c2c6aef..ab9c805a8 100644 --- a/os/open_memstream.c +++ b/os/open_memstream.c @@ -29,7 +29,7 @@ // #include "verify.h" -#if !HAVE_OPEN_MEMSTREAM +#if !HAVE_OPEN_MEMSTREAM && !_WIN32 #if !HAVE_FUNOPEN # error Sorry, not ported to your platform yet diff --git a/os/pipes.c b/os/pipes.c index 9b383cc07..b09dd7559 100644 --- a/os/pipes.c +++ b/os/pipes.c @@ -47,6 +47,12 @@ static char SccsId[] = "%W% %G%"; #define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) #endif #endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_FCNTL_H +#include +#endif #include "iopreds.h" static int PipePutc( int, int); @@ -66,15 +72,6 @@ ConsolePipePutc (int sno, int ch) ch = '\n'; } #endif -#if _MSC_VER || defined(__MINGW32__) - { - DWORD written; - if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) { - PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "write to pipe returned error"); - return EOF; - } - } -#else { int out = 0; while (!out) { @@ -88,7 +85,6 @@ ConsolePipePutc (int sno, int ch) } } } -#endif count_output_char(ch,s); return ((int) ch); } @@ -104,15 +100,6 @@ PipePutc (int sno, int ch) ch = '\n'; } #endif -#if _MSC_VER || defined(__MINGW32__) - { - DWORD written; - if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) { - PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "write to pipe returned error"); - return EOF; - } - } -#else { int out = 0; while (!out) { @@ -126,7 +113,6 @@ PipePutc (int sno, int ch) } } } -#endif console_count_output_char(ch,s); return ((int) ch); } @@ -159,19 +145,10 @@ ConsolePipeGetc(int sno) strncpy(LOCAL_Prompt, RepAtom (LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT); LOCAL_newline = false; } -#if _MSC_VER || defined(__MINGW32__) - if (ReadFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) { - LOCAL_PrologMode |= ConsoleGetcMode; - Yap_WinError("read from console pipe returned error"); - LOCAL_PrologMode &= ~ConsoleGetcMode; - return console_post_process_eof(s); - } -#else /* should be able to use a buffer */ LOCAL_PrologMode |= ConsoleGetcMode; count = read(s->u.pipe.fd, &c, sizeof(char)); LOCAL_PrologMode &= ~ConsoleGetcMode; -#endif if (count == 0) { return console_post_process_eof(s); } else if (count > 0) { @@ -192,16 +169,8 @@ PipeGetc(int sno) char c; /* should be able to use a buffer */ -#if _MSC_VER || defined(__MINGW32__) - DWORD count; - if (ReadFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) { - Yap_WinError("read from pipe returned error"); - return EOF; - } -#else int count; count = read(s->u.pipe.fd, &c, sizeof(char)); -#endif if (count == 0) { return post_process_eof(s); } else if (count > 0) { @@ -237,25 +206,19 @@ open_pipe_stream (USES_REGS1) Term t1, t2; StreamDesc *st; int sno; -#if _MSC_VER || defined(__MINGW32__) - HANDLE ReadPipe, WritePipe; - SECURITY_ATTRIBUTES satt; - - satt.nLength = sizeof(satt); - satt.lpSecurityDescriptor = NULL; - satt.bInheritHandle = TRUE; - if (!CreatePipe(&ReadPipe, &WritePipe, &satt, 0)) - { - return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "open_pipe_stream/2 could not create pipe")); - } -#else int filedes[2]; - if (pipe(filedes) != 0) + if ( +#if _MSC_VER || defined(__MINGW32__) + // assume for now only text streams... + _pipe(filedes, 1024, O_TEXT) +#else + pipe(filedes) +#endif + != 0) { - return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "open_pipe_stream/2 could not create pipe")); + return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "error %s", strerror(errno)) ); } -#endif sno = GetFreeStreamD(); if (sno < 0) return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_pipe_stream/2")); @@ -268,11 +231,7 @@ open_pipe_stream (USES_REGS1) st->stream_putc = PipePutc; st->stream_getc = PipeGetc; Yap_DefaultStreamOps( st ); -#if _MSC_VER || defined(__MINGW32__) - st->u.pipe.hdl = ReadPipe; -#else st->u.pipe.fd = filedes[0]; -#endif st->file = fdopen( filedes[0], "r"); UNLOCK(st->streamlock); sno = GetFreeStreamD(); @@ -286,11 +245,7 @@ open_pipe_stream (USES_REGS1) st->stream_putc = PipePutc; st->stream_getc = PipeGetc; Yap_DefaultStreamOps( st ); -#if _MSC_VER || defined(__MINGW32__) - st->u.pipe.hdl = WritePipe; -#else st->u.pipe.fd = filedes[1]; -#endif st->file = fdopen( filedes[1], "w"); UNLOCK(st->streamlock); t2 = Yap_MkStream (sno); diff --git a/os/random.c b/os/random.c index b34850b48..90bde48f1 100644 --- a/os/random.c +++ b/os/random.c @@ -1,7 +1,34 @@ - - -#include "sysbits.h" - +#include "Yap.h" +#include "Yatom.h" +#include "YapHeap.h" +#include "yapio.h" +#include +#if HAVE_UNISTD_H +#include +#endif +#if HAVE_STDARG_H +#include +#endif +#ifdef _WIN32 +#if HAVE_IO_H +/* Windows */ +#include +#endif +#if HAVE_SOCKET +#include +#endif +#include +#ifndef S_ISDIR +#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#endif +#endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_FCNTL_H +#include +#endif +#include "iopreds.h" #if HAVE_TIME_H #include diff --git a/os/readline.c b/os/readline.c index e5b383df2..ed7ea0bc7 100644 --- a/os/readline.c +++ b/os/readline.c @@ -1,4 +1,4 @@ - /************************************************************************* +/************************************************************************* * * * YAP Prolog * * * @@ -51,7 +51,7 @@ static char SccsId[] = "%W% %G%"; #include "iopreds.h" -#if defined(USE_READLINE) +#if USE_READLINE #include #include @@ -191,18 +191,21 @@ static int prolog_complete(int ignore, int key) { return 0; } -static void InitReadline(void) { +bool Yap_InitReadline(Term enable) { // don't call readline within emacs // if (getenv("ËMACS")) // return; + if (enable == TermFalse) + return true; GLOBAL_Stream[StdInStream].u.irl.buf = NULL; GLOBAL_Stream[StdInStream].u.irl.ptr = NULL; + GLOBAL_Stream[StdInStream].status |= Readline_Stream_f; #if _MSC_VER || defined(__MINGW32__) rl_instream = stdin; #endif rl_outstream = stderr; using_history(); - char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true); + const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true); if (!read_history(s)) { FILE *f = fopen(s, "w"); if (f) { @@ -217,6 +220,7 @@ static void InitReadline(void) { #else rl_add_defun("prolog-complete", (void *)prolog_complete, '\t'); #endif + return Yap_ReadlineOps(GLOBAL_Stream + StdInStream); } static bool getLine(int inp, int out) { @@ -250,6 +254,7 @@ static bool getLine(int inp, int out) { } } else { LOCAL_PrologMode &= ~ConsoleGetcMode; + LOCAL_newline = true; } strncpy(LOCAL_Prompt, RepAtom(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT); /* window of vulnerability closed */ @@ -274,6 +279,7 @@ static int ReadlinePutc(int sno, int ch) { console_count_output_char(ch, s); if (ch == 10) { Yap_ReadlineFlush(sno); + LOCAL_newline = true; } return ((int)ch); } @@ -303,15 +309,15 @@ static int ReadlineGetc(int sno) { return console_post_process_read_char(ch, s); } - -/** +/** @brief Yap_ReadlinePeekChar peeks the next char from the readline buffer, but does not actually grab it. - The idea is to take advantage of the buffering. Special care must be taken with EOF, though. + The idea is to take advantage of the buffering. Special care must be taken + with EOF, though. */ -Int Yap_ReadlinePeekChar( int sno) { +Int Yap_ReadlinePeekChar(int sno) { StreamDesc *s = &GLOBAL_Stream[sno]; int ch; @@ -319,13 +325,14 @@ Int Yap_ReadlinePeekChar( int sno) { const char *ttyptr = s->u.irl.ptr; ch = *ttyptr; if (ch == '\0') { - ch = '\n'; + ch = '\n'; } - } if (getLine(sno, StdErrStream) ) { - CACHE_REGS + } + if (getLine(sno, StdErrStream)) { + CACHE_REGS ch = s->u.irl.ptr[0]; if (ch == '\0') { - ch = '\n'; + ch = '\n'; } if (ch == '\n') { LOCAL_newline = true; @@ -338,7 +345,6 @@ Int Yap_ReadlinePeekChar( int sno) { return ch; } - int Yap_ReadlineForSIGINT(void) { CACHE_REGS int ch; @@ -372,10 +378,17 @@ static Int has_readline(USES_REGS1) { #endif } -void Yap_InitReadline(void) { +void Yap_InitReadlinePreds(void) { Yap_InitCPred("$has_readline", 0, has_readline, SafePredFlag | HiddenPredFlag); - InitReadline(); } +#else +bool Yap_InitReadline(Term enable) { + if (enable == TermTrue) + return true; + return false; +} + +void Yap_InitReadlinePreds(void) {} #endif diff --git a/os/readterm.c b/os/readterm.c index 3388afe28..afdd790ad 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -95,6 +95,8 @@ static char SccsId[] = "%W% %G%"; #define SYSTEM_STAT stat #endif +static Term readFromBuffer(const char *s, Term opts); + static void clean_vars(VarEntry *p) { if (p == NULL) return; @@ -180,7 +182,8 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { #endif /*O_QUASIQUOTATIONS*/ #define READ_DEFS() \ - PAR("comments", filler, READ_COMMENTS), PAR("module", isatom, READ_MODULE), \ + PAR("comments", list_filler, READ_COMMENTS),\ + PAR("module", isatom, READ_MODULE), \ PAR("priority", nat, READ_PRIORITY), \ PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ PAR("term_position", filler, READ_TERM_POSITION), \ @@ -188,7 +191,7 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { PAR("singletons", filler, READ_SINGLETONS), \ PAR("variables", filler, READ_VARIABLES), \ PAR("variable_names", filler, READ_VARIABLE_NAMES), \ - PAR("character_escapes", boolean, READ_CHARACTER_ESCAPES), \ + PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) @@ -372,10 +375,12 @@ typedef struct FEnv { bool reading_clause; /// read_clause size_t nargs; /// arity of current procedure encoding_t enc; /// encoding of the stream being read + Term tcomms; /// Access to comments + Term cmod; /// Access to comments } FEnv; typedef struct renv { - Term cm, bq; + Term bq; bool ce, sw; Term sy; UInt cpos; @@ -394,7 +399,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { CACHE_REGS LOCAL_VarTable = NULL; LOCAL_AnonVarTable = NULL; - re->cm = CurrentModule; + fe->cmod = CurrentModule; fe->enc = GLOBAL_Stream[inp_stream].encoding; xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END); if (args == NULL) { @@ -414,6 +419,13 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { } else { fe->qq = 0; } + if (args[READ_COMMENTS].used) { + fe->tcomms = args[READ_COMMENTS].tvalue; + if (fe->tcomms == TermProlog) + fe->tcomms = PROLOG_MODULE; + } else { + fe->tcomms = 0; + } if (args[READ_TERM_POSITION].used) { fe->tp = args[READ_TERM_POSITION].tvalue; } else { @@ -512,60 +524,191 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) { POPFET(qq); } -static bool complete_clause_processing(FEnv *fe, TokEntry *tokstarts, Term t); - -static bool complete_processing(FEnv *fe, TokEntry *tokstart) { - CACHE_REGS - Term v1, v2, v3; +static Term +get_variables(FEnv *fe, TokEntry *tokstart) +{ + Term v; if (fe->vp) { - while (TRUE) { - fe->old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - if ((v1 = Yap_Variables(LOCAL_VarTable, TermNil))) - break; - } else { - reset_regs(tokstart, fe); - } - } - } - if (fe->np) { while (true) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v2 = Yap_VarNames(LOCAL_VarTable, TermNil))) { + if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) { fe->old_H = HR; - break; + return v; } } else { reset_regs(tokstart, fe); } } - } + } + return 0; +} + + +static Term +get_varnames(FEnv *fe, TokEntry *tokstart) +{ + Term v; + if (fe->np) { + while (true) { + fe->old_H = HR; + + if (setjmp(LOCAL_IOBotch) == 0) { + if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) { + fe->old_H = HR; + return v; + } + } else { + reset_regs(tokstart, fe); + } + } + } + return 0; +} + + +static Term +get_singletons(FEnv *fe, TokEntry *tokstart) +{ + Term v; if (fe->sp) { while (TRUE) { fe->old_H = HR; if (setjmp(LOCAL_IOBotch) == 0) { - if ((v3 = Yap_Singletons(LOCAL_VarTable, TermNil))) - break; + if ((v = Yap_Singletons(LOCAL_VarTable, TermNil))) + return v; } else { reset_regs(tokstart, fe); } } } + return 0; +} + +static void +warn_singletons(FEnv *fe, TokEntry *tokstart) +{ + Term v; + fe->sp = TermNil; + v = get_singletons(fe, tokstart); + if (v && v != TermNil) { + Term singls[4]; + singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v); + singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno); + singls[2] = MkAtomTerm(LOCAL_SourceFileName); + if (fe->t) + singls[3] = fe->t; + else + singls[1] = TermTrue; + Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls); + singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t); + + singls[1] = v; + Yap_PrintWarning(Yap_MkApplTerm(FunctorError, 2, singls)); + } +} + + +static Term +get_stream_position(FEnv *fe, TokEntry *tokstart) +{ + Term v; + if (fe->tp) { + while (true) { + fe->old_H = HR; + + if (setjmp(LOCAL_IOBotch) == 0) { + if ((v = CurrentPositionToTerm())) + return v; + } else { + reset_regs(tokstart, fe); + } + } + } + return 0; +} + + + +static bool complete_processing(FEnv *fe, TokEntry *tokstart) { + CACHE_REGS + Term v1, v2, v3, vc, tp; + + CurrentModule = fe->cmod; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; + if (fe->vp) + v1 = get_variables(fe, tokstart); + else + v1 = 0L; + if (fe->np) + v2 = get_varnames(fe, tokstart); + else + v2 = 0L; + if (fe->sp) + v3 = get_singletons(fe, tokstart); + else + v3 = 0L; + if (fe->tcomms) + vc = LOCAL_Comments; + else + vc = 0L; + if (fe->tp) + tp = get_stream_position(fe, tokstart ); + else + tp = 0L; Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); // trail must be ok by now.] - if ((!fe->vp || Yap_unify(v1, fe->vp)) && - (!fe->np || Yap_unify(v2, fe->np)) && - (!fe->sp || Yap_unify(v3, fe->sp)) && - (!fe->tp || Yap_unify(fe->tp, CurrentPositionToTerm()))) + if ( ( !v1 || Yap_unify(v1, fe->vp) ) && + ( !v2 || Yap_unify(v2, fe->np)) && + ( !v3 || Yap_unify(v3, fe->sp)) && + ( !tp || Yap_unify(tp, fe->tp)) && + ( !vc || Yap_unify(vc, fe->tcomms))) return fe->t; return 0; } +static bool complete_clause_processing(FEnv *fe, TokEntry + *tokstart) { + CACHE_REGS + Term v_vp, v_vnames, v_comments, v_pos; + + CurrentModule = fe->cmod; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; + if (fe->vp) + v_vp = get_variables(fe, tokstart); + else + v_vp = 0L; + if (fe->np) + v_vnames = get_varnames(fe, tokstart); + else + v_vnames = 0L; + if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { + warn_singletons(fe, tokstart); + } + if (fe->tcomms) + v_comments = LOCAL_Comments; + else + v_comments = 0L; + if (fe->tp) + v_pos = get_stream_position(fe, tokstart ); + else + v_pos = 0L; + Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); + + // trail must be ok by now.] + if ( ( !v_vp || Yap_unify(v_vp, fe->vp) ) && + ( !v_vnames || Yap_unify(v_vnames, fe->np)) && + ( !v_pos || Yap_unify(v_pos, fe->tp)) && + ( !v_comments || Yap_unify(v_comments, fe->tcomms))) + return fe->t; + return 0; +} + static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, int nargs); @@ -669,6 +812,12 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { // next step return YAP_PARSING; } + if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { + LOCAL_ErrorMessage = "Empty clause"; + LOCAL_Error_TYPE = SYNTAX_ERROR; + LOCAL_Error_Term = TermEof; + return YAP_PARSING_ERROR; + } return scanEOF(fe, inp_stream); } @@ -755,12 +904,6 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { fe->toklast = LOCAL_tokptr; LOCAL_tokptr = tokstart; TR = (tr_fr_ptr)tokstart; - if (fe->t == 0) - return YAP_PARSING_ERROR; - if (fe->reading_clause && !complete_clause_processing(fe, tokstart, fe->t)) - fe->t = 0; - else if (!fe->reading_clause && !complete_processing(fe, tokstart)) - fe->t = 0; #if EMACS first_char = tokstart->TokPos; #endif /* EMACS */ @@ -808,13 +951,13 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { state = parseError(&re, &fe, inp_stream); break; case YAP_PARSING_FINISHED: - return fe.t; + break; } } - if (fe.t) { + { CACHE_REGS if (fe.reading_clause && - !complete_clause_processing(&fe, LOCAL_tokptr, fe.t)) + !complete_clause_processing(&fe, LOCAL_tokptr)) fe.t = 0; else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr)) fe.t = 0; @@ -828,12 +971,11 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { static Int read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ Term rc; - yhandle_t h = Yap_InitSlot(ARG1); + yhandle_t h = Yap_PushHandle(ARG1); if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0) return FALSE; - Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h); - return Yap_unify(tf, rc); + Term tf = Yap_PopHandle(h); + return rc && Yap_unify(tf, rc); } static Int read_term( @@ -842,23 +984,23 @@ static Int read_term( Int out; /* needs to change LOCAL_output_stream for write */ - yhandle_t h = Yap_InitSlot(ARG2); + yhandle_t h = Yap_PushHandle(ARG2); inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3"); if (inp_stream == -1) { return (FALSE); + } out = Yap_read_term(inp_stream, ARG3, 3); UNLOCK(GLOBAL_Stream[inp_stream].streamlock); - Term tf = Yap_GetFromSlot(h); - Yap_RecoverSlots(1, h); + Term tf = Yap_PopHandle(h); return out != 0L && Yap_unify(tf, out); } #define READ_CLAUSE_DEFS() \ - PAR("comments", filler, READ_CLAUSE_COMMENTS), \ - PAR("process_comments", boolean, READ_CLAUSE_PROCESS_COMMENTS), \ + PAR("comments", list_filler, READ_CLAUSE_COMMENTS), \ PAR("module", isatom, READ_CLAUSE_MODULE), \ PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ + PAR("variables", filler, READ_CLAUSE_VARIABLES), \ PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ PAR(NULL, ok, READ_CLAUSE_END) @@ -880,24 +1022,36 @@ static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()}; static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { CACHE_REGS - re->cm = CurrentModule; + xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_END); if (args == NULL) { return NULL; } - re->cm = CurrentModule; re->bq = getBackQuotesFlag(); + fe->enc = GLOBAL_Stream[inp_stream].encoding; + fe->cmod = CurrentModule; CurrentModule = LOCAL_SourceModule; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; + if (args[READ_CLAUSE_MODULE].used) { + fe->tcomms = args[READ_CLAUSE_MODULE].tvalue; + } else { + fe->tcomms = 0L; + } + fe->sp = 0; fe->qq = 0; if (args[READ_CLAUSE_TERM_POSITION].used) { fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue; } else { fe->tp = 0; } - if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) { - fe->sp = TermNil; + fe->sp = 0; + if (args[READ_CLAUSE_COMMENTS].used) { + fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue; + if (fe->tcomms == TermProlog) + fe->tcomms = PROLOG_MODULE; } else { - fe->sp = 0; + fe->tcomms = 0L; } if (args[READ_CLAUSE_SYNTAX_ERRORS].used) { re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue; @@ -910,6 +1064,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, } else { fe->np = 0; } + if (args[READ_CLAUSE_VARIABLES].used) { + fe->vp = args[READ_CLAUSE_VARIABLES].tvalue; + } else { + fe->vp = 0; + } fe->ce = Yap_CharacterEscapes(CurrentModule); re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; if (re->seekable) { @@ -923,72 +1082,6 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, return args; } -static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart, Term t) { - CACHE_REGS - Term v1, v2, v3 = TermNil; - { - fe->old_H = HR; - while (TRUE) { - fe->old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - v1 = Yap_VarNames(LOCAL_VarTable, TermNil); - break; - } else { - reset_regs(tokstart, fe); - } - } - } - if (fe->tp) { - fe->old_H = HR; - while (TRUE) { - if (setjmp(LOCAL_IOBotch) == 0) { - v2 = MkIntegerTerm(Yap_FirstLineInParse()); - break; - } else { - *HR++ = v1; - reset_regs(tokstart, fe); - v1 = *--HR; - } - } - } - if (fe->sp) { - fe->old_H = HR; - while (TRUE) { - fe->old_H = HR; - - if (setjmp(LOCAL_IOBotch) == 0) { - v3 = Yap_Singletons(LOCAL_VarTable, TermNil); - break; - } else { - *HR++ = v1; - *HR++ = v2; - reset_regs(tokstart, fe); - v2 = *--HR; - v1 = *--HR; - } - } - } - Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); - - if (v3 != TermNil) { - Term singls[4]; - singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v3); - singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno); - singls[2] = MkAtomTerm(LOCAL_SourceFileName); - singls[3] = t; - t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls); - singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t); - singls[1] = TermNil; - Yap_PrintWarning(Yap_MkApplTerm(FunctorError, 2, singls)); - } - if (fe->np && !Yap_unify(v1, fe->np)) - return 0; - if (fe->tp && !Yap_unify(v2, fe->tp)) - return 0; - return fe->t; -} - /** * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @@ -998,12 +1091,13 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart, Term t) { static Int read_clause2(USES_REGS1) { Term rc; yhandle_t h = Yap_InitSlot(ARG1); - rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), -2); + rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), 2); Term tf = Yap_GetFromSlot(h); Yap_RecoverSlots(1, h); return rc && Yap_unify(tf, rc); } + /** * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @@ -1042,6 +1136,7 @@ static Int read_clause( return out && Yap_unify(tf, out); } + /** * @pred source_location( - _File_ , _Line_ ) * @@ -1178,7 +1273,7 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, if (bindings) { ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar); - sl = Yap_InitSlot(bvar); + sl = Yap_PushHandle(bvar); } else { ctl = TermNil; sl = 0; @@ -1191,45 +1286,12 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Yap_CloseStream(stream); UNLOCK(GLOBAL_Stream[stream].streamlock); if (rval && bindings) { - *bindings = Yap_GetFromSlot(sl); - } - if (bindings) { - Yap_RecoverSlots(sl, 1); + *bindings = Yap_PopHandle(sl); } return rval; } -Term Yap_ReadFromAtom(Atom a, Term opts) { - Term rval; - int sno; - if (IsWideAtom(a)) { - wchar_t *ws = a->WStrOfAE; - size_t len = wcslen(ws); - encoding_t enc = ENC_ISO_ANSI; - sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER); - } else { - char *s = a->StrOfAE; - size_t len = strlen(s); - encoding_t enc = ENC_ISO_LATIN1; - sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER); - } - rval = Yap_read_term(sno, opts, 3); - Yap_CloseStream(sno); - return rval; -} - -static Term readFromBuffer(const char *s, Term opts) { - Term rval; - int sno; - encoding_t enc = ENC_ISO_UTF8; - sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s), - &enc, MEM_BUF_USER); - - rval = Yap_read_term(sno, opts, 3); - Yap_CloseStream(sno); - return rval; -} /** * @pred read_term_from_atom( +_Atom_ , - _T_ , + _VarNames_ @@ -1303,23 +1365,23 @@ static Int term_to_string(USES_REGS1) { * */ static Int term_to_atom(USES_REGS1) { - Term t1 = Deref(ARG2), ctl, rc = false; + Term t2 = Deref(ARG2), ctl, rc = false; Atom at; - if (IsVarTerm(t1)) { + if (IsVarTerm(t2)) { size_t length; - char *s = Yap_TermToString(t1, NULL, 0, &length, NULL, + char *s = Yap_TermToString(Deref(ARG1), NULL, 0, &length, NULL, Quote_illegal_f | Handle_vars_f); if (!s || !(at = Yap_LookupAtom(s))) { - Yap_Error(RESOURCE_ERROR_HEAP, t1, + Yap_Error(RESOURCE_ERROR_HEAP, t2, "Could not get memory from the operating system"); return false; } return Yap_unify(ARG2, MkAtomTerm(at)); - } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "atom_to_term/2"); + } else if (!IsAtomTerm(t2)) { + Yap_Error(TYPE_ERROR_ATOM, t2, "atom_to_term/2"); return (FALSE); } else { - at = AtomOfTerm(t1); + at = AtomOfTerm(t2); } ctl = TermNil; return Yap_ReadFromAtom(at, ctl) == 0L && Yap_unify(rc, ARG1); @@ -1356,6 +1418,38 @@ static Int read_term_from_atom(USES_REGS1) { return Yap_unify(rc, ARG2); } +Term Yap_ReadFromAtom(Atom a, Term opts) { + Term rval; + int sno; + if (IsWideAtom(a)) { + wchar_t *ws = a->WStrOfAE; + size_t len = wcslen(ws); + encoding_t enc = ENC_ISO_ANSI; + sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER); + } else { + char *s = a->StrOfAE; + size_t len = strlen(s); + encoding_t enc = ENC_ISO_LATIN1; + sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER); + } + + rval = Yap_read_term(sno, opts, 3); + Yap_CloseStream(sno); + return rval; +} +static Term readFromBuffer(const char *s, Term opts) { + Term rval; + int sno; + encoding_t enc = ENC_ISO_UTF8; + sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s), + &enc, MEM_BUF_USER); + + rval = Yap_read_term(sno, opts, 3); + Yap_CloseStream(sno); + return rval; +} + + /** * @pred read_term_from_string( +_String_ , - _T_ , + _Options_ * @@ -1435,7 +1529,7 @@ void Yap_InitReadTPreds(void) { Yap_InitCPred("read", 1, read1, SyncPredFlag); Yap_InitCPred("read", 2, read2, SyncPredFlag); Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag); - Yap_InitCPred("read_term", 3, read_term, 0); + Yap_InitCPred("read_term", 3, read_term, SyncPredFlag); Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag); Yap_InitCPred("read_clause", 3, read_clause, 0); diff --git a/os/sig.c b/os/sig.c index b04010a5a..2cc4c5052 100644 --- a/os/sig.c +++ b/os/sig.c @@ -1,15 +1,7 @@ - #include "sysbits.h" -#if HAVE_SIGNAL_H - -#include - -#ifdef MPW -#define signal sigset -#endif - +#if HAVE_SIGNAL #ifdef MSH @@ -579,6 +571,39 @@ MSCHandleSignal(DWORD dwCtrlType) { #endif /* HAVE_SIGNAL */ + + /* wrapper for alarm system call */ +#if _MSC_VER || defined(__MINGW32__) + + static DWORD WINAPI + DoTimerThread(LPVOID targ) + { + Int *time = (Int *)targ; + HANDLE htimer; + LARGE_INTEGER liDueTime; + + htimer = CreateWaitableTimer(NULL, FALSE, NULL); + liDueTime.QuadPart = -10000000; + liDueTime.QuadPart *= time[0]; + /* add time in usecs */ + liDueTime.QuadPart -= time[1]*10; + /* Copy the relative time into a LARGE_INTEGER. */ + if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) { + return(FALSE); + } + if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0) + fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError()); + Yap_signal (YAP_WINTIMER_SIGNAL); + /* now, say what is going on */ + Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); + ExitThread(1); +#if _MSC_VER + return(0L); +#endif + } + +#endif + static Int enable_interrupts( USES_REGS1 ) { diff --git a/os/streams.c b/os/streams.c index ad5d88201..c925cb3c1 100644 --- a/os/streams.c +++ b/os/streams.c @@ -189,7 +189,7 @@ static Int is_output(int sno static Int has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */ bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f; - if (!IsVarTerm(t2) && !boolean(t2)) { + if (!IsVarTerm(t2) && !booleanFlag(t2)) { return FALSE; } if (rc) { @@ -203,7 +203,7 @@ static Int has_reposition(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */ bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f; - if (!IsVarTerm(t2) && !boolean(t2)) { + if (!IsVarTerm(t2) && !booleanFlag(t2)) { return FALSE; } if (rc) { @@ -647,9 +647,9 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */ #define SET_STREAM_DEFS() \ PAR("alias", isatom, SET_STREAM_ALIAS), \ - PAR("buffer", boolean, SET_STREAM_BUFFER), \ + PAR("buffer", booleanFlag, SET_STREAM_BUFFER), \ PAR("buffer_size", nat, SET_STREAM_BUFFER_SIZE), \ - PAR("close_on_abort", boolean, SET_STREAM_CLOSE_ON_ABORT), \ + PAR("close_on_abort", booleanFlag, SET_STREAM_CLOSE_ON_ABORT), \ PAR("encoding", isatom, SET_STREAM_ENCODING), \ PAR("eof_action", isatom, SET_STREAM_EOF_ACTION), \ PAR("file_name", isatom, SET_STREAM_FILE_NAME), \ @@ -798,18 +798,16 @@ void Yap_CloseStreams(int loud) { continue; if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) pclose(GLOBAL_Stream[sno].file); -#if _MSC_VER || defined(__MINGW32__) - if (GLOBAL_Stream[sno].status & Pipe_Stream_f) - CloseHandle(GLOBAL_Stream[sno].u.pipe.hdl); -#else if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f)) close(GLOBAL_Stream[sno].u.pipe.fd); -#endif +#if USE_SOCKET else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) { Yap_CloseSocket(GLOBAL_Stream[sno].u.socket.fd, GLOBAL_Stream[sno].u.socket.flags, GLOBAL_Stream[sno].u.socket.domain); - } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + } +#endif + else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) { Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); } else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { @@ -846,12 +844,9 @@ static void CloseStream(int sno) { } #endif else if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { -#if _MSC_VER || defined(__MINGW32__) - CloseHandle(GLOBAL_Stream[sno].u.pipe.hdl); -#else close(GLOBAL_Stream[sno].u.pipe.fd); -#endif } else if (GLOBAL_Stream[sno].status & (InMemory_Stream_f)) { + Yap_CloseMemoryStream( sno ); if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { @@ -1329,11 +1324,7 @@ Int Yap_StreamToFileNo(Term t) { Yap_CheckStream(t, (Input_Stream_f | Output_Stream_f), "StreamToFileNo"); if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); -#if _MSC_VER || defined(__MINGW32__) - return ((Int)(GLOBAL_Stream[sno].u.pipe.hdl)); -#else return (GLOBAL_Stream[sno].u.pipe.fd); -#endif #if HAVE_SOCKET } else if (GLOBAL_Stream[sno].status & Socket_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); diff --git a/os/sysbits.c b/os/sysbits.c index 38aaefe5c..f5533fc47 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -55,7 +55,7 @@ static int chdir(char *); void exit(int); -#ifdef __WINDOWS__ +#ifdef _WIN32 void Yap_WinError(char *yap_error) { @@ -452,7 +452,7 @@ PrologPath(const char *Y, char *X) { static bool ChDir(const char *path) { bool rc = false; - char *qpath = Yap_AbsoluteFile(path, NULL, true); + const char *qpath = Yap_AbsoluteFile(path, NULL, true); #ifdef __ANDROID__ if (GLOBAL_AssetsWD) { @@ -487,7 +487,7 @@ static bool ChDir(const char *path) { #else rc = (chdir(qpath) == 0); #endif - free( qpath ); + free( (void *)qpath ); return rc; } #if _WIN32 || defined(__MINGW32__) @@ -501,7 +501,8 @@ BaseName(const char *X) { return qpath; } -char * + +const char * DirName(const char *X) { char dir[YAP_FILENAME_MAX]; char drive[YAP_FILENAME_MAX]; @@ -520,7 +521,7 @@ DirName(const char *X) { } #endif -static char *myrealpath( const char *path, char *out) +static const char *myrealpath( const char *path, char *out) { #if _WIN32 || defined(__MINGW32__) DWORD retval=0; @@ -539,21 +540,28 @@ static char *myrealpath( const char *path, char *out) return out; #elif HAVE_REALPATH { - char *rc = realpath(path,out); - char *s0; + const char *rc; + rc = ( const char *)realpath(path,out); + const char *s0, *s; if (rc == NULL && (errno == ENOENT|| errno == EACCES)) { - char *s = basename((char *)path); + + if ( is_directory(rc)) { + s = (const char *)path; + } else { + s = basename((char *)path); + path = dirname((char *)path); + } s0 = malloc(strlen(s)+1); - strcpy(s0, s); - if ((rc = myrealpath(dirname((char *)path), out))==NULL) { - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find file %s: %s", path, strerror(errno)); - return NULL; + strcpy((char *)s0, s); + if ((rc = myrealpath(path, out))==NULL) { + Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find file %s: %s", path, strerror(errno)); + return NULL; } if(rc[strlen(rc)-1] != '/' ) - strcat(rc, "/"); - strcat(rc, s0); - free(s0); + strcat((char *)rc, "/"); + strcat((char *)rc, s0); + free((void *)s0); } return rc; } @@ -596,39 +604,37 @@ PrologExpandVars(const char *spec, char *tmp0, bool ok_to) return tmp; } -/** +/** * generate absolute path, if ok first expand SICStus Prolog style - * - * @param spec the file path, including ~ and $ - * @param tmp where to store the file - * @param ok where to process ~and $ - * + * + * @param[in] spec the file path, including `~` and `$`. + * @param[out] tmp where to store the file. + * @param[in] ok where to process `~` and `$`. + * * @return tmp, or NULL - */ -char * + */ +const char * Yap_AbsoluteFile(const char *spec, char *tmp, bool ok) { char *t1 = NULL; t1 = PrologExpandVars(spec, t1, ok); if (!t1) return NULL; - char *rc = myrealpath(t1, tmp); - return rc; + return myrealpath(t1, tmp); } -/** +/** * @pred prolog_expanded_file_system_path( +PrologPath, +ExpandVars, -OSPath ) - * + * * Apply basic transformations to paths, and conidtionally apply * traditional SICStus-style variable expansion. * - * @param PrologPath the source, may be atom or string - * @param ExpandVars expand initial occurrence of ~ or $ + * @param PrologPath the source, may be atom or string * @param ExpandVars expand initial occurrence of ~ or $ * @param Prefix add this path before _PrologPath_ * @param OSPath pathname. - * - * @return + * + * @return */ static Int prolog_expanded_file_system_path( USES_REGS1 ) @@ -639,38 +645,36 @@ prolog_expanded_file_system_path( USES_REGS1 ) char *o = LOCAL_FileNameBuf; bool flag; const char *cmd, *p0; - + if (IsAtomTerm(t1)) { cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; } else if (IsStringTerm(t1)) { cmd = StringOfTerm(t1); } else { - - return FALSE; - } - if (t2 == TermTrue) - flag = true; - else if (t2 == TermFalse) - flag = false; - else return false; + } + if (t2 == TermTrue) { + flag = true; + } else if (t2 == TermFalse) { + flag = false; + } else { + return false; + } if (IsAtomTerm(t3)) { p0 = RepAtom(AtomOfTerm(t3))->StrOfAE; } else if (IsStringTerm(t3)) { p0 = StringOfTerm(t3); } else { - - return FALSE; + return false; } const char *out = PrologExpandVars(cmd,o,flag); if (Yap_IsAbsolutePath(out)) { return Yap_unify(MkAtomTerm(Yap_LookupAtom(out)), ARG4); } else if (p0[0] == '\0') { - char *rc = myrealpath(out, LOCAL_FileNameBuf2 ); + const char *rc = myrealpath(out, LOCAL_FileNameBuf2 ); return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); } else { - strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX ); - char *pt = LOCAL_FileNameBuf2 + strlen( LOCAL_FileNameBuf ); + char *pt =strncpy( LOCAL_FileNameBuf2, p0, YAP_FILENAME_MAX ); if ( !dir_separator( pt[-1] )) { #if ATARI || _MSC_VER || defined(__MINGW32__) pt[0] = '\\'; @@ -678,16 +682,17 @@ prolog_expanded_file_system_path( USES_REGS1 ) pt[0] = '/'; #endif pt++; + pt[0] = '\n'; } out = strncpy( pt, out, YAP_FILENAME_MAX -(pt -LOCAL_FileNameBuf2) ); - char *rc = myrealpath(out, LOCAL_FileNameBuf ); - return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); - } + const char *rc = myrealpath(LOCAL_FileNameBuf, LOCAL_FileNameBuf2 ); + return Yap_unify(MkAtomTerm(Yap_LookupAtom(rc)), ARG4); + } } #define EXPAND_FILENAME_DEFS() \ PAR("parameter_expansion", isatom, EXPAND_FILENAME_PARAMETER_EXPANSION), \ - PAR("commands", boolean, EXPAND_FILENAME_COMMANDS), \ + PAR("commands", booleanFlag, EXPAND_FILENAME_COMMANDS), \ PAR(NULL, ok, EXPAND_FILENAME_END) #define PAR(x, y, z) z @@ -710,20 +715,22 @@ do_expand_file_name(Term t1, Term opts USES_REGS) { xarg *args; expand_filename_enum_choices_t i; - bool use_glob = false; - char **ss = NULL; - char *tmp = NULL; - const char *spec; + bool use_system_expansion = true, glob_vs_wordexp = true; + const char *tmp = NULL; char *tmpe = NULL; - size_t j, pathcount; - int flags = 0; -#if HAVE_WORDEXP - wordexp_t wresult; -#endif + const char *spec; #if HAVE_GLOB glob_t gresult; #endif - + #if HAVE_GLOB || HAVE_WORDEXP + char **ss = NULL; + int flags = 0, j; +#endif +#if HAVE_WORDEXP + wordexp_t wresult; +#endif + Term tf; + if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, NULL); return TermNil; @@ -739,163 +746,181 @@ do_expand_file_name(Term t1, Term opts USES_REGS) if (args == NULL) { return TermNil; } + tmpe = malloc(YAP_FILENAME_MAX+1); + for (i = 0; i < EXPAND_FILENAME_END; i++) { if (args[i].used) { - Term t = args[i].tvalue; + Term t = args[i].tvalue; switch (i) { - case EXPAND_FILENAME_PARAMETER_EXPANSION: - if (t == TermProlog) { - use_glob = true; - tmpe = malloc(YAP_FILENAME_MAX+1); - if (tmpe == NULL) { - return TermNil; - } - tmpe = expandVars( spec, tmpe, YAP_FILENAME_MAX); -#ifdef GLOB_BRACE - flags = GLOB_BRACE|GLOB_TILDE; + case EXPAND_FILENAME_PARAMETER_EXPANSION: + if (t == TermProlog) { + if (tmpe == NULL) { + return TermNil; + } + tmpe = expandVars( spec, tmpe, YAP_FILENAME_MAX); + spec = tmpe; + } else if (t == TermTrue) { + use_system_expansion = true; + } else if (t == TermFalse) { + use_system_expansion = false; + } + break; + case EXPAND_FILENAME_COMMANDS: + if (!use_system_expansion) { + use_system_expansion = true; +#ifdef WRDE_NOCMD + if (t == TermFalse) { + flags = WRDE_NOCMD; + } #endif - flags |= GLOB_NOCHECK; - spec = tmpe; - } else if (t == TermTrue) { - use_glob = false; - } else if (t == TermFalse) { - use_glob = true; - } - break; - case EXPAND_FILENAME_COMMANDS: - if (!use_glob) { - if (t == TermFalse) { - flags = WRDE_NOCMD; - } - } - case EXPAND_FILENAME_END: - break; + } + case EXPAND_FILENAME_END: + break; } } } #if _WIN32 || defined(__MINGW32__) - char u[YAP_FILENAME_MAX+1]; - // first pass, remove Unix style stuff - if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) - return NULL; - spec = (const char *)u; -#endif - if (tmp == NULL) { - tmp = malloc(YAP_FILENAME_MAX+1); - if (tmp == NULL) { + { + char u[YAP_FILENAME_MAX+1]; + WIN32_FIND_DATA find; + HANDLE hFind; + CELL *dest; + + // first pass, remove Unix style stuff + if (unix2win(spec, u, YAP_FILENAME_MAX) == NULL) return TermNil; - } - } -#if ( __WIN32 || __MINGW32__ ) - DWORD retval=0; - // notice that the file does not need to exist - if (ini == NULL) { - ini = malloc(strlen(w)+1); - } - retval = ExpandEnvironmentStrings(pattern, - expanded, - maxlen); + spec = (const char *)u; - if (retval == 0) - { - Yap_WinError("Generating a full path name for a file" ); - return NULL; + if (!use_system_expansion) { + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); } - return expanded; + hFind = FindFirstFile(spec, &find); + + if (hFind == INVALID_HANDLE_VALUE) + { + return TermNil; + } + else + { + tf = AbsPair(HR); + HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); + HR[1] = TermNil; + dest = HR+1; + HR += 2; + while (FindNextFile(hFind, &find)) { + *dest = AbsPair(HR); + HR[0] = MkAtomTerm(Yap_LookupAtom(find.cFileName)); + HR[1] = TermNil; + dest = HR+1; + HR += 2; + } + FindClose(hFind); + } + return tf; + } #elif HAVE_WORDEXP || HAVE_GLOB + if (!use_system_expansion) { + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); + } /* Expand the string for the program to run. */ - if (use_glob) { + size_t pathcount; + if ( glob_vs_wordexp ) { #if HAVE_GLOB - switch (glob (spec, flags, NULL, &gresult)) - { - case 0: /* Successful. */ - ss = gresult.gl_pathv; - pathcount = gresult.gl_pathc; - if (pathcount) { - break; - } - case GLOB_NOMATCH: - globfree(&gresult); - { - Term t; - char *out = LOCAL_FileNameBuf; - t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) )); - return MkPairTerm( t, TermNil ); - } - case GLOB_ABORTED: - PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "glob aborted: %sn", strerror(errno)); - globfree (&gresult); - return TermNil; - case GLOB_NOSPACE: - Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "glob ran out of space: %sn", strerror(errno)); - globfree (&gresult); - return TermNil; - /* If the error was WRDE_NOSPACE, - then perhaps part of the result was allocated. */ - default: /* Some other error. */ - return TermNil; - } -#endif - } else { -#if HAVE_WORDEXP - int rc; - switch ((rc = wordexp (spec, &wresult, flags))) - { - case 0: /* Successful. */ - ss = wresult.we_wordv; - pathcount = wresult.we_wordc; - if (pathcount) { - break; - } else { - Term t; - char *out = LOCAL_FileNameBuf; - t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ) ); - wordfree (&wresult); - return MkPairTerm( t, TermNil ); - } - case WRDE_NOSPACE: - /* If the error was WRDE_NOSPACE, - then perhaps part of the result was allocated. */ - Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "wordexp ran out of space: %s", strerror(errno)); - wordfree (&wresult); - return TermNil; - default: /* Some other error. */ - ; PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "wordexp failed: %s", strerror(errno)); - wordfree (&wresult); - return TermNil; - } -#endif - } - Term tf = TermNil; - for (j = 0; j < pathcount; j++) { - const char *s = ss[pathcount-(j+1)]; -#if HAVE_REALPATH - s = myrealpath(s, tmp); -#endif - //if (!exists(s)) - // continue; - Atom a = Yap_LookupAtom(s); - tf = MkPairTerm(MkAtomTerm( a ),tf); - } +#ifdef GLOB_NOCHECK + flags = GLOB_NOCHECK; #else - // just use basic - if (expanded == NULL) { - expanded = malloc(strlen(pattern)+1); - } - strcpy(expanded, pattern); + flags = 0; #endif - if (tmp) - free( tmp ); - if (tmpe) - free( tmpe ); +#ifdef GLOB_BRACE + flags |= GLOB_BRACE|GLOB_TILDE; +#endif + switch (glob (spec, flags, NULL, &gresult)) + { + case 0: /* Successful. */ + ss = gresult.gl_pathv; + pathcount = gresult.gl_pathc; + if (pathcount) { + break; + } + case GLOB_NOMATCH: + globfree(&gresult); + { + return TermNil; + } + case GLOB_ABORTED: + PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "glob aborted: %sn", strerror(errno)); + globfree (&gresult); + return TermNil; + case GLOB_NOSPACE: + Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "glob ran out of space: %sn", strerror(errno)); + globfree (&gresult); + return TermNil; + /* If the error was WRDE_NOSPACE, + then perhaps part of the result was allocated. */ + default: /* Some other error. */ + return TermNil; + } +#endif + } else { +#if HAVE_WORDEXP + int rc; + memset( &wresult,0,sizeof(wresult) ); + switch ((rc = wordexp (spec, &wresult, flags))) + { + case 0: /* Successful. */ + ss = wresult.we_wordv; + pathcount = wresult.we_wordc; + if (pathcount) { + break; + } else { + Term t; + char *out = LOCAL_FileNameBuf; + t = MkAtomTerm( Yap_LookupAtom( expandVars(spec, out, YAP_FILENAME_MAX-1) ) ); + wordfree (&wresult); + return MkPairTerm( t, TermNil ); + } + case WRDE_NOSPACE: + /* If the error was WRDE_NOSPACE, + then perhaps part of the result was allocated. */ + Yap_Error(RESOURCE_ERROR_HEAP, ARG1, "wordexp ran out of space: %s", strerror(errno)); + wordfree (&wresult); + return TermNil; + default: /* Some other error. */ + PlIOError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "wordexp failed: %s", strerror(errno)); + wordfree (&wresult); + return TermNil; + } +#endif + } + tf = TermNil; + for (j = 0; j < pathcount; j++) { + const char *s = ss[pathcount-(j+1)]; +#if HAVE_REALPATH + tmp = myrealpath(s,(char *) tmp); +#else + tmp = s; +#endif + //if (!exists(s)) + // continue; + Atom a = Yap_LookupAtom(tmp); + tf = MkPairTerm(MkAtomTerm( a ),tf); + } #if HAVE_GLOB - if (use_glob) + if (use_system_expansion && glob_vs_wordexp) globfree( &gresult ); #endif #if HAVE_WORDEXP - if (!use_glob) + if (use_system_expansion && !glob_vs_wordexp) wordfree( &wresult ); +#endif + if (tmp) + free( (void *)tmp ); + if (tmpe) + free( tmpe ); +#else + // just use basic + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(spec)), TermNil); #endif return tf; } @@ -1294,7 +1319,7 @@ Yap_InitPageSize(void) return true; } - static char * + static const char * expandWithPrefix(const char *source, const char *root, char *result) { char *work; @@ -1431,7 +1456,7 @@ Yap_InitPageSize(void) root = expandWithPrefix( root, NULL, save_buffer ); } // { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "root= %s %s ", root, source) ; } - char *work = expandWithPrefix( source, root, result ); + const char *work = expandWithPrefix( source, root, (char *)result ); // expand names in case you have // to add a prefix @@ -1560,34 +1585,31 @@ Yap_InitPageSize(void) static Int p_shell ( USES_REGS1 ) { /* '$shell'(+SystCommand) */ + const char *cmd; + Term t1 = Deref (ARG1); + if (IsAtomTerm(t1)) + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; + else if (IsStringTerm(t1)) + cmd = StringOfTerm(t1); + else + return FALSE; #if _MSC_VER || defined(__MINGW32__) - char *cmd; - term_t A1 = Yap_InitSlot(ARG1); - if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) ) - { int rval = System(cmd); + { int rval = system(cmd); - return rval == 0; + return rval == 0; } - return FALSE; + return true; #else #if HAVE_SYSTEM char *shell; register int bourne = FALSE; - Term t1 = Deref (ARG1); - const char *cmd; shell = (char *) getenv ("SHELL"); if (!strcmp (shell, "/bin/sh")) bourne = TRUE; if (shell == NIL) bourne = TRUE; - if (IsAtomTerm(t1)) - cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; - else if (IsStringTerm(t1)) - cmd = StringOfTerm(t1); - else - return FALSE; /* Yap_CloseStreams(TRUE); */ if (bourne) return system( cmd ) == 0; @@ -1639,10 +1661,26 @@ Yap_InitPageSize(void) static Int p_system ( USES_REGS1 ) { /* '$system'(+SystCommand) */ + const char *cmd; + Term t1 = Deref (ARG1); + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound"); + return FALSE; + } else if (IsAtomTerm(t1)) { + cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; + } else if (IsStringTerm(t1)) { + cmd = StringOfTerm(t1); + } else { + if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { + Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1"); + return false; + } + cmd = LOCAL_FileNameBuf; + } + /* Yap_CloseStreams(TRUE); */ #if _MSC_VER || defined(__MINGW32__) - char *cmd; - term_t A1 = Yap_InitSlot(ARG1); - if ( PL_get_chars(A1, &cmd, CVT_ALL|REP_FN|CVT_EXCEPTION) ) + { STARTUPINFO si; PROCESS_INFORMATION pi; @@ -1652,7 +1690,7 @@ Yap_InitPageSize(void) // Start the child process. if( !CreateProcess( NULL, // No module name (use command line) - cmd, // Command line + (LPSTR)cmd, // Command line NULL, // Process handle not inheritable NULL, // Thread handle not inheritable FALSE, // Set handle inheritance to FALSE @@ -1678,32 +1716,14 @@ Yap_InitPageSize(void) return FALSE; #elif HAVE_SYSTEM - Term t1 = Deref (ARG1); - const char *s; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"argument to system/1 unbound"); - return FALSE; - } else if (IsAtomTerm(t1)) { - s = RepAtom(AtomOfTerm(t1))->StrOfAE; - } else if (IsStringTerm(t1)) { - s = StringOfTerm(t1); - } else { - if (!Yap_GetName (LOCAL_FileNameBuf, YAP_FILENAME_MAX, t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"argument to system/1"); - return FALSE; - } - s = LOCAL_FileNameBuf; - } - /* Yap_CloseStreams(TRUE); */ #if _MSC_VER _flushall(); #endif - if (system (s)) { + if (system (cmd)) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"%s in system(%s)", strerror(errno), s); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"%s in system(%s)", strerror(errno), cmd); #else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"in system(%s)", s); + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM,t1,"in system(%s)", cmd); #endif return FALSE; } @@ -1877,38 +1897,6 @@ Yap_InitPageSize(void) #endif } - /* wrapper for alarm system call */ -#if _MSC_VER || defined(__MINGW32__) - - static DWORD WINAPI - DoTimerThread(LPVOID targ) - { - Int *time = (Int *)targ; - HANDLE htimer; - LARGE_INTEGER liDueTime; - - htimer = CreateWaitableTimer(NULL, FALSE, NULL); - liDueTime.QuadPart = -10000000; - liDueTime.QuadPart *= time[0]; - /* add time in usecs */ - liDueTime.QuadPart -= time[1]*10; - /* Copy the relative time into a LARGE_INTEGER. */ - if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) { - return(FALSE); - } - if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0) - fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError()); - Yap_signal (YAP_WINTIMER_SIGNAL); - /* now, say what is going on */ - Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); - ExitThread(1); -#if _MSC_VER - return(0L); -#endif - } - -#endif - static Int p_host_type( USES_REGS1 ) { Term out = MkAtomTerm(Yap_LookupAtom(HOST_ALIAS)); @@ -2294,4 +2282,4 @@ Yap_InitPageSize(void) Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag); Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag); } - + diff --git a/os/sysbits.h b/os/sysbits.h index a84af95d9..36d0103f7 100644 --- a/os/sysbits.h +++ b/os/sysbits.h @@ -13,22 +13,98 @@ * */ +#if _WIN32 || defined(__MINGW32__) +#if !defined(MINGW_HAS_SECURE_API) +#define MINGW_HAS_SECURE_API 1 +#endif +//#undef _POSIX_ +#endif +#include "Yap.h" +#include "Yatom.h" +#include "YapHeap.h" +#include "yapio.h" +#include "eval.h" +#if _WIN32 || defined(__MINGW32__) +#include +/* Windows */ +#include +#include +#include +#include "Shlwapi.h" +#endif +#ifdef HAVE_UNISTD_H +#include +#endif +#if HAVE_STDARG_H +#include +#endif +#include + +#if HAVE_SYS_PARAM_H +#include +#endif + + +#ifdef FENV_H +#include +#endif +#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#if HAVE_STDARG_H +#include +#endif +#if HAVE_CTYPE_H +#include +#endif +#if HAVE_SYS_PARAMS_H +#include +#endif +#if HAVE_SYS_TYPES_H +#include +#endif +#ifdef HAVE_SYS_STAT_H +#include +#endif +#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) +#include +#endif +#if HAVE_STRING_H +#include +#endif +#if HAVE_LIBGEN_H +#include +#endif +#if HAVE_WCTYPE_H +#include +#endif +#if HAVE_LIMITS_H +#include +#endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_FCNTL_H +#include +#endif +#if !HAVE_STRNCAT +#define strncat(X,Y,Z) strcat(X,Y) +#endif +#if !HAVE_STRNCPY +#define strncpy(X,Y,Z) strcpy(X,Y) +#endif +#include "iopreds.h" + +#if HAVE_SIGNAL_H + +#include + +#endif +#ifdef MPW +#define signal sigset +#endif + /* windows.h does not like absmi.h, this should fix it for now */ -#if _WIN32 || __MINGW32__ -#include -#endif -#include "absmi.h" -#include "yapio.h" -#include "iopreds.h" -#include "alloc.h" #include -#if STDC_HEADERS -#include -#endif -#if HAVE_WINDOWS_H -#include -#endif #if HAVE_SYS_TIME_H && !_MSC_VER #include #endif @@ -41,12 +117,6 @@ #if HAVE_STRING_H #include #endif -#if !HAVE_STRNCAT -#define strncat(X,Y,Z) strcat(X,Y) -#endif -#if !HAVE_STRNCPY -#define strncpy(X,Y,Z) strcpy(X,Y) -#endif #if HAVE_GETPWNAM #include #endif @@ -61,17 +131,6 @@ #include #endif #if _MSC_VER || defined(__MINGW32__) -#include -/* required for DLL compatibility */ -#if HAVE_DIRECT_H -#include -#endif -#include -#include -#else -#if HAVE_SYS_PARAM_H -#include -#endif #endif /* CYGWIN seems to include this automatically */ #if HAVE_FENV_H && !defined(__CYGWIN__) @@ -86,13 +145,7 @@ #if HAVE_LIBGEN_H #include #endif -#if HAVE_STDARG_H -#include -#endif -#if HAVE_ERRNO_H -#include -#endif -#if HAVE_READLINE_READLINE_H +#if defined(HAVE_READLINE_READLINE_H) #include #endif diff --git a/os/time.c b/os/time.c index ef1227a7f..617d0fca9 100644 --- a/os/time.c +++ b/os/time.c @@ -159,8 +159,8 @@ static FILETIME StartOfTimes_sys, last_time_sys; static clock_t TimesStartOfTimes, Times_last_time; /* store user time in this variable */ -static void -InitTime (int wid) +void +Yap_InitTime (int wid) { HANDLE hProcess = GetCurrentProcess(); FILETIME CreationTime, ExitTime, KernelTime, UserTime; diff --git a/os/writeterm.c b/os/writeterm.c index d8564dd26..337b3317e 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -100,19 +100,19 @@ static char SccsId[] = "%W% %G%"; #define WRITE_DEFS() \ PAR( "module", isatom, WRITE_MODULE ), \ PAR( "attributes", isatom, WRITE_ATTRIBUTES ), \ - PAR( "cycles", boolean, WRITE_CYCLES ), \ - PAR( "quoted", boolean, WRITE_QUOTED ), \ - PAR( "ignore_ops", boolean, WRITE_IGNORE_OPS ), \ + PAR( "cycles", booleanFlag, WRITE_CYCLES ), \ + PAR( "quoted", booleanFlag, WRITE_QUOTED ), \ + PAR( "ignore_ops", booleanFlag, WRITE_IGNORE_OPS ), \ PAR( "max_depth",nat, WRITE_MAX_DEPTH ), \ - PAR( "numbervars", boolean, WRITE_NUMBERVARS ), \ - PAR( "portrayed", boolean, WRITE_PORTRAYED ), \ - PAR( "portray", boolean, WRITE_PORTRAY ), \ + PAR( "numbervars", booleanFlag, WRITE_NUMBERVARS ), \ + PAR( "portrayed", booleanFlag, WRITE_PORTRAYED ), \ + PAR( "portray", booleanFlag, WRITE_PORTRAY ), \ PAR( "priority", nat, WRITE_PRIORITY ), \ - PAR( "character_escapes", boolean, WRITE_CHARACTER_ESCAPES ), \ - PAR( "backquotes", boolean, WRITE_BACKQUOTES ), \ - PAR( "brace_terms", boolean, WRITE_BRACE_TERMS ), \ - PAR( "fullstop", boolean, WRITE_FULLSTOP ), \ - PAR( "nl", boolean, WRITE_NL ), \ + PAR( "character_escapes", booleanFlag, WRITE_CHARACTER_ESCAPES ), \ + PAR( "backquotes", booleanFlag, WRITE_BACKQUOTES ), \ + PAR( "brace_terms", booleanFlag, WRITE_BRACE_TERMS ), \ + PAR( "fullstop", booleanFlag, WRITE_FULLSTOP ), \ + PAR( "nl", booleanFlag, WRITE_NL ), \ PAR( "variable_names",ok, WRITE_VARIABLE_NAMES ), \ PAR( NULL, ok, WRITE_END ) diff --git a/os/yapio.h b/os/yapio.h index a5ec8c83a..ac00cd08d 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -114,7 +114,7 @@ int Yap_growtrail_in_parser(tr_fr_ptr *, TokEntry **, VarEntry **); bool Yap_IsAbsolutePath(const char *p); Atom Yap_TemporaryFile(const char *prefix, int *fd); -char *Yap_AbsoluteFile(const char *spec, char *tmp, bool expand); +const char *Yap_AbsoluteFile(const char *spec, char *tmp, bool expand); typedef enum mem_buf_source { MEM_BUF_CODE = 1, diff --git a/os/ypsocks.c b/os/ypsocks.c index fdf2a820e..c304d92b3 100755 --- a/os/ypsocks.c +++ b/os/ypsocks.c @@ -16,12 +16,7 @@ *************************************************************************/ -#include "Yap.h" - -#include "Yatom.h" -#include "YapHeap.h" -#include "yapio.h" -#include "iopreds.h" +#include "sysbits.h" #if HAVE_SOCKET diff --git a/packages/CLPBN/horus/CMakeLists.txt b/packages/CLPBN/horus/CMakeLists.txt index 2741ee32f..06354ad25 100644 --- a/packages/CLPBN/horus/CMakeLists.txt +++ b/packages/CLPBN/horus/CMakeLists.txt @@ -69,4 +69,5 @@ install(TARGETS horus HorusCli RUNTIME DESTINATION ${bindir} LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/packages/bdd/CMakeLists.txt b/packages/bdd/CMakeLists.txt index 3a3c29b2d..ea475c490 100644 --- a/packages/bdd/CMakeLists.txt +++ b/packages/bdd/CMakeLists.txt @@ -67,6 +67,8 @@ IF (CUDD_FOUND) install(TARGETS cudd LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} + ) INSTALL(FILES bdd.yap DESTINATION ${libpl}) diff --git a/packages/bdd/simplecudd_lfi/problogbdd_lfi.c b/packages/bdd/simplecudd_lfi/problogbdd_lfi.c index 667d8aa0e..9cc09b0d5 100644 --- a/packages/bdd/simplecudd_lfi/problogbdd_lfi.c +++ b/packages/bdd/simplecudd_lfi/problogbdd_lfi.c @@ -190,7 +190,7 @@ #include "iqueue.h" #include #include -#define VERSION "2.0.0" +#define VERSION "2.0.0" int all_loaded_for_deterministic_variables(namedvars varmap, int disp); @@ -236,16 +236,20 @@ void termhandler(int num); void myexpand(extmanager MyManager, DdNode *Current); double CalcProbability(extmanager MyManager, DdNode *Current); double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current); -gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern, int type); -double CalcExpectedCountsUp(extmanager * MyManager, DdNode *Current, char *query_id) ; -double CalcExpectedCountsDown(extmanager * MyManager, DdNode *Current, char *query_id); -double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_id, int calcdown_needed); +gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, + char *TargetPattern, int type); +double CalcExpectedCountsUp(extmanager *MyManager, DdNode *Current, + char *query_id); +double CalcExpectedCountsDown(extmanager *MyManager, DdNode *Current, + char *query_id); +double CalcExpectedCounts(extmanager *MyManager, DdNode *Current, + char *query_id, int calcdown_needed); int patterncalculated(char *pattern, extmanager MyManager, int loc); -char * extractpattern(const char *thestr); +char *extractpattern(const char *thestr); int main(int argc, char **arg) { extmanager MyManager; - DdNode *bdd = NULL, **forest = NULL, *bakbdd= NULL; + DdNode *bdd = NULL, **forest = NULL, *bakbdd = NULL; bddfileheader fileheader; int i, ivarcnt, code, curbdd; gradientpair tvalue; @@ -258,7 +262,8 @@ int main(int argc, char **arg) { if (params.errorcnt > 0) { printhelp(argc, arg); for (i = 0; i < params.errorcnt; i++) { - fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]); + fprintf(stderr, "Error: not known or error at parameter %s.\n", + arg[params.error[i]]); } return -1; } @@ -269,19 +274,32 @@ int main(int argc, char **arg) { return -1; } - if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l' && arg[params.method][0] != 'e' && arg[params.method][0] != 'd') { + if (params.method != 0 && arg[params.method][0] != 'g' && + arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && + arg[params.method][0] != 'l' && arg[params.method][0] != 'e' && + arg[params.method][0] != 'd') { printhelp(argc, arg); - fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [o]nline, [e]xpected counts, probability with [d]eterministic nodes.\n"); + fprintf(stderr, "Error: you must choose a calculation method beetween " + "[p]robability, [g]radient, [l]ine search, [o]nline, " + "[e]xpected counts, probability with [d]eterministic " + "nodes.\n"); return -1; } - if (params.method != 0 && (arg[params.method][0] == 'g' || arg[params.method][0] == 'p' || arg[params.method][0] == 'l'|| arg[params.method][0] == 'e'|| arg[params.method][0] == 'd') && params.inputfile == -1) { + if (params.method != 0 && + (arg[params.method][0] == 'g' || arg[params.method][0] == 'p' || + arg[params.method][0] == 'l' || arg[params.method][0] == 'e' || + arg[params.method][0] == 'd') && + params.inputfile == -1) { printhelp(argc, arg); - fprintf(stderr, "Error: an input file is necessary for probability, gradient, line search calculation or expected counts methods.\n"); + fprintf(stderr, "Error: an input file is necessary for probability, " + "gradient, line search calculation or expected counts " + "methods.\n"); return -1; } - if (params.debug) DEBUGON; + if (params.debug) + DEBUGON; RAPIDLOADON; SETMAXBUFSIZE(params.maxbufsize); @@ -304,43 +322,44 @@ int main(int argc, char **arg) { bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap); ivarcnt = GetVarCount(MyManager.manager); } else { - //fprintf(stderr,"reading file \n"); + // fprintf(stderr,"reading file \n"); fileheader = ReadFileHeader(arg[params.loadfile]); - switch(fileheader.filetype) { - case BDDFILE_SCRIPT: - // fprintf(stderr," ..... %i \n",fileheader.varcnt); - MyManager.manager = simpleBDDinit(fileheader.varcnt); - MyManager.t = HIGH(MyManager.manager); - MyManager.f = LOW(MyManager.manager); - MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - if (fileheader.version > 1) { - forest = FileGenerateBDDForest(MyManager.manager, MyManager.varmap, fileheader); - bdd = forest[0]; - bakbdd = bdd; - } else { - forest = NULL; - bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader); - bakbdd = bdd; - } - ivarcnt = fileheader.varcnt; - break; - case BDDFILE_NODEDUMP: - MyManager.manager = simpleBDDinit(fileheader.varcnt); - MyManager.t = HIGH(MyManager.manager); - MyManager.f = LOW(MyManager.manager); - MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); - bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile); - ivarcnt = fileheader.varcnt; - break; - default: - fprintf(stderr, "Error: not a valid file format to load.\n"); - return -1; - break; + switch (fileheader.filetype) { + case BDDFILE_SCRIPT: + // fprintf(stderr," ..... %i \n",fileheader.varcnt); + MyManager.manager = simpleBDDinit(fileheader.varcnt); + MyManager.t = HIGH(MyManager.manager); + MyManager.f = LOW(MyManager.manager); + MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); + if (fileheader.version > 1) { + forest = FileGenerateBDDForest(MyManager.manager, MyManager.varmap, + fileheader); + bdd = forest[0]; + bakbdd = bdd; + } else { + forest = NULL; + bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader); + bakbdd = bdd; + } + ivarcnt = fileheader.varcnt; + break; + case BDDFILE_NODEDUMP: + MyManager.manager = simpleBDDinit(fileheader.varcnt); + MyManager.t = HIGH(MyManager.manager); + MyManager.f = LOW(MyManager.manager); + MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart); + bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, + fileheader.inputfile); + ivarcnt = fileheader.varcnt; + break; + default: + fprintf(stderr, "Error: not a valid file format to load.\n"); + return -1; + break; } // fprintf(stderr,"bdd built\n"); } - alarm(0); // problem specifics @@ -349,104 +368,136 @@ int main(int argc, char **arg) { ivarcnt = RepairVarcnt(&MyManager.varmap); code = 0; if (params.inputfile != -1) { - if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1; + if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) + return -1; // if (!all_loaded(MyManager.varmap, 1)) return -1; all_loaded_for_deterministic_variables(MyManager.varmap, 1); } // impose a predifined order good for debugging - // can be used with a partial number of variables to impose ordering at beggining of BDD + // can be used with a partial number of variables to impose ordering at + // beggining of BDD if (params.orderfile != -1) { - ImposeOrder(MyManager.manager, MyManager.varmap, GetVariableOrder(arg[params.orderfile], MyManager.varmap.varcnt)); + ImposeOrder( + MyManager.manager, MyManager.varmap, + GetVariableOrder(arg[params.orderfile], MyManager.varmap.varcnt)); } curbdd = 0; do { MyManager.his = InitHistory(ivarcnt); if (params.method != 0) { - switch(arg[params.method][0]) { - case 'g': - for (i = 0; i < MyManager.varmap.varcnt; i++) { - if (MyManager.varmap.vars[i] != NULL) { + switch (arg[params.method][0]) { + case 'g': + for (i = 0; i < MyManager.varmap.varcnt; i++) { + if (MyManager.varmap.vars[i] != NULL) { - // check whether this is a continues fact - if (MyManager.varmap.dynvalue[i] == NULL) { // nope, regular fact - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 0); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } - ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); - } - } else { // it is! let's do the Hybrid Problog Magic - // first for mu - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 1); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,mu,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,mu,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } + // check whether this is a continues fact + if (MyManager.varmap.dynvalue[i] == NULL) { // nope, regular fact + varpattern = extractpattern(MyManager.varmap.vars[i]); + if ((varpattern == NULL) || + (!patterncalculated(varpattern, MyManager, i))) { + tvalue = CalcGradient(MyManager, bdd, + i + MyManager.varmap.varstart, + varpattern, 0); + probability = tvalue.probability; + if (varpattern == NULL) { + printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], + MyManager.varmap.vars[i], tvalue.gradient); + } else { + varpattern[strlen(varpattern) - 2] = '\0'; + printf("query_gradient(%s,%s,p,%e).\n", arg[params.queryid], + varpattern, tvalue.gradient); } ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); - - // then for sigma - varpattern = extractpattern(MyManager.varmap.vars[i]); - if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) { - tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern, 2); - probability = tvalue.probability; - if (varpattern == NULL) { - printf("query_gradient(%s,%s,sigma,%e).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient); - } else { - varpattern[strlen(varpattern) - 2] = '\0'; - printf("query_gradient(%s,%s,sigma,%e).\n", arg[params.queryid], varpattern, tvalue.gradient); - } - } - ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - if (varpattern != NULL) free(varpattern); + if (varpattern != NULL) + free(varpattern); } + } else { // it is! let's do the Hybrid Problog Magic + // first for mu + varpattern = extractpattern(MyManager.varmap.vars[i]); + if ((varpattern == NULL) || + (!patterncalculated(varpattern, MyManager, i))) { + tvalue = CalcGradient(MyManager, bdd, + i + MyManager.varmap.varstart, + varpattern, 1); + probability = tvalue.probability; + if (varpattern == NULL) { + printf("query_gradient(%s,%s,mu,%e).\n", + arg[params.queryid], MyManager.varmap.vars[i], + tvalue.gradient); + } else { + varpattern[strlen(varpattern) - 2] = '\0'; + printf("query_gradient(%s,%s,mu,%e).\n", + arg[params.queryid], varpattern, tvalue.gradient); + } + } + ReInitHistory(MyManager.his, MyManager.varmap.varcnt); + if (varpattern != NULL) + free(varpattern); - } else { - fprintf(stderr, "Error: no variable name given for parameter.\n"); + // then for sigma + varpattern = extractpattern(MyManager.varmap.vars[i]); + if ((varpattern == NULL) || + (!patterncalculated(varpattern, MyManager, i))) { + tvalue = CalcGradient(MyManager, bdd, + i + MyManager.varmap.varstart, + varpattern, 2); + probability = tvalue.probability; + if (varpattern == NULL) { + printf("query_gradient(%s,%s,sigma,%e).\n", + arg[params.queryid], MyManager.varmap.vars[i], + tvalue.gradient); + } else { + varpattern[strlen(varpattern) - 2] = '\0'; + printf("query_gradient(%s,%s,sigma,%e).\n", + arg[params.queryid], varpattern, tvalue.gradient); + } + } + ReInitHistory(MyManager.his, MyManager.varmap.varcnt); + if (varpattern != NULL) + free(varpattern); } + + } else { + fprintf(stderr, "Error: no variable name given for parameter.\n"); } - if (probability < 0.0) { - // no nodes, so we have to calculate probability ourself - tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL, 0); - probability = tvalue.probability; - } - printf("query_probability(%s,%e).\n", arg[params.queryid], probability); - break; - case 'l': - tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL, 0); + } + if (probability < 0.0) { + // no nodes, so we have to calculate probability ourself + tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, + NULL, 0); probability = tvalue.probability; - printf("query_probability(%s,%e).\n", arg[params.queryid], probability); - break; - case 'e': - //fprintf(stderr,"start calc exp count\n"); - printf("query_probability(%s,%30.30e).\n", arg[params.queryid],CalcExpectedCounts(&MyManager, bdd,arg[params.queryid],1)); - break; - case 'd': - //fprintf(stderr,"start calc exp count\n"); - printf("query_probability(%s,%30.30e).\n", arg[params.queryid],CalcExpectedCounts(&MyManager, bdd,arg[params.queryid],0)); - break; - case 'p': - printf("query_probability(%s,%e).\n", arg[params.queryid], CalcProbability(MyManager, bdd)); - break; - case 'o': - onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd); - break; - default: - myexpand(MyManager, bdd); - break; + } + printf("query_probability(%s,%e).\n", arg[params.queryid], + probability); + break; + case 'l': + tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, + NULL, 0); + probability = tvalue.probability; + printf("query_probability(%s,%e).\n", arg[params.queryid], + probability); + break; + case 'e': + // fprintf(stderr,"start calc exp count\n"); + printf("query_probability(%s,%30.30e).\n", arg[params.queryid], + CalcExpectedCounts(&MyManager, bdd, arg[params.queryid], 1)); + break; + case 'd': + // fprintf(stderr,"start calc exp count\n"); + printf("query_probability(%s,%30.30e).\n", arg[params.queryid], + CalcExpectedCounts(&MyManager, bdd, arg[params.queryid], 0)); + break; + case 'p': + printf("query_probability(%s,%e).\n", arg[params.queryid], + CalcProbability(MyManager, bdd)); + break; + case 'o': + onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, + bdd); + break; + default: + myexpand(MyManager, bdd); + break; } } else { myexpand(MyManager, bdd); @@ -458,10 +509,14 @@ int main(int argc, char **arg) { bdd = NULL; } ReInitHistory(MyManager.his, MyManager.varmap.varcnt); - } while(bdd != NULL); + } while (bdd != NULL); bdd = bakbdd; - if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]); - if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]); + if (params.savedfile > -1) + SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, + arg[params.savedfile]); + if (params.exportfile > -1) + simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, + arg[params.exportfile]); free(MyManager.his); } if (MyManager.manager != NULL) { @@ -469,70 +524,113 @@ int main(int argc, char **arg) { free(MyManager.varmap.dvalue); free(MyManager.varmap.ivalue); if (MyManager.varmap.dynvalue != NULL) { - for(i = 0; i < MyManager.varmap.varcnt; i++) + for (i = 0; i < MyManager.varmap.varcnt; i++) if (MyManager.varmap.dynvalue[i] != NULL) { free(MyManager.varmap.dynvalue[i]); } free(MyManager.varmap.dynvalue); } for (i = 0; i < MyManager.varmap.varcnt; i++) - free((const char *)MyManager.varmap.vars[i]); + free((void *)MyManager.varmap.vars[i]); free(MyManager.varmap.vars); } - if (params.error != NULL) free(params.error); + if (params.error != NULL) + free(params.error); return code; - } /* Shell Parameters handling */ int argtype(const char *arg) { - if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0; - if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2; - if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3; - if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4; - if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5; - if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6; - if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7; - if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8; - if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9; - if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10; - if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11; - if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12; - if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13; - if (strcmp(arg, "-ord") == 0 || strcmp(arg, "--order") == 0) return 14; + if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) + return 0; + if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) + return 2; + if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) + return 3; + if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) + return 4; + if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) + return 5; + if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) + return 6; + if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) + return 7; + if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) + return 8; + if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) + return 9; + if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) + return 10; + if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) + return 11; + if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) + return 12; + if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) + return 13; + if (strcmp(arg, "-ord") == 0 || strcmp(arg, "--order") == 0) + return 14; return -1; } void printhelp(int argc, char **arg) { fprintf(stderr, "\n\nProbLogBDD Tool Version: %s\n\n", VERSION); - fprintf(stderr, "SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html)\n"); - fprintf(stderr, "SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be)\n"); + fprintf( + stderr, + "SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html)\n"); + fprintf(stderr, "SimpleCUDD was developed at Katholieke Universiteit " + "Leuven(www.kuleuven.be)\n"); fprintf(stderr, "Copyright Katholieke Universiteit Leuven 2008\n"); - fprintf(stderr, "Authors: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann\n"); + fprintf(stderr, + "Authors: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann\n"); fprintf(stderr, "This package falls under the: Artistic License 2.0\n"); - fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]); + fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) " + "[filename] -e [filename] -m [method] -id [queryid] -sl " + "[double]) (-t [seconds] -d -h)\n", + arg[0]); fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n"); - fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n"); - fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n"); - fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n"); + fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two " + "formats:\n\t\t\t\t\t\t1. script with generation " + "instructions\n\t\t\t\t\t\t2. node dump saved file\n"); + fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics " + "(mandatory with file formats 1, 2)\n"); + fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a " + "file can be used instead of -l\n"); fprintf(stderr, "Optional parameters:\n"); - fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n"); - fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n"); - fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [l]ine search, [o]nline, [e]xpexted counts, prob. with [d]eterministic nodes\n"); - fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]); - fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n"); + fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in " + "node dump format (fast loading, traverse valid only)\n"); + fprintf( + stderr, + "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n"); + fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: " + "none(default), [p]robability, [g]radient, [l]ine search, " + "[o]nline, [e]xpexted counts, prob. with [d]eterministic " + "nodes\n"); + fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by " + "gradient) default: %s\n", + arg[0]); + fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) " + "default: 1.0\n"); fprintf(stderr, "Extra parameters:\n"); - fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n"); - fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check\n"); - fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n"); - fprintf(stderr, "\t-ord [filename]\t->\tUse the [filename] to define a specific BDD variable order\n"); - fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n"); + fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation " + "timeout default 0 = no timeout\n"); + fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for " + "termination default 0 = no process to check\n"); + fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum " + "buffer size to read files default 0 = no max\n"); + fprintf(stderr, "\t-ord [filename]\t->\tUse the [filename] to define a " + "specific BDD variable order\n"); + fprintf(stderr, + "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n"); fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n"); - fprintf(stderr, "Extra notes:\nSupports a forest of BDDs in one shared BDD.\nSelected computational methods will be applied to each BDD seperately.\nFile operations will be applied only to the first BDD.\n"); - fprintf(stderr, "\nExample: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]); + fprintf(stderr, "Extra notes:\nSupports a forest of BDDs in one shared " + "BDD.\nSelected computational methods will be applied to " + "each BDD seperately.\nFile operations will be applied only " + "to the first BDD.\n"); + fprintf(stderr, "\nExample: %s -l testbdd -i input.txt -m g -id testbdd\n", + arg[0]); } parameters loadparam(int argc, char **arg) { @@ -552,122 +650,122 @@ parameters loadparam(int argc, char **arg) { params.maxbufsize = 0; params.ppid = NULL; params.orderfile = -1; - params.error = (int *) malloc(argc * sizeof(int)); + params.error = (int *)malloc(argc * sizeof(int)); for (i = 1; i < argc; i++) { - switch(argtype(arg[i])) { - case 0: - if (argc > i + 1) { - i++; - params.loadfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 2: - if (argc > i + 1) { - i++; - params.exportfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 3: - if (argc > i + 1) { - i++; - params.method = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 4: - if (argc > i + 1) { - i++; - params.inputfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 5: - printhelp(argc, arg); - break; - case 6: - params.debug = 1; - break; - case 7: - if (argc > i + 1) { - i++; - params.queryid = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 8: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.timeout = atoi(arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 9: - if (argc > i + 1) { - i++; - params.savedfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 10: - if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) { - i++; - params.sigmoid_slope = atof(arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 11: - params.online = 1; - break; - case 12: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.maxbufsize = atoi(arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 13: - if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { - i++; - params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1)); - strcpy(params.ppid, arg[i]); - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - case 14: - if (argc > i + 1) { - i++; - params.orderfile = i; - } else { - params.error[params.errorcnt] = i; - params.errorcnt++; - } - break; - default: + switch (argtype(arg[i])) { + case 0: + if (argc > i + 1) { + i++; + params.loadfile = i; + } else { params.error[params.errorcnt] = i; params.errorcnt++; - break; + } + break; + case 2: + if (argc > i + 1) { + i++; + params.exportfile = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 3: + if (argc > i + 1) { + i++; + params.method = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 4: + if (argc > i + 1) { + i++; + params.inputfile = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 5: + printhelp(argc, arg); + break; + case 6: + params.debug = 1; + break; + case 7: + if (argc > i + 1) { + i++; + params.queryid = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 8: + if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { + i++; + params.timeout = atoi(arg[i]); + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 9: + if (argc > i + 1) { + i++; + params.savedfile = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 10: + if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) { + i++; + params.sigmoid_slope = atof(arg[i]); + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 11: + params.online = 1; + break; + case 12: + if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { + i++; + params.maxbufsize = atoi(arg[i]); + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 13: + if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) { + i++; + params.ppid = (char *)malloc(sizeof(char) * (strlen(arg[i]) + 1)); + strcpy(params.ppid, arg[i]); + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + case 14: + if (argc > i + 1) { + i++; + params.orderfile = i; + } else { + params.error[params.errorcnt] = i; + params.errorcnt++; + } + break; + default: + params.error[params.errorcnt] = i; + params.errorcnt++; + break; } } return params; @@ -689,9 +787,12 @@ void pidhandler(int num) { exit(-1); } } - s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid))); - strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null"); - if (system(s) != 0) exit(4); + s = (char *)malloc(sizeof(char) * (19 + strlen(params.ppid))); + strcpy(s, "ps "); + strcat(s, params.ppid); + strcat(s, " >/dev/null"); + if (system(s) != 0) + exit(4); #ifndef __MINGW32__ signal(SIGALRM, pidhandler); #endif @@ -699,9 +800,7 @@ void pidhandler(int num) { free(s); } -void termhandler(int num) { - exit(3); -} +void termhandler(int num) { exit(3); } /* Debugging traverse function */ @@ -712,7 +811,8 @@ void myexpand(extmanager MyManager, DdNode *Current) { curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); printf("%s\n", curnode); if ((Current != MyManager.t) && (Current != MyManager.f) && - ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) { + ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == + NULL)) { l = LowNodeOf(MyManager.manager, Current); h = HighNodeOf(MyManager.manager, Current); printf("l(%s)->", curnode); @@ -739,27 +839,33 @@ double CalcProbability(extmanager MyManager, DdNode *Current) { // gcc stupidly complains. curnode = NULL; } - if (Current == MyManager.t) return 1.0; - if (Current == MyManager.f) return 0.0; + if (Current == MyManager.t) + return 1.0; + if (Current == MyManager.f) + return 0.0; - if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) return Found->dvalue; + if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != + NULL) + return Found->dvalue; l = LowNodeOf(MyManager.manager, Current); h = HighNodeOf(MyManager.manager, Current); - if (params.debug) fprintf(stderr, "l(%s)->", curnode); + if (params.debug) + fprintf(stderr, "l(%s)->", curnode); lvalue = CalcProbability(MyManager, l); - if (params.debug) fprintf(stderr, "h(%s)->", curnode); + if (params.debug) + fprintf(stderr, "h(%s)->", curnode); hvalue = CalcProbability(MyManager, h); - - tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart]; + tvalue = + MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart]; tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue); AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL); return tvalue; } - -double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_id, int calcdown_needed) { +double CalcExpectedCounts(extmanager *MyManager, DdNode *Current, + char *query_id, int calcdown_needed) { // fprintf(stderr,"%%calcing up\n"); double ret = CalcExpectedCountsUp(MyManager, Current, query_id); @@ -769,14 +875,13 @@ double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_i if (calcdown_needed != 0) { // double retd=CalcExpectedCountsDown(MyManager,Current, query_id); } -/* if(1 != retd){ */ -/* fprintf(stderr,"down %e != up %e/%e\n",ret,retd,ret); */ -/* exit(1); */ -/* } */ + /* if(1 != retd){ */ + /* fprintf(stderr,"down %e != up %e/%e\n",ret,retd,ret); */ + /* exit(1); */ + /* } */ return ret; } - /* ComparisonFunction compare_nodes ( extmanager MyManager) */ /* { */ /* //fprintf(stderr,"creating comparator for %p\n",MyManager); */ @@ -790,11 +895,14 @@ double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_i /* int aindex,bindex, aperm, bperm; */ /* aindex=GetIndex(a); */ /* bindex=GetIndex(b); */ -/* aperm=Cudd_IsConstant(a) ? CUDD_CONST_INDEX : Cudd_ReadPerm(MyManager.manager,aindex); */ +/* aperm=Cudd_IsConstant(a) ? CUDD_CONST_INDEX : + * Cudd_ReadPerm(MyManager.manager,aindex); */ /* Cudd_ReadPerm(MyManager.manager,bindex); */ -/* bperm=Cudd_IsConstant(b) ? CUDD_CONST_INDEX : Cudd_ReadPerm(MyManager.manager,bindex); */ +/* bperm=Cudd_IsConstant(b) ? CUDD_CONST_INDEX : + * Cudd_ReadPerm(MyManager.manager,bindex); */ /* int temp = aperm-bperm; */ -/* //-Cudd_ReadPerm(MyManager.manager,(*b).index);//-Cudd_ReadPerm(MyManager,b);// - Cudd_ReadPerm(b); */ +/* //-Cudd_ReadPerm(MyManager.manager,(*b).index);//-Cudd_ReadPerm(MyManager,b);// + * - Cudd_ReadPerm(b); */ /* //fprintf(stderr,"comparing3 %p %p %p\n",a,b,MyManager); */ /* // return -1; */ /* if (temp < 0) */ @@ -810,244 +918,314 @@ double CalcExpectedCounts(extmanager * MyManager, DdNode *Current, char *query_i /* } */ #define NODE_VALUE 1001 -#define LOG_EXPECTED 0 +#define LOG_EXPECTED 0 +static void PrintNodeQueue(Queue q, extmanager MyManager) { -static -void PrintNodeQueue(Queue q , extmanager MyManager){ - - QueueIterator qiter = QueueIteratorNew(q, 1); - fprintf(stderr,"Queue %p is [", q); - - while (qiter->currentItem != NULL) { - DdNode* val = (DdNode*) qiter->currentItem->element; - QueueIteratorAdvance(qiter); - fprintf(stderr," %s %s", GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, val), - (qiter->currentItem !=NULL)?",":"]\n"); - } + QueueIterator qiter = QueueIteratorNew(q, 1); + fprintf(stderr, "Queue %p is [", q); + while (qiter->currentItem != NULL) { + DdNode *val = (DdNode *)qiter->currentItem->element; + QueueIteratorAdvance(qiter); + fprintf(stderr, " %s %s", + GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, val), + (qiter->currentItem != NULL) ? "," : "]\n"); + } } - /** also nesting in CalcExpected seems to not work (must be here nested only valid within function frame)*/ +/** also nesting in CalcExpected seems to not work (must be here nested only + * valid within function frame)*/ /* will be changed at later stage */ -static extmanager * ineedtostorethatsomehow; +static extmanager *ineedtostorethatsomehow; -static -int comparator(void *av, void *bv){ - int ret = 0; - DdNode* a = (DdNode*)av; - DdNode* b = (DdNode*)bv; - int aindex,bindex, aperm, bperm; - aindex=GetIndex(a); - bindex=GetIndex(b); - aperm=Cudd_IsConstant(a) ? CUDD_CONST_INDEX : Cudd_ReadPerm(ineedtostorethatsomehow->manager,aindex); - Cudd_ReadPerm(ineedtostorethatsomehow->manager,bindex); - bperm=Cudd_IsConstant(b) ? CUDD_CONST_INDEX : Cudd_ReadPerm(ineedtostorethatsomehow->manager,bindex); - int temp = -aperm+bperm; - if (temp < 0) - ret= 1; - else if (temp > 0) - ret= -1; - // else //never return zero otherwise one is pruned away, or(?) - // return 0; - if(LOG_EXPECTED){ - fprintf(stderr,"perm(%s,%i)=%i perm(%s,%i)=%i => %i\n",GetNodeVarNameDisp(ineedtostorethatsomehow->manager, ineedtostorethatsomehow->varmap, a), - aindex, - aperm, - GetNodeVarNameDisp(ineedtostorethatsomehow->manager, ineedtostorethatsomehow->varmap, b), - bindex,bperm, - ret);} +static int comparator(void *av, void *bv) { + int ret = 0; + DdNode *a = (DdNode *)av; + DdNode *b = (DdNode *)bv; + int aindex, bindex, aperm, bperm; + aindex = GetIndex(a); + bindex = GetIndex(b); + aperm = Cudd_IsConstant(a) + ? CUDD_CONST_INDEX + : Cudd_ReadPerm(ineedtostorethatsomehow->manager, aindex); + Cudd_ReadPerm(ineedtostorethatsomehow->manager, bindex); + bperm = Cudd_IsConstant(b) + ? CUDD_CONST_INDEX + : Cudd_ReadPerm(ineedtostorethatsomehow->manager, bindex); + int temp = -aperm + bperm; + if (temp < 0) + ret = 1; + else if (temp > 0) + ret = -1; + // else //never return zero otherwise one is pruned away, or(?) + // return 0; + if (LOG_EXPECTED) { + fprintf(stderr, "perm(%s,%i)=%i perm(%s,%i)=%i => %i\n", + GetNodeVarNameDisp(ineedtostorethatsomehow->manager, + ineedtostorethatsomehow->varmap, a), + aindex, aperm, + GetNodeVarNameDisp(ineedtostorethatsomehow->manager, + ineedtostorethatsomehow->varmap, b), + bindex, bperm, ret); + } - return ret; + return ret; } -static void -skip_nodes_cnt(extmanager * MyManager, double (*counts)[] , int skipcnt, DdNode* l,double dprob, char *query_id); +static void skip_nodes_cnt(extmanager *MyManager, double (*counts)[], + int skipcnt, DdNode *l, double dprob, + char *query_id); /** output information for skipped nodes **/ -static void -skip_nodes(extmanager * MyManager, double (*counts)[] , DdNode* node, DdNode* l,double dprob, char *query_id){ +static void skip_nodes(extmanager *MyManager, double (*counts)[], DdNode *node, + DdNode *l, double dprob, char *query_id) { int skipcnt; - skipcnt = Cudd_ReadPerm(MyManager->manager,GetIndex(node))+1; - if(LOG_EXPECTED){fprintf(stderr,">> skipper >> %s=%i@%i of %i -> %i@%i %i\n", - (char *)(MyManager->varmap.dynvalue[GetIndex(node) - MyManager->varmap.varstart]), - GetIndex(node), - Cudd_ReadPerm(MyManager->manager,GetIndex(node)), - Cudd_ReadSize( MyManager->manager), - GetIndex(l), - Cudd_ReadPerm(MyManager->manager,GetIndex(l)), - Cudd_IsConstant(l) - ); + skipcnt = Cudd_ReadPerm(MyManager->manager, GetIndex(node)) + 1; + if (LOG_EXPECTED) { + fprintf(stderr, ">> skipper >> %s=%i@%i of %i -> %i@%i %i\n", + (char *)(MyManager->varmap.dynvalue[GetIndex(node) - + MyManager->varmap.varstart]), + GetIndex(node), Cudd_ReadPerm(MyManager->manager, GetIndex(node)), + Cudd_ReadSize(MyManager->manager), GetIndex(l), + Cudd_ReadPerm(MyManager->manager, GetIndex(l)), Cudd_IsConstant(l)); } - skip_nodes_cnt( MyManager, counts, skipcnt, l, dprob, query_id); + skip_nodes_cnt(MyManager, counts, skipcnt, l, dprob, query_id); } -static void -skip_nodes_cnt(extmanager * MyManager, double (*counts)[] , int skipcnt, DdNode* l,double dprob, char *query_id){ - if(LOG_EXPECTED) fprintf(stderr,"====================\n"); +static void skip_nodes_cnt(extmanager *MyManager, double (*counts)[], + int skipcnt, DdNode *l, double dprob, + char *query_id) { + if (LOG_EXPECTED) + fprintf(stderr, "====================\n"); double p; int ivalue; // fprintf(stderr, " skip (:%i) \n",__LINE__); - while(Cudd_IsConstant(l) ? - skipcnt < Cudd_ReadSize( MyManager->manager) // the terminals/leafs/constants will be ignored - : - skipcnt < Cudd_ReadPerm(MyManager->manager,GetIndex(l) ) - ){ + while (Cudd_IsConstant(l) + ? skipcnt < Cudd_ReadSize(MyManager->manager) // the + // terminals/leafs/constants + // will be ignored + : skipcnt < Cudd_ReadPerm(MyManager->manager, GetIndex(l))) { skipcnt++; - if(LOG_EXPECTED){ fprintf(stderr,"skipcnt %i\n",skipcnt-1);} - int idx=Cudd_ReadInvPerm(MyManager->manager,skipcnt-1); - if(LOG_EXPECTED){fprintf(stderr,"index %i %i\n",idx,MyManager->varmap.varstart);} - //fprintf(stdout,"%i %s.\n",skipcnt,MyManager->varmap.dynvalue[GetIndex(node) - MyManager->varmap.varstart]); - if(LOG_EXPECTED){fprintf(stderr,"Node skipped level %i index: %i name: %s (dprob is %e)\n", - skipcnt,idx, - MyManager->varmap.vars[idx - MyManager->varmap.varstart], - dprob);} - //notiz + if (LOG_EXPECTED) { + fprintf(stderr, "skipcnt %i\n", skipcnt - 1); + } + int idx = Cudd_ReadInvPerm(MyManager->manager, skipcnt - 1); + if (LOG_EXPECTED) { + fprintf(stderr, "index %i %i\n", idx, MyManager->varmap.varstart); + } + // fprintf(stdout,"%i + // %s.\n",skipcnt,MyManager->varmap.dynvalue[GetIndex(node) - + // MyManager->varmap.varstart]); + if (LOG_EXPECTED) { + fprintf(stderr, + "Node skipped level %i index: %i name: %s (dprob is %e)\n", + skipcnt, idx, + MyManager->varmap.vars[idx - MyManager->varmap.varstart], dprob); + } + // notiz ivalue = MyManager->varmap.ivalue[idx - MyManager->varmap.varstart]; //+ new{ - //double tvalue; // probability of prob fact corresp to node - //tvalue = MyManager->varmap.dvalue[idx - MyManager->varmap.varstart]; + // double tvalue; // probability of prob fact corresp to node + // tvalue = MyManager->varmap.dvalue[idx - MyManager->varmap.varstart]; //} - if(ivalue==1){ - p=dprob*MyManager->varmap.dvalue[idx - MyManager->varmap.varstart]; + if (ivalue == 1) { + p = dprob * MyManager->varmap.dvalue[idx - MyManager->varmap.varstart]; //+ new{ - //p=dprob*MyManager->varmap.dvalue[idx - MyManager->varmap.varstart] *tvalue; + // p=dprob*MyManager->varmap.dvalue[idx - MyManager->varmap.varstart] + // *tvalue; //} - if(p>0){// probability is zero, don't follow this branch - (*counts)[idx - MyManager->varmap.varstart]+=p; - // fprintf(stdout,"oec(%s,%s,%e). %%2\n",query_id,MyManager->varmap.vars[idx - MyManager->varmap.varstart],p); - if(LOG_EXPECTED) fprintf(stderr,"ec -> %s,%s,%e . %%2_1\n",query_id,MyManager->varmap.vars[idx - MyManager->varmap.varstart],p); - }else{ - if(LOG_EXPECTED){fprintf(stdout,"%% ec(%s,%s,%30.30e). %%2_2\n",query_id,MyManager->varmap.vars[idx - MyManager->varmap.varstart],p);} + if (p > 0) { // probability is zero, don't follow this branch + (*counts)[idx - MyManager->varmap.varstart] += p; + // fprintf(stdout,"oec(%s,%s,%e). + //%%2\n",query_id,MyManager->varmap.vars[idx - + // MyManager->varmap.varstart],p); + if (LOG_EXPECTED) + fprintf(stderr, "ec -> %s,%s,%e . %%2_1\n", query_id, + MyManager->varmap.vars[idx - MyManager->varmap.varstart], p); + } else { + if (LOG_EXPECTED) { + fprintf(stdout, "%% ec(%s,%s,%30.30e). %%2_2\n", query_id, + MyManager->varmap.vars[idx - MyManager->varmap.varstart], p); + } } } } // fprintf(stderr, " skip %i \n",__LINE__); - if(LOG_EXPECTED){fprintf(stderr,"skipped\n");} + if (LOG_EXPECTED) { + fprintf(stderr, "skipped\n"); + } } - -double CalcExpectedCountsDown(extmanager * MyManager, DdNode *Current, char *query_id) { - ineedtostorethatsomehow=MyManager; +double CalcExpectedCountsDown(extmanager *MyManager, DdNode *Current, + char *query_id) { + ineedtostorethatsomehow = MyManager; Queue q = QueueNew(); - //fprintf(stderr", =====> queue is: %p \n",q); + // fprintf(stderr", =====> queue is: %p \n",q); int i; - char *curnode, *curh, *curl,*dynvalue; + char *curnode, *curh, *curl, *dynvalue; DdNode *h, *l, *node; ComparisonFunction fun; - hisnode *Found = NULL,*lfound, *hfound; - double dprob; //downward probability of current node + hisnode *Found = NULL, *lfound, *hfound; + double dprob; // downward probability of current node double tvalue; // probability of prob fact corresp to node int ivalue; - double retval; //last value of true + double retval; // last value of true - double counts[MyManager->varmap.varcnt] ; - double (*pcnt)[MyManager->varmap.varcnt]; + double counts[MyManager->varmap.varcnt]; + double(*pcnt)[MyManager->varmap.varcnt]; pcnt = &counts; - for( i = 0 ;i< MyManager->varmap.varcnt ; i++){ - (*pcnt)[i]=0; + for (i = 0; i < MyManager->varmap.varcnt; i++) { + (*pcnt)[i] = 0; } // skip everything before the first node: - skip_nodes_cnt(MyManager,pcnt,0,Current,1,query_id); - + skip_nodes_cnt(MyManager, pcnt, 0, Current, 1, query_id); fun = *comparator; - if(LOG_EXPECTED){fprintf(stderr," ##############################\n");} - if(LOG_EXPECTED){ fprintf(stderr," ##############################\n fun is %p\n",fun);} - if(!Cudd_IsConstant(Current)){ - QueuePutOnPriority(q, Current, NODE_VALUE,fun); - Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current); - (*Found).dvalue2=1.0/((*Found).dvalue); - dynvalue = (*Found).dynvalue; + if (LOG_EXPECTED) { + fprintf(stderr, " ##############################\n"); } - Current= NULL; // not used anymore or should not be - retval=0; + if (LOG_EXPECTED) { + fprintf(stderr, " ##############################\n fun is %p\n", fun); + } + if (!Cudd_IsConstant(Current)) { + QueuePutOnPriority(q, Current, NODE_VALUE, fun); + Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current); + (*Found).dvalue2 = 1.0 / ((*Found).dvalue); + dynvalue = (*Found).dynvalue; + } + Current = NULL; // not used anymore or should not be + retval = 0; - while(QueueSize(q)>0){ - if(LOG_EXPECTED){fprintf(stderr,"\n");} - if(LOG_EXPECTED){PrintNodeQueue(q,*MyManager);} - node=QueueGet(q); + while (QueueSize(q) > 0) { + if (LOG_EXPECTED) { + fprintf(stderr, "\n"); + } + if (LOG_EXPECTED) { + PrintNodeQueue(q, *MyManager); + } + node = QueueGet(q); curnode = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, node); // int level = Cudd_ReadPerm(MyManager->manager,GetIndex(node)); - if(!Cudd_IsConstant(node)){ - tvalue = MyManager->varmap.dvalue[GetIndex(node) - MyManager->varmap.varstart]; - ivalue = MyManager->varmap.ivalue[GetIndex(node) - MyManager->varmap.varstart]; - dynvalue = MyManager->varmap.vars[GetIndex(node) - MyManager->varmap.varstart]; - Found = GetNode(MyManager->his, MyManager->varmap.varstart, node); - dprob=(*Found).dvalue2; - l = LowNodeOf(MyManager->manager, node); - h = HighNodeOf(MyManager->manager, node); - lfound = GetNode(MyManager->his, MyManager->varmap.varstart, l); - hfound = GetNode(MyManager->his, MyManager->varmap.varstart, h) ; - curh = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, h); - curl = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, l); + if (!Cudd_IsConstant(node)) { + tvalue = + MyManager->varmap.dvalue[GetIndex(node) - MyManager->varmap.varstart]; + ivalue = + MyManager->varmap.ivalue[GetIndex(node) - MyManager->varmap.varstart]; + dynvalue = + MyManager->varmap.vars[GetIndex(node) - MyManager->varmap.varstart]; + Found = GetNode(MyManager->his, MyManager->varmap.varstart, node); + dprob = (*Found).dvalue2; + l = LowNodeOf(MyManager->manager, node); + h = HighNodeOf(MyManager->manager, node); + lfound = GetNode(MyManager->his, MyManager->varmap.varstart, l); + hfound = GetNode(MyManager->his, MyManager->varmap.varstart, h); + curh = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, h); + curl = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, l); - if(LOG_EXPECTED){fprintf(stderr, "%s (%i)--> %s %s\n", curnode,(*node).index,curh,curl);} - /** low node */ - if((*lfound).dvalue2<-0.1){ //only if not seen before == dvalue2=0 (almost) otherwise requing does not harm - if(LOG_EXPECTED){fprintf(stderr,"queueing l(%s)=%s \n",curnode,curl);} - QueuePutOnPriority(q, l, NODE_VALUE,fun); - (*lfound).dvalue2=0; + if (LOG_EXPECTED) { + fprintf(stderr, "%s (%i)--> %s %s\n", curnode, (*node).index, curh, + curl); + } + /** low node */ + if ((*lfound).dvalue2 < -0.1) { // only if not seen before == dvalue2=0 + // (almost) otherwise requing does not + // harm + if (LOG_EXPECTED) { + fprintf(stderr, "queueing l(%s)=%s \n", curnode, curl); + } + QueuePutOnPriority(q, l, NODE_VALUE, fun); + (*lfound).dvalue2 = 0; + } + ((*lfound).dvalue2) = + ((*lfound).dvalue2) + (ivalue == 0 ? dprob : dprob * (1 - tvalue)); + if (LOG_EXPECTED) { + fprintf(stderr, "l(%s)=%s %e \n", curnode, curl, (*lfound).dvalue2); + } + if (LOG_EXPECTED) { + fprintf(stderr, "l(%s)=%s %e %e %e\n", curnode, curl, (*lfound).dvalue2, + tvalue, dprob); } - ((*lfound).dvalue2)=((*lfound).dvalue2)+(ivalue==0? dprob : dprob*(1-tvalue)); - if(LOG_EXPECTED){fprintf(stderr, "l(%s)=%s %e \n", curnode,curl,(*lfound).dvalue2);} - if(LOG_EXPECTED){fprintf(stderr, "l(%s)=%s %e %e %e\n", curnode,curl,(*lfound).dvalue2,tvalue,dprob);} /** high node */ - if((*hfound).dvalue2<-0.1){ //only if not seen before == dvalue2=0 (almost) otherwise requing does not harm - fun = *comparator; - (*fun)(l,l); - if(LOG_EXPECTED){ - PrintNodeQueue(q,*MyManager); - fprintf(stderr,"-> %p\n",h); - } - QueuePutOnPriority(q, h, NODE_VALUE,fun); - (*hfound).dvalue2=0; + if ((*hfound).dvalue2 < -0.1) { // only if not seen before == dvalue2=0 + // (almost) otherwise requing does not + // harm + fun = *comparator; + (*fun)(l, l); + if (LOG_EXPECTED) { + PrintNodeQueue(q, *MyManager); + fprintf(stderr, "-> %p\n", h); + } + QueuePutOnPriority(q, h, NODE_VALUE, fun); + (*hfound).dvalue2 = 0; + } + (*hfound).dvalue2 = + (*hfound).dvalue2 + (ivalue == 0 ? dprob : (dprob * (tvalue))); + if (LOG_EXPECTED) { + fprintf(stderr, "h(%s)=%s %e %e %e\n", curnode, curh, (*hfound).dvalue2, + tvalue, dprob); } - (*hfound).dvalue2=(*hfound).dvalue2+(ivalue==0? dprob : (dprob*(tvalue))); - if(LOG_EXPECTED){fprintf(stderr, "h(%s)=%s %e %e %e\n", curnode,curh,(*hfound).dvalue2,tvalue,dprob);} /** output expected counts current node */ - if(ivalue==1){ - (*pcnt)[GetIndex(node) - MyManager->varmap.varstart]+=dprob * tvalue * (*hfound).dvalue; - //fprintf(stdout,"oec(%s,%s,%e). %% 1_1\n",query_id,dynvalue,dprob * tvalue * (*hfound).dvalue); - if(LOG_EXPECTED) fprintf(stderr,"ec -> %s,%s,%e . %% 1_1\n",query_id,dynvalue,dprob * tvalue * (*hfound).dvalue); - }else{ - (*pcnt)[GetIndex(node) - MyManager->varmap.varstart]+=dprob * tvalue * (*hfound).dvalue; - if(LOG_EXPECTED) fprintf(stderr,"ec -> %s,%s,%e . %% 1_2\n",query_id,dynvalue,dprob * tvalue * (*hfound).dvalue); + if (ivalue == 1) { + (*pcnt)[GetIndex(node) - MyManager->varmap.varstart] += + dprob * tvalue * (*hfound).dvalue; + // fprintf(stdout,"oec(%s,%s,%e). %% 1_1\n",query_id,dynvalue,dprob * + // tvalue * (*hfound).dvalue); + if (LOG_EXPECTED) + fprintf(stderr, "ec -> %s,%s,%e . %% 1_1\n", query_id, dynvalue, + dprob * tvalue * (*hfound).dvalue); + } else { + (*pcnt)[GetIndex(node) - MyManager->varmap.varstart] += + dprob * tvalue * (*hfound).dvalue; + if (LOG_EXPECTED) + fprintf(stderr, "ec -> %s,%s,%e . %% 1_2\n", query_id, dynvalue, + dprob * tvalue * (*hfound).dvalue); } /** output expected counts of skipped nodes for low branch*/ - skip_nodes(MyManager,pcnt,node,l,dprob*((ivalue==0)?1:(1-tvalue))*(*lfound).dvalue,query_id); - skip_nodes(MyManager,pcnt,node,h,dprob*((ivalue==0)?1:(tvalue))*(*hfound).dvalue,query_id); - }else{ - if(LOG_EXPECTED){fprintf(stderr,"here: retval %s %e=>%e\n",curnode,retval,(*Found).dvalue2);} - if(node==(MyManager->t)){ - if(LOG_EXPECTED){fprintf(stderr,"updating retval %e=>%e\n",retval,(*Found).dvalue2);} - retval=(*Found).dvalue2; + skip_nodes(MyManager, pcnt, node, l, + dprob * ((ivalue == 0) ? 1 : (1 - tvalue)) * (*lfound).dvalue, + query_id); + skip_nodes(MyManager, pcnt, node, h, + dprob * ((ivalue == 0) ? 1 : (tvalue)) * (*hfound).dvalue, + query_id); + } else { + if (LOG_EXPECTED) { + fprintf(stderr, "here: retval %s %e=>%e\n", curnode, retval, + (*Found).dvalue2); + } + if (node == (MyManager->t)) { + if (LOG_EXPECTED) { + fprintf(stderr, "updating retval %e=>%e\n", retval, (*Found).dvalue2); + } + retval = (*Found).dvalue2; } - } } - for( i = 0 ;i< MyManager->varmap.varcnt ; i++){ + for (i = 0; i < MyManager->varmap.varcnt; i++) { ivalue = MyManager->varmap.ivalue[i]; /* fprintf(stderr,"Node level %i index: %i name: %s (dprob is %e)\n", */ /* i,idx, */ /* MyManager->varmap.vars[idx - MyManager->varmap.varstart], */ /* dprob); */ - //fprintf(stderr,"Node idx: %i level: %i \n",i,Cudd_ReadPerm(MyManager->manager,i)); - if(ivalue==0){ - fprintf(stdout,"%% det: ec(%s,%s,%30.30e).\n",query_id,MyManager->varmap.vars[i],(counts)[i]); - }else{ - fprintf(stdout,"ec(%s,%s,%30.30e).\n",query_id,MyManager->varmap.vars[i],(counts)[i]); - + // fprintf(stderr,"Node idx: %i level: %i + // \n",i,Cudd_ReadPerm(MyManager->manager,i)); + if (ivalue == 0) { + fprintf(stdout, "%% det: ec(%s,%s,%30.30e).\n", query_id, + MyManager->varmap.vars[i], (counts)[i]); + } else { + fprintf(stdout, "ec(%s,%s,%30.30e).\n", query_id, + MyManager->varmap.vars[i], (counts)[i]); } } // free(counts); - if(LOG_EXPECTED){ -fprintf(stderr,"retval is %e\n",retval); -} + if (LOG_EXPECTED) { + fprintf(stderr, "retval is %e\n", retval); + } return retval; } -double CalcExpectedCountsUp(extmanager * MyManager, DdNode *Current, char *query_id) { +double CalcExpectedCountsUp(extmanager *MyManager, DdNode *Current, + char *query_id) { // fprintf(stderr,"--------------------- the manager 2 %p \n",&MyManager); DdNode *h, *l; @@ -1057,52 +1235,62 @@ double CalcExpectedCountsUp(extmanager * MyManager, DdNode *Current, char *query // tvalue=0.0; int ivalue; if (params.debug) { - curnode = GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, Current); + curnode = + GetNodeVarNameDisp(MyManager->manager, MyManager->varmap, Current); fprintf(stderr, "%s\n", curnode); } - if (Current == MyManager->t){ - // if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) == NULL) { + if (Current == MyManager->t) { + // if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, + // Current)) == NULL) { // fprintf(stderr,"adding true \n"); - AddNode(MyManager->his, MyManager->varmap.varstart, MyManager->t, 1, 0, NULL);//}//needed in down + AddNode(MyManager->his, MyManager->varmap.varstart, MyManager->t, 1, 0, + NULL); //}//needed in down return 1.0; } - if (Current == MyManager->f){ + if (Current == MyManager->f) { // fprintf(stderr,"adding false \n"); - // if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) == NULL) { - AddNode(MyManager->his, MyManager->varmap.varstart, MyManager->f, 0, 0, NULL);//}//needed in down + // if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, + // Current)) == NULL) { + AddNode(MyManager->his, MyManager->varmap.varstart, MyManager->f, 0, 0, + NULL); //}//needed in down return 0.0; } - if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) != NULL) return Found->dvalue; + if ((Found = GetNode(MyManager->his, MyManager->varmap.varstart, Current)) != + NULL) + return Found->dvalue; l = LowNodeOf(MyManager->manager, Current); h = HighNodeOf(MyManager->manager, Current); - if (params.debug) fprintf(stderr, "l(%s)->", curnode); - lvalue = CalcExpectedCountsUp(MyManager, l,query_id); - if (params.debug) fprintf(stderr, "h(%s)->", curnode); - hvalue = CalcExpectedCountsUp(MyManager, h,query_id); + if (params.debug) + fprintf(stderr, "l(%s)->", curnode); + lvalue = CalcExpectedCountsUp(MyManager, l, query_id); + if (params.debug) + fprintf(stderr, "h(%s)->", curnode); + hvalue = CalcExpectedCountsUp(MyManager, h, query_id); + tvalue = + MyManager->varmap.dvalue[GetIndex(Current) - MyManager->varmap.varstart]; + // notiz + ivalue = + MyManager->varmap.ivalue[GetIndex(Current) - MyManager->varmap.varstart]; - tvalue = MyManager->varmap.dvalue[GetIndex(Current) - MyManager->varmap.varstart]; - //notiz - ivalue = MyManager->varmap.ivalue[GetIndex(Current) - MyManager->varmap.varstart]; - - if(ivalue == 1){ + if (ivalue == 1) { tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue); - }else if (ivalue == 0){ - tvalue = hvalue + lvalue ; + } else if (ivalue == 0) { + tvalue = hvalue + lvalue; } // fprintf(stderr," ---> %e \n",tvalue); AddNode(MyManager->his, MyManager->varmap.varstart, Current, tvalue, 0, NULL); return tvalue; } - /* Bernds Algorithm */ // type=0 regular probabilistic fact // type=1 derive gradient for mu // type=2 derive gradient for sigma -gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern, int type) { +gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, + char *TargetPattern, int type) { DdNode *h, *l; hisnode *Found; char *curnode = NULL, *dynvalue; @@ -1126,55 +1314,78 @@ gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, tvalue.gradient = 0.0; return tvalue; } - //node is in cache - if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) { + // node is in cache + if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != + NULL) { tvalue.probability = Found->dvalue; - tvalue.gradient = *((double *) Found->dynvalue); + tvalue.gradient = *((double *)Found->dynvalue); return tvalue; } - //inductive case + // inductive case l = LowNodeOf(MyManager.manager, Current); h = HighNodeOf(MyManager.manager, Current); - if (params.debug) fprintf(stderr, "l(%s)->", curnode); - lowvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern,type); - if (params.debug) fprintf(stderr, "h(%s)->", curnode); - highvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern,type); - dynvalue = (char*) MyManager.varmap.dynvalue[GetIndex(Current) - MyManager.varmap.varstart]; + if (params.debug) + fprintf(stderr, "l(%s)->", curnode); + lowvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern, type); + if (params.debug) + fprintf(stderr, "h(%s)->", curnode); + highvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern, type); + dynvalue = (char *)MyManager.varmap + .dynvalue[GetIndex(Current) - MyManager.varmap.varstart]; if (dynvalue == NULL) { // no dynvalue, it's a regular probabilistic fact - memset( &dynvalue_parsed, 0, sizeof(dynvalue_parsed) ); - this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope); - } else { // there is a dynvalue, it's a continuous fact! let's do the hybrid ProbLog magic here + memset(&dynvalue_parsed, 0, sizeof(dynvalue_parsed)); + this_probability = sigmoid( + MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], + params.sigmoid_slope); + } else { // there is a dynvalue, it's a continuous fact! let's do the hybrid + // ProbLog magic here curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current); dynvalue_parsed = parse_density_integral_string(dynvalue, curnode); - this_probability=cumulative_normal(dynvalue_parsed.low,dynvalue_parsed.high,dynvalue_parsed.mu,dynvalue_parsed.sigma); + this_probability = + cumulative_normal(dynvalue_parsed.low, dynvalue_parsed.high, + dynvalue_parsed.mu, dynvalue_parsed.sigma); } - tvalue.probability = this_probability * highvalue.probability + (1 - this_probability) * lowvalue.probability; - tvalue.gradient = this_probability * highvalue.gradient + (1 - this_probability) * lowvalue.gradient; + tvalue.probability = this_probability * highvalue.probability + + (1 - this_probability) * lowvalue.probability; + tvalue.gradient = this_probability * highvalue.gradient + + (1 - this_probability) * lowvalue.gradient; if ((GetIndex(Current) == TargetVar) || - ((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) { - if (type == 0) { // current node is normal probabilistic fact - tvalue.gradient += (highvalue.probability - lowvalue.probability) * this_probability * (1 - this_probability) * params.sigmoid_slope; + ((TargetPattern != NULL) && + patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) { + if (type == 0) { // current node is normal probabilistic fact + tvalue.gradient += (highvalue.probability - lowvalue.probability) * + this_probability * (1 - this_probability) * + params.sigmoid_slope; } else if (type == 1) { // it's a continues fact and we need d/dmu - tvalue.gradient += cumulative_normal_dmu(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, dynvalue_parsed.sigma) * (highvalue.probability + lowvalue.probability); + tvalue.gradient += + cumulative_normal_dmu(dynvalue_parsed.low, dynvalue_parsed.high, + dynvalue_parsed.mu, dynvalue_parsed.sigma) * + (highvalue.probability + lowvalue.probability); } else if (type == 2) { // it's a continues fact and we need d/dsigma - tvalue.gradient += cumulative_normal_dsigma(dynvalue_parsed.low, dynvalue_parsed.high, dynvalue_parsed.mu, dynvalue_parsed.sigma) * (highvalue.probability + lowvalue.probability); + tvalue.gradient += + cumulative_normal_dsigma(dynvalue_parsed.low, dynvalue_parsed.high, + dynvalue_parsed.mu, dynvalue_parsed.sigma) * + (highvalue.probability + lowvalue.probability); } } - gradient = (double *) malloc(sizeof(double)); + gradient = (double *)malloc(sizeof(double)); *gradient = tvalue.gradient; - AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient); + AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, + 0, gradient); return tvalue; } -char * extractpattern(const char *thestr) { +char *extractpattern(const char *thestr) { char *p; int i = 0, sl = strlen(thestr); - while((thestr[i] != '_') && (i < sl)) i++; - if (i == sl) return NULL; + while ((thestr[i] != '_') && (i < sl)) + i++; + if (i == sl) + return NULL; i++; - p = (char *) malloc(sizeof(char) * (i + 2)); + p = (char *)malloc(sizeof(char) * (i + 2)); strncpy(p, thestr, i); p[i] = '*'; p[i + 1] = '\0'; @@ -1183,8 +1394,10 @@ char * extractpattern(const char *thestr) { int patterncalculated(char *pattern, extmanager MyManager, int loc) { int i; - if (pattern == NULL) return 0; + if (pattern == NULL) + return 0; for (i = loc - 1; i > -1; i--) - if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1; + if (patternmatch(pattern, MyManager.varmap.vars[i])) + return 1; return 0; } diff --git a/packages/cplint/CMakeLists.txt b/packages/cplint/CMakeLists.txt index 2f0964c5c..1004c38be 100644 --- a/packages/cplint/CMakeLists.txt +++ b/packages/cplint/CMakeLists.txt @@ -168,6 +168,7 @@ IF (CUDD_FOUND_EXPORT) install(TARGETS cplint LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) INSTALL(FILES ${CPLINT_PROGRAMS} DESTINATION ${libpl}) diff --git a/packages/cplint/doc/Makefile b/packages/cplint/doc/Makefile index 786d90969..dfb95b004 100644 --- a/packages/cplint/doc/Makefile +++ b/packages/cplint/doc/Makefile @@ -1,8 +1,9 @@ -manual.pdf: manual.tex manual.bbl +manual.pdf: manual.tex bib.bib + pdflatex manual + bibtex manual pdflatex manual pdflatex manual -manual.html: manual.tex manual.bbl - htlatex manual - +manual.html: manual.tex bib.bib + pandoc manual.tex -o manual.html -s --bibliography bib.bib --csl acm-sigchi-proceedings.csl --table-of-contents --toc-depth=2 diff --git a/packages/cplint/doc/acm-sigchi-proceedings.csl b/packages/cplint/doc/acm-sigchi-proceedings.csl new file mode 100644 index 000000000..e612feedc --- /dev/null +++ b/packages/cplint/doc/acm-sigchi-proceedings.csl @@ -0,0 +1,183 @@ + + diff --git a/packages/cplint/doc/cmsy10-42.png b/packages/cplint/doc/cmsy10-42.png deleted file mode 100644 index 5e157008f..000000000 Binary files a/packages/cplint/doc/cmsy10-42.png and /dev/null differ diff --git a/packages/cplint/doc/cmsy10-4e.png b/packages/cplint/doc/cmsy10-4e.png deleted file mode 100644 index dc5f09ca5..000000000 Binary files a/packages/cplint/doc/cmsy10-4e.png and /dev/null differ diff --git a/packages/cplint/doc/manual.bbl b/packages/cplint/doc/manual.bbl deleted file mode 100644 index b779d5f92..000000000 --- a/packages/cplint/doc/manual.bbl +++ /dev/null @@ -1,90 +0,0 @@ -\begin{thebibliography}{10} - -\bibitem{DBLP:journals/ngc/AptB91} -K.~R. Apt and M.~Bezem. -\newblock Acyclic programs. -\newblock {\em New Generation Comput.}, 9(3/4):335--364, 1991. - -\bibitem{Blo04-ILP04WIP-IC} -H.~Blockeel. -\newblock Probabilistic logical models for mendel's experiments: An exercise. -\newblock In {\em Inductive Logic Programming ({ILP} 2004), Work in Progress - Track}, 2004. - -\bibitem{DBLP:journals/jacm/ChenW96} -Weidong Chen and David~Scott Warren. -\newblock Tabled evaluation with delaying for general logic programs. -\newblock {\em J. ACM}, 43(1):20--74, 1996. - -\bibitem{DBLP:conf/ijcai/RaedtKT07} -L.~De~Raedt, A.~Kimmig, and H.~Toivonen. -\newblock Problog: A probabilistic prolog and its application in link - discovery. -\newblock In {\em Proceedings of the 20th International Joint Conference on - Artificial Intelligence}, pages 2462--2467, 2007. - -\bibitem{GetFri01-BC} -L.~Getoor, N.~Friedman, D.~Koller, and A.~Pfeffer. -\newblock Learning probabilistic relational models. -\newblock In Saso Dzeroski and Nada Lavrac, editors, {\em Relational Data - Mining}. Springer-Verlag, Berlin, 2001. - -\bibitem{Getoor+al:JMLR02} -L.~Getoor, N.~Friedman, D.~Koller, and B.~Taskar. -\newblock Learning probabilistic models of relational structure. -\newblock {\em Journal of Machine Learning Research}, 3:679--707, December - 2002. - -\bibitem{Rig-AIIA07-IC} -Fabrizio Riguzzi. -\newblock A top down interpreter for lpad and cp-logic. -\newblock In {\em 10th Congress of the Italian Association for Artificial - Intelligence}. Springer, 2007. -\newblock - \href{http://www.ing.unife.it/docenti/FabrizioRiguzzi/Papers/Rig-AIIA07.pdf}% -{http://www.ing.unife.it/docenti/FabrizioRiguzzi/Papers/Rig-AIIA07.pdf}. - -\bibitem{Rig-RCRA07-IC} -Fabrizio Riguzzi. -\newblock A top down interpreter for lpad and cp-logic. -\newblock In {\em The 14th RCRA workshop Experimental Evaluation of Algorithms - for Solving Problems with Combinatorial Explosion}, 2007. -\newblock - \href{http://pst.istc.cnr.it/RCRA07/articoli/P19-riguzzi-RCRA07.pdf}{http://% -pst.istc.cnr.it/RCRA07/articoli/P19-riguzzi-RCRA07.pdf}. - -\bibitem{SanPagQaz03-UAI-IC} -V.~Santos~Costa, D.~Page, M.~Qazi, and J.~Cussens. -\newblock {CLP(BN)}: Constraint logic programming for probabilistic knowledge. -\newblock In {\em Uncertainty in Artificial Intelligence ({UAI} 2003)}, 2003. - -\bibitem{VenDenBru-JELIA06} -J.~Vennekens, M.~Denecker, and M.~Bruynooghe. -\newblock Representing causal information about a probabilistic process. -\newblock In {\em 10th European Conference on Logics in Artificial - Intelligence, JELIA 2006}, LNAI. Springer, September 2006. - -\bibitem{VenVer03-TR} -J.~Vennekens and S.~Verbaeten. -\newblock Logic programs with annotated disjunctions. -\newblock Technical Report CW386, K. U. Leuven, 2003. -\newblock - \href{http://www.cs.kuleuven.ac.be/~joost/techrep.ps}{http://www.cs.kuleuven% -.ac.be/$\sim$joost/techrep.ps}. - -\bibitem{VenVer04-ICLP04-IC} -J.~Vennekens, S.~Verbaeten, and M.~Bruynooghe. -\newblock Logic programs with annotated disjunctions. -\newblock In {\em The 20th International Conference on Logic Programming - ({ICLP} 2004)}, 2004. -\newblock - \href{http://www.cs.kuleuven.ac.be/~joost/}{http://www.cs.kuleuven.ac.be/$\sim$joost/}. - -\bibitem{CP-logic-unp} -Joost Vennekens, Marc Denecker, and Maurice Bruynooge. -\newblock Extending the role of causality in probabilistic modeling. -\newblock - \href{http://www.cs.kuleuven.ac.be/~joost/cplogic.pdf}{http://www.cs.kuleuve% -n.ac.be/$\sim$joost/cplogic.pdf}, 2006. - -\end{thebibliography} diff --git a/packages/cplint/doc/manual.css b/packages/cplint/doc/manual.css deleted file mode 100644 index 1addc2ca6..000000000 --- a/packages/cplint/doc/manual.css +++ /dev/null @@ -1,123 +0,0 @@ - -/* start css.sty */ -.cmr-7{font-size:70%;} -.cmmi-7{font-size:70%;font-style: italic;} -.cmmi-10{font-style: italic;} -.cmr-17{font-size:170%;} -.cmtt-12x-x-144{font-size:172%;font-family: monospace;} -.cmtt-12x-x-144{font-family: monospace;} -.cmr-12{font-size:120%;} -.cmtt-10{font-family: monospace;} -.cmtt-10{font-family: monospace;} -.cmbx-10{ font-weight: bold;} -.cmti-10{ font-style: italic;} -p.noindent { text-indent: 0em } -td p.noindent { text-indent: 0em; margin-top:0em; } -p.nopar { text-indent: 0em; } -p.indent{ text-indent: 1.5em } -@media print {div.crosslinks {visibility:hidden;}} -a img { border-top: 0; border-left: 0; border-right: 0; } -center { margin-top:1em; margin-bottom:1em; } -td center { margin-top:0em; margin-bottom:0em; } -.Canvas { position:relative; } -img.math{vertical-align:middle;} -li p.indent { text-indent: 0em } -li p:first-child{ margin-top:0em; } -li p:last-child, li div:last-child { margin-bottom:0.5em; } -li p~ul:last-child, li p~ol:last-child{ margin-bottom:0.5em; } -.enumerate1 {list-style-type:decimal;} -.enumerate2 {list-style-type:lower-alpha;} -.enumerate3 {list-style-type:lower-roman;} -.enumerate4 {list-style-type:upper-alpha;} -div.newtheorem { margin-bottom: 2em; margin-top: 2em;} -.obeylines-h,.obeylines-v {white-space: nowrap; } -div.obeylines-v p { margin-top:0; margin-bottom:0; } -.overline{ text-decoration:overline; } -.overline img{ border-top: 1px solid black; } -td.displaylines {text-align:center; white-space:nowrap;} -.centerline {text-align:center;} -.rightline {text-align:right;} -div.verbatim {font-family: monospace; white-space: nowrap; text-align:left; clear:both; } -.fbox {padding-left:3.0pt; padding-right:3.0pt; text-indent:0pt; border:solid black 0.4pt; } -div.fbox {display:table} -div.center div.fbox {text-align:center; clear:both; padding-left:3.0pt; padding-right:3.0pt; text-indent:0pt; border:solid black 0.4pt; } -div.minipage{width:100%;} -div.center, div.center div.center {text-align: center; margin-left:1em; margin-right:1em;} -div.center div {text-align: left;} -div.flushright, div.flushright div.flushright {text-align: right;} -div.flushright div {text-align: left;} -div.flushleft {text-align: left;} -.underline{ text-decoration:underline; } -.underline img{ border-bottom: 1px solid black; margin-bottom:1pt; } -.framebox-c, .framebox-l, .framebox-r { padding-left:3.0pt; padding-right:3.0pt; text-indent:0pt; border:solid black 0.4pt; } -.framebox-c {text-align:center;} -.framebox-l {text-align:left;} -.framebox-r {text-align:right;} -span.thank-mark{ vertical-align: super } -span.footnote-mark sup.textsuperscript, span.footnote-mark a sup.textsuperscript{ font-size:80%; } -div.tabular, div.center div.tabular {text-align: center; margin-top:0.5em; margin-bottom:0.5em; } -table.tabular td p{margin-top:0em;} -table.tabular {margin-left: auto; margin-right: auto;} -td p:first-child{ margin-top:0em; } -td p:last-child{ margin-bottom:0em; } -div.td00{ margin-left:0pt; margin-right:0pt; } -div.td01{ margin-left:0pt; margin-right:5pt; } -div.td10{ margin-left:5pt; margin-right:0pt; } -div.td11{ margin-left:5pt; margin-right:5pt; } -table[rules] {border-left:solid black 0.4pt; border-right:solid black 0.4pt; } -td.td00{ padding-left:0pt; padding-right:0pt; } -td.td01{ padding-left:0pt; padding-right:5pt; } -td.td10{ padding-left:5pt; padding-right:0pt; } -td.td11{ padding-left:5pt; padding-right:5pt; } -table[rules] {border-left:solid black 0.4pt; border-right:solid black 0.4pt; } -.hline hr, .cline hr{ height : 1px; margin:0px; } -.tabbing-right {text-align:right;} -span.TEX {letter-spacing: -0.125em; } -span.TEX span.E{ position:relative;top:0.5ex;left:-0.0417em;} -a span.TEX span.E {text-decoration: none; } -span.LATEX span.A{ position:relative; top:-0.5ex; left:-0.4em; font-size:85%;} -span.LATEX span.TEX{ position:relative; left: -0.4em; } -div.float, div.figure {margin-left: auto; margin-right: auto;} -div.float img {text-align:center;} -div.figure img {text-align:center;} -.marginpar {width:20%; float:right; text-align:left; margin-left:auto; margin-top:0.5em; font-size:85%; text-decoration:underline;} -.marginpar p{margin-top:0.4em; margin-bottom:0.4em;} -table.equation {width:100%;} -.equation td{text-align:center; } -td.equation { margin-top:1em; margin-bottom:1em; } -td.equation-label { width:5%; text-align:center; } -td.eqnarray4 { width:5%; white-space: normal; } -td.eqnarray2 { width:5%; } -table.eqnarray-star, table.eqnarray {width:100%;} -div.eqnarray{text-align:center;} -div.array {text-align:center;} -div.pmatrix {text-align:center;} -table.pmatrix {width:100%;} -span.pmatrix img{vertical-align:middle;} -div.pmatrix {text-align:center;} -table.pmatrix {width:100%;} -span.bar-css {text-decoration:overline;} -img.cdots{vertical-align:middle;} -.partToc a, .partToc, .likepartToc a, .likepartToc {line-height: 200%; font-weight:bold; font-size:110%;} -.index-item, .index-subitem, .index-subsubitem {display:block} -div.caption {text-indent:-2em; margin-left:3em; margin-right:1em; text-align:left;} -div.caption span.id{font-weight: bold; white-space: nowrap; } -h1.partHead{text-align: center} -p.bibitem { text-indent: -2em; margin-left: 2em; margin-top:0.6em; margin-bottom:0.6em; } -p.bibitem-p { text-indent: 0em; margin-left: 2em; margin-top:0.6em; margin-bottom:0.6em; } -.paragraphHead, .likeparagraphHead { margin-top:2em; font-weight: bold;} -.subparagraphHead, .likesubparagraphHead { font-weight: bold;} -.quote {margin-bottom:0.25em; margin-top:0.25em; margin-left:1em; margin-right:1em; text-align:justify;} -.verse{white-space:nowrap; margin-left:2em} -div.maketitle {text-align:center;} -h2.titleHead{text-align:center;} -div.maketitle{ margin-bottom: 2em; } -div.author, div.date {text-align:center;} -div.thanks{text-align:left; margin-left:10%; font-size:85%; font-style:italic; } -div.author{white-space: nowrap;} -.quotation {margin-bottom:0.25em; margin-top:0.25em; margin-left:1em; } -.abstract p {margin-left:5%; margin-right:5%;} -div.abstract {width:100%;} -.figure img.graphics {margin-left:10%;} -/* end css.sty */ - diff --git a/packages/cplint/doc/manual.html b/packages/cplint/doc/manual.html index 4c8816cb3..df314f7e8 100644 --- a/packages/cplint/doc/manual.html +++ b/packages/cplint/doc/manual.html @@ -1,1740 +1,545 @@ - - -cplint Manual - - - - - - - - -

    - - - -

    cplint Manual

    -
    Fabrizio Riguzzi -
    fabrizio.riguzzi@unife.it

    -
    September 17, 2013
    -
    -

    1 Introduction

    -

    cplint is a suite of programs for reasoning with ICL [15], LPADs [24, 25] and -CP-logic programs [22, 23]. It contains programs both for inference and -learning. -

    -

    2 Installation

    -

    cplint is distributed in source code in the source code development tree of Yap. It -includes Prolog and C files. Download it by following the instruction in -http://www.dcc.fc.up.pt/˜vsc/Yap/downloads.html . -

    cplint requires CUDD . You can download CUDD from -ftp://vlsi.colorado.edu/pub/cudd-2.5.0.tar.gz . -

    Compile CUDD: -

      -
    1. decompress cudd-2.4.2.tar.gz -
      2. -
    2. cd cudd-2.4.2 -
      3. -
    3. see the README file for instructions on compilation
    -

    Install Yap together with cplint: when compiling Yap following the instruction of -the INSTALL file in the root of the Yap folder, use - -

    -configure --enable-cplint=DIR -
    -

    where DIR is the directory where CUDD is, i.e., the directory ending with -cudd-2.5.0. Under Windows, you have to use Cygwin (CUDD does not compile -under MinGW), so
    - -

    -configure --enable-cplint=DIR --enable-cygwin -
    -

    -

    After having performed make install you can do make installcheck that will -execute a suite of tests of the various programs. If no error is reported you have a -working installation of cplint. -

    -

    3 Syntax

    -

    LPAD and CP-logic programs consist of a set of annotated disjunctive clauses. -Disjunction in the head is represented with a semicolon and atoms in the head are -separated from probabilities by a colon. For the rest, the usual syntax of Prolog is -used. For example, the CP-logic clause -

    -h1 : p1 ∨...∨ hn : pn ← b1,...,bm,¬c1,...,¬cl
    is -represented by - -
    -h1:p1 ; ... ; hn:pn :- b1,...,bm,\+ c1,....,\+ cl -
    -

    No parentheses are necessary. The pi are numeric expressions. It is up to the user to -ensure that the numeric expressions are legal, i.e. that they sum up to less than -one. -

    If the clause has an empty body, it can be represented like this - -

    -h1:p1 ; ... ;hn:pn. -
    -

    If the clause has a single head with probability 1, the annotation can be omitted and -the clause takes the form of a normal prolog clause, i.e. - -

    -h1:- b1,...,bm,\+ c1,...,\+ cl. -
    -

    stands for - -

    -h1:1 :- b1,...,bm,\+ c1,...,\+ cl. -
    -

    -

    The coin example of [25] is represented as (see file coin.cpl) - -

    -heads(Coin):1/2 ; tails(Coin):1/2:- - 
         toss(Coin),\+biased(Coin). - 
    - 
    heads(Coin):0.6 ; tails(Coin):0.4:- - 
         toss(Coin),biased(Coin). - 
    - 
    fair(Coin):0.9 ; biased(Coin):0.1. - 
    - 
    toss(coin). -
    -

    The first clause states that if we toss a coin that is not biased it has equal -probability of landing heads and tails. The second states that if the coin is biased it -has a slightly higher probability of landing heads. The third states that the coin is -fair with probability 0.9 and biased with probability 0.1 and the last clause states -that we toss a coin with certainty. -

    Moreover, the bodies of rules can contain the built-in predicates: - -

    -is/2, >/2, </2, >=/2 ,=</2, - 
    =:=/2, =\=/2, true/0, false/0, - 
    =/2, ==/2, \=/2 ,\==/2, length/2 -
    -

    The bodies can also contain the following library predicates: - -

    -member/2, max_list/2, min_list/2 - 
    nth0/3, nth/3 -
    -

    plus the predicate - -

    -average/2 -
    -

    that, given a list of numbers, computes its arithmetic mean. -

    The syntax of ICL program is the one used by the AILog 2 system. -

    4 Inference

    -

    cplint contains various modules for answering queries. -

    These modules answer queries using using goal-oriented procedures: -

      -
    • lpadsld.pl: uses the top-down procedure described in in [16] and [17]. It - is based on SLDNF resolution and is an adaptation of the interpreter for - ProbLog [11]. -

      It was proved correct [17] with respect to the semantics of LPADs for - range restricted acyclic programs [1] without function symbols. -

      It is also able to deal with extensions of LPADs and CP-logic: the clause - bodies can contain setof and bagof, the probabilities in the head may - be depend on variables in the body and it is possible to specify a uniform - distribution in the head with reference to a setof or bagof operator. - These extended features have been introduced in order to represent - CLP(BN) [21] programs and PRM models [14]: setof and bagof allow to - express dependency of an attribute from an aggregate function of another - attribute, as in CLP(BN) and PRM, while the possibility of specifying a - uniform distribution allows the use of the reference uncertainty feature of - PRM. -

      • -
    • picl.pl: performs inference on ICL programs [18] -
      • -
    • lpad.pl: uses a top-down procedure based on SLG resolution [9]. As a - consequence, it works for any sound LPADs, i.e., any LPAD such that - each of its instances has a two valued well founded model. -
      • -
    • cpl.pl: uses a top-down procedure based on SLG resolution and moreover - checks that the CP-logic program is valid, i.e., that it has at least an - execution model. -
      • -
    • Modules for approximate inference: - -
        -
      • deepit.pl performs iterative deepening [8] -
        • -
      • deepdyn.pl performs dynamic iterative deepening [8] -
        • -
      • bestk.pl performs k-Best [8] -
        • -
      • bestfirst.pl performs best first [8] -
        • -
      • montecarlo.pl performs Monte Carlo [8] -
        • -
      • mcintyre.pl: implements the algorithm MCINTYRE (Monte Carlo - INference wiTh Yap REcord) [19]
      -
      • -
    • approx/exact.pl as lpadsld.pl but uses SimplecuddLPADs, a modification - of the Simplecudd instead of the cplint library for building BDDs and - computing the probability.
    -

    These modules answer queries using the definition of the semantics of LPADs and -CP-logic: -

      -
    • semlpadsld.pl: given an LPAD P, it generates all the instances of P. - The probability of a query Q is computed by identifying all the instances - where Q is derivable by SLDNF resolution. -
      • -
    • semlpad.pl: given an LPAD P, it generates all the instances of P. The - probability of a query Q is computed by identifying all the instances where - Q is derivable by SLG resolution. -
      • -
    • semlcpl.pl: given an LPAD P, it builds an execution model of P, i.e., - a probabilistic process that satisfy the principles of universal causation, - sufficient causation, independent causation, no deus ex machina events - and temporal precedence. It uses the definition of the semantics given in - [23].
    -

    -

    4.1 Commands

    -

    The LPAD or CP-logic program must be stored in a text file with extension .cpl. -Suppose you have stored the example above in file coin.cpl. In order to answer -queries from this program, you have to run Yap, load one of the modules (such as for -example lpad.pl) by issuing the command - -

    -use_module(library(lpad)). -
    -

    at the command prompt. Then you must parse the source file coin.cpl with the -command - -

    -p(coin). -
    -

    if coin.cpl is in the current directory, or - -

    -p(’path_to_coin/coin’). -
    -

    if coin.cpl is in a different directory. At this point you can pose query to the -program by using the predicate s/2 (for solve) that takes as its first argument a -conjunction of goals in the form of a list and returns the computed probability -as its second argument. For example, the probability of the conjunction -head(coin),biased(coin) can be asked with the query - -

    -s([head(coin),biased(coin)],P). -
    -

    For computing the probability of a conjunction given another conjunction you can -use the predicate sc/3 (for solve conditional) that take takes as input the query -conjunction as its first argument, the evidence conjunction as its second argument -and returns the probability in its third argument. For example, the probability of the -query heads(coin) given the evidence biased(coin) can be asked with the -query - -

    -sc([heads(coin)],[biased(coin)],P). -
    -

    After having parsed a program, in order to read in a new program you must restart -Yap when using semlpadsld.pl and semlpad.pl. With the other modules, you can -directly parse a new program. -

    When using lpad.pl, the system can print the message “Uunsound program” in -the case in which an instance with a three valued well founded model is found. -Moreover, it can print the message “It requires the choice of a head atom from a non -ground head”: in this case, in order to answer the query, all the groundings of the -culprit clause must be generated, which may be impossible for programs with -function symbols. -

    When using semcpl.pl, you can print the execution process by using the -command print. after p(file). Moreover, you can build an execution -process given a context by issuing the command parse(file). and then -build(context). where context is a list of atoms that are true in the context. -semcpl.pl can print “Invalid program” in the case in which no execution process -exists. -

    When using cpl.pl you can print a partial execution model including all the -clauses involved in the query issued with print. cpl.pl can print the messages -“Uunsound program”, “It requires the choice of a head atom from a non ground -head” and “Invalid program”. -

    For approx/deepit.pl and approx/deepdyn.pl the command - -

    -solve(GoalsList, ProbLow, ProbUp, ResTime, BddTime) -
    -

    takes as input a list of goals GoalsList and returns a lower bound on the -probability ProbLow, an upper bound on the probability ProbUp, the CPU time spent -on performing resolution ResTime and the CPU time spent on handling BDDs -BddTime. -

    For approx/bestk.pl the command - -

    -solve(GoalsList, ProbLow,  ResTime, BddTime) -
    -

    takes as input a list of goals GoalsList and returns a lower bound on the -probability ProbLow, the CPU time spent on performing resolution ResTime and the -CPU time spent on handling BDDs BddTime. -

    For approx/bestfirst.pl the command - -

    -solve(GoalsList, ProbLow, ProbUp, Count, ResTime, BddTime) -
    -

    takes as input a list of goals GoalsList and returns a lower bound on the -probability ProbLow, an upper bound on the probability ProbUp, the number of -BDDs generated by the algorithm Count, the CPU time spent on performing -resolution ResTime and the CPU time spent on handling BDDs BddTime. -

    For approx/montecarlo.pl the command - -

    -solve(GoalsList, Samples, Time, Low, Prob, Up) -
    -

    takes as input a list of goals GoalsList and returns the number of samples taken -Samples, the time required to solve the problem Time, the lower end of the -confidence interval Lower, the estimated probability Prob and the upper end of the -confidence interval Up. -

    For mcintyre.pl: the command - -

    -solve(Goals, Samples, CPUTime, WallTime, Lower, Prob, Upper) :- -
    -

    takes as input a conjunction of goals Goals and returns the number of samples taken -Samples, the CPU time required to solve the problem CPUTime, the wall time -required to solve the problem CPUTime, the lower end of the confidence interval -Lower, the estimated probability Prob and the upper end of the confidence interval -Up. -

    For approx/exact.pl the command - -

    -solve(GoalsList, Prob, ResTime, BddTime) -
    -

    takes as input a conjunction of goals Goals and returns the probability Prob, the -CPU time spent on performing resolution ResTime and the CPU time spent on -handling BDDs BddTime. -

    -

    4.1.1 Parameters
    -

    The modules make use of a number of parameters in order to control their behavior. -They that can be set with the command - -

    -set(parameter,value). -
    -

    from the Yap prompt after having loaded the module. The current value can be read -with - -

    -setting(parameter,Value). -
    -

    from the Yap prompt. The available parameters are: -

      -
    • epsilon_parsing (valid for all modules): if (1 - the sum of the - probabilities of all the head atoms) is smaller than epsilon_parsing then - cplint adds the null events to the head. Default value 0.00001 -
      • -
    • save_dot (valid for all goal-oriented modules): if true a graph representing the - BDD is saved in the file cpl.dot in the current directory in dot format. The - variables names are of the form Xn_m where n is the number of the multivalued - variable and m is the number of the binary variable. The correspondence - between variables and clauses can be evinced from the message printed on the - screen, such as - -
      - Variables: [(2,[X=2,X1=1]),(2,[X=1,X1=0]),(1,[])] -
      -

      where the first element of each couple is the clause number of the input file - (starting from 1). In the example above variable X0 corresponds to clause 2 - with the substitutions X=2,X1=1, variable X1 corresponds to clause 2 with the - substitutions X=1,X1=0 and variable X2 corresponds to clause 1 with the - empty substitution. You can view the graph with graphviz using the - command - -

      - dotty cpl.dot & -
      -

      -

      • -
    • ground_body: (valid for lpadsld.pl and all semantic modules) determines how - non ground clauses are treated: if true, ground clauses are obtained from a non - ground clause by replacing each variable with a constant, if false, ground - clauses are obtained by replacing only variables in the head with a - constant. In the case where the body contains variables not in the - head, setting it to false means that the body represents an existential - event. -
      • -
    • min_error: (valid for approx/deepit.pl, approx/deepdyn.pl, - approx/bestk.pl, approx/bestfirst.pl, approx/montecarlo.pl and - mcintyre.pl) is the threshold under which the difference between - upper and lower bounds on probability must fall for the algorithm to - stop. -
      • -
    • k: maximum number of explanations for approx/bestk.pl and - approx/bestfirst.pl and number of samples to take at each iteration for - approx/montecarlo.pl and mcintyre.pl -
      • -
    • prob_bound: (valid for approx/deepit.pl, approx/deepdyn.pl, - approx/bestk.pl and approx/bestfirst.pl) is the initial bound on the - probability of explanations when iteratively building explanations -
      • -
    • prob_step: (valid for approx/deepit.pl, approx/deepdyn.pl, - approx/bestk.pl and approx/bestfirst.pl) is the increment on the - bound on the probability of explanations when iteratively building - explanations -
      • -
    • timeout: (valid for approx/deepit.pl, approx/deepdyn.pl, approx/bestk.pl, - approx/bestfirst.pl and approx/exact.pl) timeout for builduing - BDDs
    - -

    -

    4.2 Semantic Modules

    -

    The three semantic modules need to produce a grounding of the program in order to -compute the semantics. They require an extra file with extension .uni (for universe) -in the same directory where the .cpl file is. -

    There are two ways to specify how to ground a program. The first consists in -providing the list of constants to which each variable can be instantiated. For -example, in our case the current directory will contain a file coin.uni that is a -Prolog file containing facts of the form - -

    -universe(var_list,const_list). -
    -

    where var_list is a list of variables names (each must be included in single quotes) -and const_list is a list of constants. The semantic modules generate the grounding -by instantiating in all possible ways the variables of var_list with the constants of -const_list. Note that the variables are identified by name, so a variable with -the same name in two different clauses will be instantiated with the same -constants. -

    The other way to specify how to ground a program consists in using mode and -type information. For each predicate, the file .uni must contain a fact of the -form - -

    -mode(predicate(t1,...,tn)). -
    -

    that specifies the number and types of each argument of the predicate. Then, the list -of constants that are in the domain of each type ti must be specified with a fact of -the form - -

    -type(ti,list_of_constants). -
    -

    The file .uni can contain both universe and mode declaration, the ones to be used -depend on the value of the parameter grounding: with value variables, the -universe declarations are used, with value modes the mode declarations are -used. -

    With semcpl.pl only mode declarations can be used. -

    -

    4.3 Extensions

    -

    In this section we will present the extensions to the syntax of LPADs and CP-logic -programs that lpadsld can handle. -

    When using lpadsld.pl, the bodies can contain the predicates setof/3 and -bagof/3 with the same meaning as in Prolog. Existential quantifiers are allowed in -both, so for example the query - -

    -setof(Z, (term(X,Y))^foo(X,Y,Z), L). -
    -

    returns all the instantiations of Z such that there exists an instantiation of X and Y -for which foo(X,Y,Z) is true. -

    An example of the use of setof and bagof is in the file female.cpl: - -

    -male(C):M/P ; female(C):F/P:- - 
        person(C), - 
        setof(Male,known_male(Male),LM), - 
        length(LM,M), - 
        setof(Female,known_female(Female),LF), - 
        length(LF,F), - 
        P is F+M. - 
    - 
    person(f). - 
    - 
    known_female(a). - 
    known_female(b). - 
    known_female(c). - 
    known_male(d). - 
    known_male(e). -
    -

    The disjunctive rule expresses the probability of a person of unknown sex of being -male or female depending on the number of males and females that are known. This -is an example of the use of expressions in the probabilities in the head that depend -on variables in the body. The probabilities are well defined because they always sum -to 1 (unless P is 0). -

    Another use of setof and bagof is to have an attribute depend on an -aggregate function of another attribute, similarly to what is done in PRM and -CLP(BN). -

    So, in the classical school example (available in student.cpl) you can find the -following clauses: - -

    -student_rank(S,h):0.6 ; student_rank(S,l):0.4:- - 
        bagof(G,R^(registr_stu(R,S),registr_gr(R,G)),L), - 
        average(L,Av),Av>1.5. - 
    - 
    student_rank(S,h):0.4 ; student_rank(S,l):0.6:- - 
        bagof(G,R^(registr_stu(R,S),registr_gr(R,G)),L), - 
        average(L,Av),Av =< 1.5. -
    -

    where registr_stu(R,S) expresses that registration R refers to student S and -registr_gr(R,G) expresses that registration R reports grade G which is a natural -number. The two clauses express a dependency of the rank of the student from the -average of her grades. -

    Another extension can be used with lpadsld.pl in order to be able to represent -reference uncertainty of PRMs. Reference uncertainty means that the link structure -of a relational model is not fixed but is uncertain: this is represented by having the -instance referenced in a relationship be chosen uniformly from a set. For example, -consider a domain modeling scientific papers: you have a single entity, paper, and a -relationship, cites, between paper and itself that connects the citing paper to the -cited paper. To represent the fact that the cited paper and the citing paper are -selected uniformly from certain sets, the following clauses can be used (see file -paper_ref_simple.cpl): - -

    -uniform(cites_cited(C,P),P,L):- - 
        bagof(Pap,paper_topic(Pap,theory),L). - 
    - 
    uniform(cites_citing(C,P),P,L):- - 
        bagof(Pap,paper_topic(Pap,ai),L). -
    -

    The first clauses states that the paper P cited in a citation C is selected -uniformly from the set of all papers with topic theory. The second clauses -expresses that the citing paper is selected uniformly from the papers with topic -ai. -

    These clauses make use of the predicate - -

    -uniform(Atom,Variable,List) -
    -

    in the head, where Atom must contain Variable. The meaning is the following: -the set of all the atoms obtained by instantiating Variable of Atom with a -term taken from List is generated and the head is obtained by having a -disjunct for each instantiation with probability 1∕N where N is the length of -List. -

    A more elaborate example is present in file paper_ref.cpl: - -

    -uniform(cites_citing(C,P),P,L):- - 
        setof(Pap,paper(Pap),L). - 
    - 
    cites_cited_group(C,theory):0.9 ; cites_cited_group(C,ai):0.1:- - 
        cites_citing(C,P),paper_topic(P,theory). - 
    - 
    cites_cited_group(C,theory):0.01;cites_cited_group(C,ai):0.99:- - 
        cites_citing(C,P),paper_topic(P,ai). - 
    - 
    uniform(cites_cited(C,P),P,L):- - 
        cites_cited_group(C,T),bagof(Pap,paper_topic(Pap,T),L). -
    -

    where the cited paper depends on the topic of the citing paper. In particular, if the -topic is theory, the cited paper is selected uniformly from the papers about theory -with probability 0.9 and from the papers about ai with probability 0.1. if -the topic is ai, the cited paper is selected uniformly from the papers about -theory with probability 0.01 and from the papers about ai with probability -0.99. -

    PRMs take into account as well existence uncertainty, where the existence of -instances is also probabilistic. For example, in the paper domain, the total number of -citations may be unknown and a citation between any two paper may have a -probability of existing. For example, a citation between two paper may be more -probable if they are about the same topic: - -

    -cites(X,Y):0.005 :- - 
        paper_topic(X,theory),paper_topic(Y,theory). - 
    - 
    cites(X,Y):0.001 :- - 
        paper_topic(X,theory),paper_topic(Y,ai). - 
    - 
    cites(X,Y):0.003 :- - 
        paper_topic(X,ai),paper_topic(Y,theory). - 
    - 
    cites(X,Y):0.008 :- - 
        paper_topic(X,ai),paper_topic(Y,ai). -
    -

    This is an example where the probabilities in the head do not sum up to one so the -null event is automatically added to the head. The first clause states that, if the topic -of a paper X is theory and of paper Y is theory, there is a probability of 0.005 that -there is a citation from X to Y. The other clauses consider the remaining cases for the -topics. -

    -

    4.4 Files

    -

    In the directory where Yap keeps the library files (usually /usr/local/share/ Yap) -you can find the directory cplint that contains the files: -

      -
    • testlpadsld_gbtrue.pl, testlpadsld_gbfalse.pl, testlpad.pl, - testcpl.pl, testsemlpadsld.pl, testsemlpad.pl testsemcpl.pl: - Prolog programs for testing the modules. They are executed when issuing - the command make installcheck during the installation. To execute - them afterwords, load the file and issue the command t. -
      • -
    • Subdirectory examples: -
        -
      • alarm.cpl: representation of the Bayesian network in Figure 2 of - [25]. -
        • -
      • coin.cpl: coin example from [25]. -
        • -
      • coin2.cpl: coin example with two coins. -
        • -
      • dice.cpl: dice example from [25]. - -
        • -
      • twosideddice.cpl, threesideddice.cpl game with idealized dice - with two or three sides. Used in the experiments in [17]. -
        • -
      • ex.cpl: first example in [17]. -
        • -
      • exapprox.cpl: example showing the problems of approximate - inference (see [17]). -
        • -
      • exrange.cpl: example showing the problems with non range - restricted programs (see [17]). -
        • -
      • female.cpl: example showing the dependence of probabilities in the - head from variables in the body (from [25]). -
        • -
      • mendel.cpl, mendels.cpl: programs describing the Mendelian - rules of inheritance, taken from [7]. -
        • -
      • paper_ref.cpl, paper_ref_simple.cpl: paper citations examples, - showing reference uncertainty, inspired by [14]. -
        • -
      • paper_ref_not.cpl: paper citations example showing that negation - can be used also for predicates defined by clauses with uniform in - the head. -
        • -
      • school.cpl: example inspired by the example school_32.yap from - the source distribution of Yap in the CLPBN directory. -
        • -
      • school_simple.cpl: simplified version of school.cpl. -
        • -
      • student.cpl: student example from Figure 1.3 of [13]. -
        • -
      • win.cpl, light.cpl, trigger.cpl, throws.cpl, hiv.cpl,
        invalid.cpl: programs taken from [23]. invalid.cpl is an example - of a program that is invalid but sound.
      -

      The files *.uni that are present for some of the examples are used by the - semantical modules. Some of the example files contain in an initial comment - some queries together with their result. -

      • -
    • Subdirectory doc: contains this manual in latex, html and pdf.
    - -

    -

    5 Learning

    -

    cplint contains the following learning algorithms: -

      -
    • CEM (cplint EM): an implementation of EM for learning parameters - that is based on lpadsld.pl [20] -
      • -
    • RIB (Relational Information Bottleneck): an algorithm for learning - parameters based on the Information Bottleneck [20] -
      • -
    • EMBLEM (EM over Bdds for probabilistic Logic programs Efficient - Mining): an implementation of EM for learning parameters that computes - expectations directly on BDDs [5, 2, 3] -
      • -
    • SLIPCASE (Structure LearnIng of ProbabilistiC logic progrAmS with - Em over bdds): an algorithm for learning the structure of programs by - searching directly the theory space [4] -
      • -
    • SLIPCOVER (Structure LearnIng of Probabilistic logic programs by - searChing OVER the clause space): an algorithm for learning the structure - of programs by searching the clause space and the theory space separatery - [6]
    -

    -

    5.1 Input

    -

    To execute the learning algorithms, prepare four files in the same folder: -

      -
    • <stem>.kb: contains the example interpretations -
      • -
    • <stem>.bg: contains the background knowledge, i.e., knowledge valid for - all interpretations -
      • -
    • <stem>.l: contains language bias information -
      • -
    • <stem>.cpl: contains the LPAD for you which you want to learn the - parameters or the initial LPAD for SLIPCASE. For SLIPCOVER, this file - should be absent
    - -

    where <stem> is your dataset name. Examples of these files can be found in the dataset -pages. -

    In <stem>.kb the example interpretations have to be given as a list of Prolog -facts initiated by begin(model(<name>)). and terminated by end(model(<name>)). -as in - -

    -begin(model(b1)). - 
    sameperson(1,2). - 
    movie(f1,1). - 
    movie(f1,2). - 
    workedunder(1,w1). - 
    workedunder(2,w1). - 
    gender(1,female). - 
    gender(2,female). - 
    actor(1). - 
    actor(2). - 
    end(model(b1)). -
    -

    The interpretations may contain a fact of the form - -

    -prob(0.3). -
    -

    assigning a probability (0.3 in this case) to the interpretations. If this is omitted, the -probability of each interpretation is considered equal to 1∕n where n is the total -number of interpretations. prob/1 can be used to set different multiplicity for the -different interpretations. -

    In order for RIB to work, the input interpretations must share the Herbrand -universe. If this is not the case, you have to translate the interpretations in this was, -see for example the sp1 files in RIB’s folder, that are the results of the conversion of -the first fold of the IMDB dataset. -

    <stem>.bg can contain Prolog clauses that can be used to derive additional -conclusions from the atoms in the interpretations. -

    <stem>.l contains the declarations of the input and output predicates, of the -unseen predicates and the commands for setting the algorithms’ parameters. Output -predicates are declared as - -

    -output(<predicate>/<arity>). -
    -

    and define the predicates whose atoms in the input interpretations are used as the -goals for the prediction of which you want to optimize the parameters. Derivations -for these goals are built by the systems. -

    Input predicates are those for the predictions of which you do not want to -optimize the parameters. You can declare closed world input predicates -with - -

    -input_cw(<predicate>/<arity>). -
    -

    For these predicates, the only true atoms are those in the interpretations, the -clauses in the input program are not used to derive atoms not present in the -interpretations. -

    Open world input predicates are declared with - -

    -input(<predicate>/<arity>). -
    -

    In this case, if a subgoal for such a predicate is encountered when deriving the atoms -for the output predicates, both the facts in the interpretations and the clauses of the -input program are used. -

    For RIB, if there are unseen predicates, i.e., predicates that are present in the -input program but not in the interpretations, you have to declare them -with - -

    -unseen(<predicate>/<arity>). -
    -

    -

    For SLIPCASE and SLIPCOVER, you have to specify the language bias by -means of mode declarations in the style of Progol . - -

    -modeh(<recall>,<predicate>(<arg1>,...). -
    -

    specifies the atoms that can appear in the head of clauses, while - -

    -modeb(<recall>,<predicate>(<arg1>,...). -
    -

    specifies the atoms that can appear in the body of clauses. <recall> can be an -integer or * (currently unused). -

    The arguments are of the form - -

    -+<type> -
    -

    for specifying an input variable of type <type>, or - -

    --<type> -
    -

    for specifying an output variable of type <type>. or - -

    -<constant> -
    -

    for specifying a constant. -

    SLIPCOVER also allows the arguments - -

    -#<type> -
    -

    for specifying an argument which should be replaced by a constant of type <type> in -the bottom clause but should not be used for replacing input variables of the -following literals or - -

    --#<type> -
    -

    for specifying an argument which should be replaced by a constant of type <type> in -the bottom clause and that should be used for replacing input variables of -the following literals. # and -# differ only in the creation of the bottom -clause. -

    An example of language bias for the UWCSE domain is - -

    -output(advisedby/2). - 
    - 
    input(student/1). - 
    input(professor/1). - 
    .... - 
    - 
    modeh(*,advisedby(+person,+person)). - 
    - 
    modeb(*,professor(+person)). - 
    modeb(*,student(+person)). - 
    modeb(*,sameperson(+person, -person)). - 
    modeb(*,sameperson(-person, +person)). - 
    modeb(*,samecourse(+course, -course)). - 
    modeb(*,samecourse(-course, +course)). - 
    .... -
    -

    SLIPCOVER also requires facts for the determination/2 predicate that indicate -which predicates can appear in the body of clauses. For example - -

    -determination(professor/1,student/1). - 
    determination(student/1,hasposition/2). -
    -

    state that student/1 can appear in the body of clauses for professor/1 and that -hasposition/2 can appear in the body of clauses for student/1. -

    SLIPCOVER also allows mode declarations of the form - -

    -modeh(<r>,[<s1>,...,<sn>],[<a1>,...,<an>],[<P1/Ar1>,...,<Pk/Ark>]). -
    -

    These mode declarations are used to generate clauses with more than two head -atoms. In them, <s1>,...,<sn> are schemas, <a1>,...,<an> are atoms such that -<ai> is obtained from <si> by replacing placemarkers with variables, <Pi/Ari> are -the predicates admitted in the body. <a1>,...,<an> are used to indicate which -variables should be shared by the atoms in the head. An example of such a mode -declaration is - -

    -modeh(*, - 
      [advisedby(+person,+person),tempadvisedby(+person,+person)], - 
      [advisedby(A,B),tempadvisedby(A,B)], - 
      [professor/1,student/1,hasposition/2,inphase/2, - 
      publication/2,taughtby/3,ta/3,courselevel/2,yearsinprogram/2]). -
    -

    -

    -

    5.2 Parameters

    -

    In order to set the algorithms’ parameters, you have to insert in <stem>.l commands -of the form - -

    -:- set(<parameter>,<value>). -
    -

    The available parameters are: -

      -
    • depth (values: integer or inf, default value: 3): depth of derivations if - depth_bound is set to true -
      • -
    • single_var (values: {true,false}, default value: false, valid for CEM, - EMBLEM, SLIPCASE and SLIPCOVER): if set to true, there is a - random variable for each clauses, instead of a separate random variable - for each grounding of a clause -
      • -
    • sample_size (values: integer, default value: 1000): total number of - examples in case in which the models in the .kb file contain a prob(P). - fact. In that case, one model corresponds to sample_size*P examples -
      • -
    • epsilon_em (values: real, default value: 0.1, valid for CEM, EMBLEM, - SLIPCASE and SLIPCOVER): if the difference in the log likelihood in - two successive EM iteration is smaller than epsilon_em, then EM stops -
      • -
    • epsilon_em_fraction (values: real, default value: 0.01, valid for - CEM, EMBLEM, SLIPCASE and SLIPCOVER): if the difference in - the log likelihood in two successive EM iteration is smaller than - epsilon_em_fraction*(-current log likelihood), then EM stops -
      • -
    • iter (values: integer, defualt value: 1, valid for EMBLEM, SLIPCASE and - SLIPCOVER): maximum number of iteration of EM parameter learning. - If set to -1, no maximum number of iterations is imposed -
      • -
    • iterREF (values: integer, defualt value: 1, valid for SLIPCASE and - SLIPCOVER): maximum number of iteration of EM parameter learning - for refinements. If set to -1, no maximum number of iterations is imposed. -
      • -
    • random_restarts_number (values: integer, default value: 1, valid for - CEM, EMBLEM, SLIPCASE and SLIPCOVER): number of random - restarts of EM learning - -
      • -
    • random_restarts_REFnumber (values: integer, default value: 1, valid for - SLIPCASE and SLIPCOVER): number of random restarts of EM learning - for refinements -
      • -
    • setrand (values: rand(integer,integer,integer)): seed for the random - functions, see Yap manual for allowed values -
      • -
    • minimal_step (values: [0,1], default value: 0.005, valid for RIB): minimal - increment of γ -
      • -
    • maximal_step (values: [0,1], default value: 0.1, valid for RIB): maximal - increment of γ -
      • -
    • logsize_fraction (values: [0,1], default value 0.9, valid for RIB): RIB - stops when I(CH,T;Y ) is above logsize_fraction times its maximum - value (log |CH,T|, see [12]) -
      • -
    • delta (values: negative integer, default value -10, valid for RIB): value - assigned to log 0 -
      • -
    • epsilon_fraction (values: integer, default value 100, valid for RIB): - in the computation of the step, the value of ϵ of [12] is obtained as - log |CH,T|×epsilon_fraction -
      • -
    • max_rules (values: integer, default value: 6000, valid for RIB and - SLIPCASE): maximum number of ground rules. Used to set the size of - arrays for storing internal statistics. Can be increased as much as memory - allows. -
      • -
    • logzero (values: negative real, default value log(0.000001), valid for - SLIPCASE and SLIPCOVER): value assigned to log 0 -
      • -
    • examples (values: atoms,interpretations, default value atoms, valid for - SLIPCASE): determines how BDDs are built: if set to interpretations, - a BDD for the conjunction of all the atoms for the target predicates in each - interpretations is built. If set to atoms, a BDD is built for the conjunction - of a group of atoms for the target predicates in each interpretations. The - number of atoms in each group is determined by the parameter group - -
      • -
    • group (values: integer, default value: 1, valid for SLIPCASE): number of - target atoms in the groups that are used to build BDDs -
      • -
    • nax_iter (values: integer, default value: 10, valid for SLIPCASE and - SLIPCOVER): number of interations of beam search -
      • -
    • max_var (values: integer, default value: 1, valid for SLIPCASE and - SLIPCOVER): maximum number of distinct variables in a clause -
      • -
    • verbosity (values: integer in [1,3], default value: 1): level of verbosity of - the algorithms -
      • -
    • beamsize (values: integer, default value: 20, valid for SLIPCASE and - SLIPCOVER): size of the beam -
      • -
    • megaex_bottom (values: integer, default value: 1, valid for SLIPCOVER): - number of mega-examples on which to build the bottom clauses -
      • -
    • initial_clauses_per_megaex (values: integer, default value: 1, valid for - SLIPCOVER): number of bottom clauses to build for each mega-example -
      • -
    • d (values: integer, default value: 10000, valid for SLIPCOVER): number - of saturation steps when building the bottom clause -
      • -
    • max_iter_structure (values: integer, default value: 1, valid for - SLIPCOVER): maximum number of theory search iterations -
      • -
    • background_clauses (values: integer, default value: 50, valid for - SLIPCOVER): maximum numbers of background clauses -
      • -
    • maxdepth_var (values: integer, default value: 2, valid for SLIPCOVER): - maximum depth of variables in clauses (as defined in [10]). -
      • -
    • score (values: ll, aucpr, default value ll, valid for SLIPCOVER): - determines the score function for refinement: if set to ll, log likelihood is - used, if set to aucpr, the area under the Precision-Recall curve is used.
    - -

    -

    5.3 Commands

    -

    To execute CEM, load em.pl with - -

    -?:- use_module(library(’cplint/em’)). -
    -

    and call: - -

    -?:- em(stem). -
    -

    To execute RIB, load rib.pl with - -

    -?:- use_module(library(’cplint/rib’)). -
    -

    and call: - -

    -?:- ib_par(stem). -
    -

    To execute EMBLEM, load slipcase.pl with - -

    -?:- use_module(library(’cplint/slipcase’)). -
    -

    and call - -

    -?:- em(stem). -
    -

    To execute SLIPCASE, load slipcase.pl with - -

    -?:- use_module(library(’cplint/slipcase’)). -
    -

    and call - -

    -?:- sl(stem). -
    -

    To execute SLIPCOVER, load slipcover.pl with - -

    -?:- use_module(library(’cplint/slipcover’)). -
    -

    and call - -

    -?:- sl(stem). -
    -

    -

    -

    5.4 Testing

    -

    To test the theories learned, load test.pl with - -

    -?:- use_module(library(’cplint/test’)). -
    -

    and call - -

    -?:- main([<stem_fold1>,...,<stem_foldn>],[<testing_set_fold1>,..., - 
      <testing_set_foldn>]). -
    -

    For example, if you want to test the theory in ai_train.rules on the set ai.kb, -you can call - -

    -?:- main([ai_train],[ai]). -
    -

    The testing program has the following parameter: -

      -
    • neg_ex (values: given, cw, default value: cw): if set to given, the negative - examples are taken from <testing_set_foldi>.kb, i.e., those example - ex stored as neg(ex); if set to cw, the negative examples are generated - according to the closed world assumption, i.e., all atoms for target - predicates that are not positive examples. The set of all atoms is obtained - by collecting the set of constants for each type of the arguments of the - target predicate.
    -

    The testing program produces the following output in the current folder: -

      -
    • cll.pl: for each fold, the list of examples orderd by their probability of - being true -
      • -
    • areas.csv: the areas under the Precision-Recall curve and the Receiver - Operating Characteristic curve -
      • -
    • curve_roc.m: a Matlab file for plotting the Receiver Operating - Characteristic curve -
      • -
    • curve_pr.m: a Matlab file for plotting the Precision-Recall curve
    -

    -

    5.5 Learning Examples

    -

    The subfolders em, rib, slipcase and slipcover of the packages/cplint folder in -Yap git distribution contain examples of input and output files for the learning -algorithms. -

    -

    6 License

    -

    cplint, as Yap, follows the Artistic License 2.0 that you can find in Yap CVS root -dir. The copyright is by Fabrizio Riguzzi. - -

    The modules in the approx subdirectory use SimplecuddLPADs, a modification of -the Simplecudd library whose copyright is by Katholieke Universiteit Leuven and -that follows the Artistic License 2.0. -

    Some modules use the library CUDD for manipulating BDDs that is included in -glu. For the use of CUDD, the following license must be accepted: -

    Copyright (c) 1995-2004, Regents of the University of Colorado -

    All rights reserved. -

    Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: -

      -
    • Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. -
      • -
    • Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. -
      • -
    • Neither the name of the University of Colorado nor the names of its - contributors may be used to endorse or promote products derived from - this software without specific prior written permission.
    -

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
    AND CONTRIBUTORS ”AS IS” AND ANY EXPRESS OR IMPLIED -WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAU-SED
    AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -

    lpad.pl, semlpad.pl and cpl.pl are based on the SLG system by Weidong -Chen and David Scott Warren , Copyright (C) 1993 Southern Methodist University, -1993 SUNY at Stony Brook, see the file COYPRIGHT_SLG for detailed information -on this copyright. - -

    -

    References

    -

    -

    -

    - [1]   K. R. Apt and M. Bezem. Acyclic programs. New Gener. Comput., - 9(3/4):335–364, 1991. -

    -

    - [2]   Elena Bellodi and Fabrizio Riguzzi. EM over binary decision diagrams - for probabilistic logic programs. In Proceedings of the 26th Italian - Conference on Computational Logic (CILC2011), Pescara, Italy, 31 August - 31-2 September, 2011, 2011. -

    -

    - [3]   Elena Bellodi and Fabrizio Riguzzi. EM over binary decision - diagrams for probabilistic logic programs. Technical Report CS-2011-01, - Dipartimento di Ingegneria, Università di Ferrara, Italy, 2011. -

    -

    - [4]   Elena Bellodi and Fabrizio Riguzzi. Learning the structure of - probabilistic logic programs. In Inductive Logic Programming, 21th - International Conference, ILP 2011, London, UK, 31 July-3 August, 2011, - 2011. -

    -

    - [5]   Elena Bellodi and Fabrizio Riguzzi. Expectation Maximization over - binary decision diagrams for probabilistic logic programs. Intel. Data Anal., - 16(6), 2012. -

    -

    - [6]   Elena Bellodi and Fabrizio Riguzzi. Structure learning of probabilistic - logic programs by searching the clause space. Theory and Practice of Logic - Programming, 2013. -

    -

    - [7]   H. Blockeel. Probabilistic logical models for mendel’s experiments: An - exercise. In Inductive Logic Programming (ILP 2004), Work in Progress - Track, 2004. - -

    -

    - [8]   Stefano Bragaglia and Fabrizio Riguzzi. Approximate inference for logic - programs with annotated disjunctions. In Paolo Frasconi and Francesca - Lisi, editors, Inductive Logic Programming 20th International Conference, - ILP 2010, Florence, Italy, June 27-30, 2010. Revised Papers, volume 6489 - of LNCS, pages 30–37. Springer, 2011. -

    -

    - [9]   Weidong Chen and David Scott Warren. Tabled evaluation with - delaying for general logic programs. Journal of the ACM, 43(1):20–74, 1996. -

    -

    - [10]   William W. Cohen. Pac-learning non-recursive prolog clauses. Artif. - Intell., 79(1):1–38, 1995. -

    -

    - [11]   L. De Raedt, A. Kimmig, and H. Toivonen. ProbLog: A probabilistic - Prolog and its application in link discovery. In International Joint - Conference on Artificial Intelligence, pages 2462–2467, 2007. -

    -

    - [12]   G. Elidan and N. Friedman. Learning hidden variable networks: The - information bottleneck approach. Journal of Machine Learning Research, - 6:81–127, 2005. -

    -

    - [13]   L. Getoor, N. Friedman, D. Koller, and A. Pfeffer. Learning - probabilistic relational models. In Saso Dzeroski and Nada Lavrac, editors, - Relational Data Mining. Springer-Verlag, Berlin, 2001. -

    -

    - [14]   L. Getoor, N. Friedman, D. Koller, and B. Taskar. Learning - probabilistic models of relational structure. Journal of Machine Learning - Research, 3:679–707, December 2002. -

    -

    - [15]   David Poole. The independent choice logic for modelling multiple agents - under uncertainty. Artificial Intelligence, 94(1-2):7–56, 1997. - -

    -

    - [16]   Fabrizio Riguzzi. A top down interpreter for LPAD and CP-logic. In - Congress of the Italian Association for Artificial Intelligence, volume 4733 - of LNAI, pages 109–120. Springer, 2007. -

    -

    - [17]   Fabrizio Riguzzi. A top down interpreter for LPAD and CP-logic. - In Proceedings of the 14th RCRA workshop Experimental Evaluation of - Algorithms for Solving Problems with Combinatorial Explosion, 2007. -

    -

    - [18]   Fabrizio Riguzzi. Extended semantics and inference for the Independent - Choice Logic. Logic Journal of the IGPL, 17(6):589–629, 2009. -

    -

    - [19]   Fabrizio Riguzzi. MCINTYRE: A Monte Carlo algorithm for - probabilistic logic programming. In Proceedings of the 26th Italian - Conference on Computational Logic (CILC2011), Pescara, Italy, 31 - August-2 September, 2011, 2011. -

    -

    - [20]   Fabrizio Riguzzi and Nicola Di Mauro. Applying the information - bottleneck to statistical relational learning. Machine Learning, 2011. To - appear. -

    -

    - [21]   V. Santos Costa, D. Page, M. Qazi, and J. Cussens. CLP(BN): - Constraint logic programming for probabilistic knowledge. In Uncertainty - in Artificial Intelligence. Morgan Kaufmann, 2003. -

    -

    - [22]   J. Vennekens, M. Denecker, and M. Bruynooghe. Representing causal - information about a probabilistic process. In Proceedings of the 10th - European Conference on Logics in Artificial Intelligence, LNAI. Springer, - September 2006. -

    - -

    - [23]   J. Vennekens, Marc Denecker, and Maurice Bruynooghe. CP-logic: - A language of causal probabilistic events and its relation to logic - programming. Theory Pract. Log. Program., 9(3):245–308, 2009. -

    -

    - [24]   J. Vennekens and S. Verbaeten. Logic programs with annotated - disjunctions. Technical Report CW386, K. U. Leuven, 2003. -

    -

    - [25]   J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs - with annotated disjunctions. In International Conference on Logic - Programming, volume 3131 of LNCS, pages 195–209. Springer, 2004. + + + + + + + + cplint Manual + + + +

    + +

    Introduction

    +

    cplint is a suite of programs for reasoning with ICL [15], LPADs [22,25] and CP-logic programs [23,24]. It contains programs both for inference and learning.

    +

    cplint is available in two versions, one for Yap Prolog and one for SWI-Prolog. They differ slightly in the features offered. This manual is about the Yap version. You can find the manual for the SWI-Prolog version at http://ds.ing.unife.it/~friguzzi/software/cplint-swi/manual.html.

    +

    Installation

    +

    cplint is distributed in the source code development tree of Yap. It includes Prolog and C files. Download it by following the instruction in http://www.dcc.fc.up.pt/\string ~vsc/Yap/downloads.html.

    +

    cplint requires CUDD. You can download CUDD from ftp://vlsi.colorado.edu/pub/cudd-2.5.0.tar.gz.

    +

    Compile CUDD:

    +
      +

    1. decompress cudd-2.4.2.tar.gz

      2. +

    2. cd cudd-2.4.2

      3. +

    3. see the README file for instructions on compilation

      4. +
    +

    Install Yap together with cplint: when compiling Yap following the instruction of the INSTALL file in the root of the Yap folder, use

    +
    configure --enable-cplint=DIR
    +

    where DIR is the directory where CUDD is, i.e., the directory ending with cudd-2.5.0. Under Windows, you have to use Cygwin (CUDD does not compile under MinGW), so

    -
    - - +
    configure --enable-cplint=DIR --enable-cygwin
    +

    After having performed make install you can do make installcheck that will execute a suite of tests of the various programs. If no error is reported you have a working installation of cplint.

    +

    Syntax

    +

    LPAD and CP-logic programs consist of a set of annotated disjunctive clauses. Disjunction in the head is represented with a semicolon and atoms in the head are separated from probabilities by a colon. For the rest, the usual syntax of Prolog is used. For example, the CP-logic clause
    h1 : p1 ∨ … ∨ hn : pn â†â€„b1, …, bm, ¬c1, …, ¬cl
    is represented by

    +
    h1:p1 ; ... ; hn:pn :- b1,...,bm,\+ c1,....,\+ cl
    +

    No parentheses are necessary. The pi are numeric expressions. It is up to the user to ensure that the numeric expressions are legal, i.e. that they sum up to less than one.

    +

    If the clause has an empty body, it can be represented like this

    +
    h1:p1 ; ... ;hn:pn.
    +

    If the clause has a single head with probability 1, the annotation can be omitted and the clause takes the form of a normal prolog clause, i.e.

    +
    h1:- b1,...,bm,\+ c1,...,\+ cl.
    +

    stands for

    +
    h1:1 :- b1,...,bm,\+ c1,...,\+ cl.
    +

    The coin example of [25] is represented as (see file coin.cpl)

    +
    heads(Coin):1/2 ; tails(Coin):1/2:- 
+     toss(Coin),\+biased(Coin).
 
+heads(Coin):0.6 ; tails(Coin):0.4:- 
+     toss(Coin),biased(Coin).
 
+fair(Coin):0.9 ; biased(Coin):0.1.
 
+toss(coin).
    +

    The first clause states that if we toss a coin that is not biased it has equal probability of landing heads and tails. The second states that if the coin is biased it has a slightly higher probability of landing heads. The third states that the coin is fair with probability 0.9 and biased with probability 0.1 and the last clause states that we toss a coin with certainty.

    +

    Moreover, the bodies of rules can contain the built-in predicates:

    +
    is/2, >/2, </2, >=/2 ,=</2,
+=:=/2, =\=/2, true/0, false/0,
+=/2, ==/2, \=/2 ,\==/2, length/2
    +

    The bodies can also contain the following library predicates:

    +
    member/2, max_list/2, min_list/2
+nth0/3, nth/3
    +

    plus the predicate

    +
    average/2
    +

    that, given a list of numbers, computes its arithmetic mean.

    +

    The syntax of ICL program is the one used by the AILog 2 system.

    +

    Inference

    +

    cplint contains various modules for answering queries.

    +

    These modules answer queries using using goal-oriented procedures:

    +
      +

    • lpadsld.pl: uses the top-down procedure described in in [17] and [18]. It is based on SLDNF resolution and is an adaptation of the interpreter for ProbLog [11].

      +

      It was proved correct [18] with respect to the semantics of LPADs for range restricted acyclic programs [1] without function symbols.

      +

      It is also able to deal with extensions of LPADs and CP-logic: the clause bodies can contain setof and bagof, the probabilities in the head may be depend on variables in the body and it is possible to specify a uniform distribution in the head with reference to a setof or bagof operator. These extended features have been introduced in order to represent CLP(BN) [21] programs and PRM models [14]: setof and bagof allow to express dependency of an attribute from an aggregate function of another attribute, as in CLP(BN) and PRM, while the possibility of specifying a uniform distribution allows the use of the reference uncertainty feature of PRM.

      • +

    • picl.pl: performs inference on ICL programs [19]

      • +

    • lpad.pl: uses a top-down procedure based on SLG resolution [9]. As a consequence, it works for any sound LPADs, i.e., any LPAD such that each of its instances has a two valued well founded model.

      • +

    • cpl.pl: uses a top-down procedure based on SLG resolution and moreover checks that the CP-logic program is valid, i.e., that it has at least an execution model.

      • +

    • Modules for approximate inference:

      +
        +

      • deepit.pl performs iterative deepening [8]

        • +

      • deepdyn.pl performs dynamic iterative deepening [8]

        • +

      • bestk.pl performs k-Best [8]

        • +

      • bestfirst.pl performs best first [8]

        • +

      • montecarlo.pl performs Monte Carlo [8]

        • +

      • mcintyre.pl: implements the algorithm MCINTYRE (Monte Carlo INference wiTh Yap REcord) [20]

        • +
      • +

    • approx/exact.pl as lpadsld.pl but uses SimplecuddLPADs, a modification of the Simplecudd instead of the cplint library for building BDDs and computing the probability.

      • +
    +

    These modules answer queries using the definition of the semantics of LPADs and CP-logic:

    +
      +

    • semlpadsld.pl: given an LPAD P, it generates all the instances of P. The probability of a query Q is computed by identifying all the instances where Q is derivable by SLDNF resolution.

      • +

    • semlpad.pl: given an LPAD P, it generates all the instances of P. The probability of a query Q is computed by identifying all the instances where Q is derivable by SLG resolution.

      • +

    • semlcpl.pl: given an LPAD P, it builds an execution model of P, i.e., a probabilistic process that satisfy the principles of universal causation, sufficient causation, independent causation, no deus ex machina events and temporal precedence. It uses the definition of the semantics given in [24].

      • +
    +

    Commands

    +

    The LPAD or CP-logic program must be stored in a text file with extension .cpl. Suppose you have stored the example above in file coin.cpl. In order to answer queries from this program, you have to run Yap, load one of the modules (such as for example lpad.pl) by issuing the command

    +
    use_module(library(lpad)).
    +

    at the command prompt. Then you must parse the source file coin.cpl with the command

    +
    p(coin).
    +

    if coin.cpl is in the current directory, or

    +
    p('path_to_coin/coin').
    +

    if coin.cpl is in a different directory. At this point you can pose query to the program by using the predicate s/2 (for solve) that takes as its first argument a conjunction of goals in the form of a list and returns the computed probability as its second argument. For example, the probability of the conjunction head(coin),biased(coin) can be asked with the query

    +
    s([head(coin),biased(coin)],P).
    +

    For computing the probability of a conjunction given another conjunction you can use the predicate sc/3 (for solve conditional) that take takes as input the query conjunction as its first argument, the evidence conjunction as its second argument and returns the probability in its third argument. For example, the probability of the query heads(coin) given the evidence biased(coin) can be asked with the query

    +
    sc([heads(coin)],[biased(coin)],P).
    +

    After having parsed a program, in order to read in a new program you must restart Yap when using semlpadsld.pl and semlpad.pl. With the other modules, you can directly parse a new program.

    +

    When using lpad.pl, the system can print the message “Uunsound program†in the case in which an instance with a three valued well founded model is found. Moreover, it can print the message “It requires the choice of a head atom from a non ground headâ€: in this case, in order to answer the query, all the groundings of the culprit clause must be generated, which may be impossible for programs with function symbols.

    +

    When using semcpl.pl, you can print the execution process by using the command print. after p(file). Moreover, you can build an execution process given a context by issuing the command parse(file). and then build(context). where context is a list of atoms that are true in the context. semcpl.pl can print “Invalid program†in the case in which no execution process exists.

    +

    When using cpl.pl you can print a partial execution model including all the clauses involved in the query issued with print. cpl.pl can print the messages “Uunsound programâ€, “It requires the choice of a head atom from a non ground head†and “Invalid programâ€.

    +

    For approx/deepit.pl and approx/deepdyn.pl the command

    +
    solve(GoalsList, ProbLow, ProbUp, ResTime, BddTime)
    +

    takes as input a list of goals GoalsList and returns a lower bound on the probability ProbLow, an upper bound on the probability ProbUp, the CPU time spent on performing resolution ResTime and the CPU time spent on handling BDDs BddTime.

    +

    For approx/bestk.pl the command

    +
    solve(GoalsList, ProbLow,  ResTime, BddTime)
    +

    takes as input a list of goals GoalsList and returns a lower bound on the probability ProbLow, the CPU time spent on performing resolution ResTime and the CPU time spent on handling BDDs BddTime.

    +

    For approx/bestfirst.pl the command

    +
    solve(GoalsList, ProbLow, ProbUp, Count, ResTime, BddTime)
    +

    takes as input a list of goals GoalsList and returns a lower bound on the probability ProbLow, an upper bound on the probability ProbUp, the number of BDDs generated by the algorithm Count, the CPU time spent on performing resolution ResTime and the CPU time spent on handling BDDs BddTime.

    +

    For approx/montecarlo.pl the command

    +
    solve(GoalsList, Samples, Time, Low, Prob, Up)
    +

    takes as input a list of goals GoalsList and returns the number of samples taken Samples, the time required to solve the problem Time, the lower end of the confidence interval Lower, the estimated probability Prob and the upper end of the confidence interval Up.

    +

    For mcintyre.pl: the command

    +
    solve(Goals, Samples, CPUTime, WallTime, Lower, Prob, Upper) :-
    +

    takes as input a conjunction of goals Goals and returns the number of samples taken Samples, the CPU time required to solve the problem CPUTime, the wall time required to solve the problem CPUTime, the lower end of the confidence interval Lower, the estimated probability Prob and the upper end of the confidence interval Up.

    +

    For approx/exact.pl the command

    +
    solve(GoalsList, Prob, ResTime, BddTime)
    +

    takes as input a conjunction of goals Goals and returns the probability Prob, the CPU time spent on performing resolution ResTime and the CPU time spent on handling BDDs BddTime.

    +

    Parameters

    +

    The modules make use of a number of parameters in order to control their behavior. They that can be set with the command

    +
    set(parameter,value).
    +

    from the Yap prompt after having loaded the module. The current value can be read with

    +
    setting(parameter,Value).
    +

    from the Yap prompt. The available parameters are:

    +
      +

    • epsilon_parsing (valid for all modules): if (1 - the sum of the probabilities of all the head atoms) is smaller than epsilon_parsing then cplint adds the null events to the head. Default value 0.00001

      • +

    • save_dot (valid for all goal-oriented modules): if true a graph representing the BDD is saved in the file cpl.dot in the current directory in dot format. The variables names are of the form Xn_m where n is the number of the multivalued variable and m is the number of the binary variable. The correspondence between variables and clauses can be evinced from the message printed on the screen, such as

      +
      Variables: [(2,[X=2,X1=1]),(2,[X=1,X1=0]),(1,[])]
      +

      where the first element of each couple is the clause number of the input file (starting from 1). In the example above variable X0 corresponds to clause 2 with the substitutions X=2,X1=1, variable X1 corresponds to clause 2 with the substitutions X=1,X1=0 and variable X2 corresponds to clause 1 with the empty substitution. You can view the graph with graphviz using the command

      +
      dotty cpl.dot &
      • +

    • ground_body: (valid for lpadsld.pl and all semantic modules) determines how non ground clauses are treated: if true, ground clauses are obtained from a non ground clause by replacing each variable with a constant, if false, ground clauses are obtained by replacing only variables in the head with a constant. In the case where the body contains variables not in the head, setting it to false means that the body represents an existential event.

      • +

    • min_error: (valid for approx/deepit.pl, approx/deepdyn.pl, approx/bestk.pl, approx/bestfirst.pl, approx/montecarlo.pl and mcintyre.pl) is the threshold under which the difference between upper and lower bounds on probability must fall for the algorithm to stop.

      • +

    • k: maximum number of explanations for approx/bestk.pl and approx/bestfirst.pl and number of samples to take at each iteration for approx/montecarlo.pl and mcintyre.pl

      • +

    • prob_bound: (valid for approx/deepit.pl, approx/deepdyn.pl, approx/bestk.pl and approx/bestfirst.pl) is the initial bound on the probability of explanations when iteratively building explanations

      • +

    • prob_step: (valid for approx/deepit.pl, approx/deepdyn.pl, approx/bestk.pl and approx/bestfirst.pl) is the increment on the bound on the probability of explanations when iteratively building explanations

      • +

    • timeout: (valid for approx/deepit.pl, approx/deepdyn.pl, approx/bestk.pl, approx/bestfirst.pl and approx/exact.pl) timeout for builduing BDDs

      • +
    +

    Semantic Modules

    +

    The three semantic modules need to produce a grounding of the program in order to compute the semantics. They require an extra file with extension .uni (for universe) in the same directory where the .cpl file is.

    +

    There are two ways to specify how to ground a program. The first consists in providing the list of constants to which each variable can be instantiated. For example, in our case the current directory will contain a file coin.uni that is a Prolog file containing facts of the form

    +
    universe(var_list,const_list).
    +

    where var_list is a list of variables names (each must be included in single quotes) and const_list is a list of constants. The semantic modules generate the grounding by instantiating in all possible ways the variables of var_list with the constants of const_list. Note that the variables are identified by name, so a variable with the same name in two different clauses will be instantiated with the same constants.

    +

    The other way to specify how to ground a program consists in using mode and type information. For each predicate, the file .uni must contain a fact of the form

    +
    mode(predicate(t1,...,tn)).
    +

    that specifies the number and types of each argument of the predicate. Then, the list of constants that are in the domain of each type ti must be specified with a fact of the form

    +
    type(ti,list_of_constants).
    +

    The file .uni can contain both universe and mode declaration, the ones to be used depend on the value of the parameter grounding: with value variables, the universe declarations are used, with value modes the mode declarations are used.

    +

    With semcpl.pl only mode declarations can be used.

    +

    Extensions

    +

    In this section we will present the extensions to the syntax of LPADs and CP-logic programs that lpadsld can handle.

    +

    When using lpadsld.pl, the bodies can contain the predicates setof/3 and bagof/3 with the same meaning as in Prolog. Existential quantifiers are allowed in both, so for example the query

    +
    setof(Z, (term(X,Y))^foo(X,Y,Z), L).
    +

    returns all the instantiations of Z such that there exists an instantiation of X and Y for which foo(X,Y,Z) is true.

    +

    An example of the use of setof and bagof is in the file female.cpl:

    +
    male(C):M/P ; female(C):F/P:-
+    person(C),
+    setof(Male,known_male(Male),LM),
+    length(LM,M),
+    setof(Female,known_female(Female),LF),
+    length(LF,F),
+    P is F+M.
+
+person(f).
+
+known_female(a).
+known_female(b).
+known_female(c).
+known_male(d).
+known_male(e).
    +

    The disjunctive rule expresses the probability of a person of unknown sex of being male or female depending on the number of males and females that are known. This is an example of the use of expressions in the probabilities in the head that depend on variables in the body. The probabilities are well defined because they always sum to 1 (unless P is 0).

    +

    Another use of setof and bagof is to have an attribute depend on an aggregate function of another attribute, similarly to what is done in PRM and CLP(BN).

    +

    So, in the classical school example (available in student.cpl) you can find the following clauses:

    +
    student_rank(S,h):0.6 ; student_rank(S,l):0.4:- 
+    bagof(G,R^(registr_stu(R,S),registr_gr(R,G)),L),
+    average(L,Av),Av>1.5.
+
+student_rank(S,h):0.4 ; student_rank(S,l):0.6:- 
+    bagof(G,R^(registr_stu(R,S),registr_gr(R,G)),L),
+    average(L,Av),Av =< 1.5.
    +

    where registr_stu(R,S) expresses that registration R refers to student S and registr_gr(R,G) expresses that registration R reports grade G which is a natural number. The two clauses express a dependency of the rank of the student from the average of her grades.

    +

    Another extension can be used with lpadsld.pl in order to be able to represent reference uncertainty of PRMs. Reference uncertainty means that the link structure of a relational model is not fixed but is uncertain: this is represented by having the instance referenced in a relationship be chosen uniformly from a set. For example, consider a domain modeling scientific papers: you have a single entity, paper, and a relationship, cites, between paper and itself that connects the citing paper to the cited paper. To represent the fact that the cited paper and the citing paper are selected uniformly from certain sets, the following clauses can be used (see file paper_ref_simple.cpl):

    +
    uniform(cites_cited(C,P),P,L):-
+    bagof(Pap,paper_topic(Pap,theory),L).
+
+uniform(cites_citing(C,P),P,L):-
+    bagof(Pap,paper_topic(Pap,ai),L).
    +

    The first clauses states that the paper P cited in a citation C is selected uniformly from the set of all papers with topic theory. The second clauses expresses that the citing paper is selected uniformly from the papers with topic ai.

    +

    These clauses make use of the predicate

    +
    uniform(Atom,Variable,List)
    +

    in the head, where Atom must contain Variable. The meaning is the following: the set of all the atoms obtained by instantiating Variable of Atom with a term taken from List is generated and the head is obtained by having a disjunct for each instantiation with probability 1/N where N is the length of List.

    +

    A more elaborate example is present in file paper_ref.cpl:

    +
    uniform(cites_citing(C,P),P,L):-
+    setof(Pap,paper(Pap),L).
+
+cites_cited_group(C,theory):0.9 ; cites_cited_group(C,ai):0.1:-
+    cites_citing(C,P),paper_topic(P,theory).
+
+cites_cited_group(C,theory):0.01;cites_cited_group(C,ai):0.99:-
+    cites_citing(C,P),paper_topic(P,ai).
+
+uniform(cites_cited(C,P),P,L):-
+    cites_cited_group(C,T),bagof(Pap,paper_topic(Pap,T),L).
    +

    where the cited paper depends on the topic of the citing paper. In particular, if the topic is theory, the cited paper is selected uniformly from the papers about theory with probability 0.9 and from the papers about ai with probability 0.1. if the topic is ai, the cited paper is selected uniformly from the papers about theory with probability 0.01 and from the papers about ai with probability 0.99.

    +

    PRMs take into account as well existence uncertainty, where the existence of instances is also probabilistic. For example, in the paper domain, the total number of citations may be unknown and a citation between any two paper may have a probability of existing. For example, a citation between two paper may be more probable if they are about the same topic:

    +
    cites(X,Y):0.005 :- 
+    paper_topic(X,theory),paper_topic(Y,theory).
+
+cites(X,Y):0.001 :- 
+    paper_topic(X,theory),paper_topic(Y,ai).
+
+cites(X,Y):0.003 :- 
+    paper_topic(X,ai),paper_topic(Y,theory).
+
+cites(X,Y):0.008 :- 
+    paper_topic(X,ai),paper_topic(Y,ai).
    +

    This is an example where the probabilities in the head do not sum up to one so the null event is automatically added to the head. The first clause states that, if the topic of a paper X is theory and of paper Y is theory, there is a probability of 0.005 that there is a citation from X to Y. The other clauses consider the remaining cases for the topics.

    +

    Files

    +

    In the directory where Yap keeps the library files (usually /usr/local/share/ Yap) you can find the directory cplint that contains the files:

    +
      +

    • testlpadsld_gbtrue.pl, testlpadsld_gbfalse.pl, testlpad.pl, testcpl.pl, testsemlpadsld.pl, testsemlpad.pl testsemcpl.pl: Prolog programs for testing the modules. They are executed when issuing the command make installcheck during the installation. To execute them afterwords, load the file and issue the command t.

      • +

    • Subdirectory examples:

      +
        +

      • alarm.cpl: representation of the Bayesian network in Figure 2 of [25].

        • +

      • coin.cpl: coin example from [25].

        • +

      • coin2.cpl: coin example with two coins.

        • +

      • dice.cpl: dice example from [25].

        • +

      • twosideddice.cpl, threesideddice.cpl game with idealized dice with two or three sides. Used in the experiments in [18].

        • +

      • ex.cpl: first example in [18].

        • +

      • exapprox.cpl: example showing the problems of approximate inference (see [18]).

        • +

      • exrange.cpl: example showing the problems with non range restricted programs (see [18]).

        • +

      • female.cpl: example showing the dependence of probabilities in the head from variables in the body (from [25]).

        • +

      • mendel.cpl, mendels.cpl: programs describing the Mendelian rules of inheritance, taken from [7].

        • +

      • paper_ref.cpl, paper_ref_simple.cpl: paper citations examples, showing reference uncertainty, inspired by [14].

        • +

      • paper_ref_not.cpl: paper citations example showing that negation can be used also for predicates defined by clauses with uniform in the head.

        • +

      • school.cpl: example inspired by the example school_32.yap from the source distribution of Yap in the CLPBN directory.

        • +

      • school_simple.cpl: simplified version of school.cpl.

        • +

      • student.cpl: student example from Figure 1.3 of [13].

        • +

      • win.cpl, light.cpl, trigger.cpl, throws.cpl, hiv.cpl,
        + invalid.cpl: programs taken from [24]. invalid.cpl is an example of a program that is invalid but sound.

        • +
      +

      The files *.uni that are present for some of the examples are used by the semantical modules. Some of the example files contain in an initial comment some queries together with their result.

      • +

    • Subdirectory doc: contains this manual in latex, html and pdf.

      • +
    +

    Learning

    +

    cplint contains the following learning algorithms:

    +
      +

    • CEM (cplint EM): an implementation of EM for learning parameters that is based on lpadsld.pl [16]

      • +

    • RIB (Relational Information Bottleneck): an algorithm for learning parameters based on the Information Bottleneck [16]

      • +

    • EMBLEM (EM over Bdds for probabilistic Logic programs Efficient Mining): an implementation of EM for learning parameters that computes expectations directly on BDDs [2,3,5]

      • +

    • SLIPCASE (Structure LearnIng of ProbabilistiC logic progrAmS with Em over bdds): an algorithm for learning the structure of programs by searching directly the theory space [4]

      • +

    • SLIPCOVER (Structure LearnIng of Probabilistic logic programs by searChing OVER the clause space): an algorithm for learning the structure of programs by searching the clause space and the theory space separatery [6]

      • +

    • LEMUR (LEarning with a Monte carlo Upgrade of tRee search): an algorithm for learning the structure of programs by searching the clase space using Monte-Carlo tree search.

      • +
    +

    Input

    +

    To execute the learning algorithms, prepare four files in the same folder:

    +
      +

    • <stem>.kb: contains the example interpretations

      • +

    • <stem>.bg: contains the background knowledge, i.e., knowledge valid for all interpretations

      • +

    • <stem>.l: contains language bias information

      • +

    • <stem>.cpl: contains the LPAD for you which you want to learn the parameters or the initial LPAD for SLIPCASE and LEMUR. For SLIPCOVER, this file should be absent

      • +
    +

    where <stem> is your dataset name. Examples of these files can be found in the dataset pages.

    +

    In <stem>.kb the example interpretations have to be given as a list of Prolog facts initiated by begin(model(<name>)). and terminated by end(model(<name>)). as in

    +
    begin(model(b1)).
+sameperson(1,2).
+movie(f1,1).
+movie(f1,2).
+workedunder(1,w1).
+workedunder(2,w1).
+gender(1,female).
+gender(2,female).
+actor(1).
+actor(2).
+end(model(b1)).
    +

    The interpretations may contain a fact of the form

    +
    prob(0.3).
    +

    assigning a probability (0.3 in this case) to the interpretations. If this is omitted, the probability of each interpretation is considered equal to 1/n where n is the total number of interpretations. prob/1 can be used to set different multiplicity for the different interpretations.

    +

    In order for RIB to work, the input interpretations must share the Herbrand universe. If this is not the case, you have to translate the interpretations in this was, see for example the sp1 files in RIB’s folder, that are the results of the conversion of the first fold of the IMDB dataset.

    +

    <stem>.bg can contain Prolog clauses that can be used to derive additional conclusions from the atoms in the interpretations.

    +

    <stem>.l contains the declarations of the input and output predicates, of the unseen predicates and the commands for setting the algorithms’ parameters. Output predicates are declared as

    +
    output(<predicate>/<arity>).
    +

    and define the predicates whose atoms in the input interpretations are used as the goals for the prediction of which you want to optimize the parameters. Derivations for these goals are built by the systems.

    +

    Input predicates are those for the predictions of which you do not want to optimize the parameters. You can declare closed world input predicates with

    +
    input_cw(<predicate>/<arity>).
    +

    For these predicates, the only true atoms are those in the interpretations, the clauses in the input program are not used to derive atoms not present in the interpretations.

    +

    Open world input predicates are declared with

    +
    input(<predicate>/<arity>).
    +

    In this case, if a subgoal for such a predicate is encountered when deriving the atoms for the output predicates, both the facts in the interpretations and the clauses of the input program are used.

    +

    For RIB, if there are unseen predicates, i.e., predicates that are present in the input program but not in the interpretations, you have to declare them with

    +
    unseen(<predicate>/<arity>).
    +

    For SLIPCASE, SLIPCOVER and LEMUR, you have to specify the language bias by means of mode declarations in the style of Progol.

    +
    modeh(<recall>,<predicate>(<arg1>,...).
    +

    specifies the atoms that can appear in the head of clauses, while

    +
    modeb(<recall>,<predicate>(<arg1>,...).
    +

    specifies the atoms that can appear in the body of clauses. <recall> can be an integer or * (currently unused).

    +

    The arguments are of the form

    +
    +<type>
    +

    for specifying an input variable of type <type>, or

    +
    -<type>
    +

    for specifying an output variable of type <type>. or

    +
    <constant>
    +

    for specifying a constant.

    +

    SLIPCOVER also allows the arguments

    +
    #<type>
    +

    for specifying an argument which should be replaced by a constant of type <type> in the bottom clause but should not be used for replacing input variables of the following literals or

    +
    -#<type>
    +

    for specifying an argument which should be replaced by a constant of type <type> in the bottom clause and that should be used for replacing input variables of the following literals. # and -# differ only in the creation of the bottom clause.

    +

    An example of language bias for the UWCSE domain is

    +
    output(advisedby/2).
+
+input(student/1).
+input(professor/1).
+....
+
+modeh(*,advisedby(+person,+person)). 
+
+modeb(*,professor(+person)).
+modeb(*,student(+person)).
+modeb(*,sameperson(+person, -person)). 
+modeb(*,sameperson(-person, +person)). 
+modeb(*,samecourse(+course, -course)). 
+modeb(*,samecourse(-course, +course)). 
+....
    +

    SLIPCOVER and LEMUR lso requires facts for the determination/2 predicate that indicate which predicates can appear in the body of clauses. For example

    +
    determination(professor/1,student/1).
+determination(student/1,hasposition/2).
    +

    state that student/1 can appear in the body of clauses for professor/1 and that hasposition/2 can appear in the body of clauses for student/1.

    +

    SLIPCOVER also allows mode declarations of the form

    +
    modeh(<r>,[<s1>,...,<sn>],[<a1>,...,<an>],[<P1/Ar1>,...,<Pk/Ark>]).
    +

    These mode declarations are used to generate clauses with more than two head atoms. In them, <s1>,...,<sn> are schemas, <a1>,...,<an> are atoms such that <ai> is obtained from $\verb|<si>|$ by replacing placemarkers with variables, <Pi/Ari> are the predicates admitted in the body. <a1>,...,<an> are used to indicate which variables should be shared by the atoms in the head. An example of such a mode declaration is

    +
    modeh(*,
+  [advisedby(+person,+person),tempadvisedby(+person,+person)],
+  [advisedby(A,B),tempadvisedby(A,B)],
+  [professor/1,student/1,hasposition/2,inphase/2,
+      publication/2,taughtby/3,ta/3,courselevel/2,yearsinprogram/2]).
    +

    Parameters

    +

    In order to set the algorithms’ parameters, you have to insert in <stem>.l commands of the form

    +
    :- set(<parameter>,<value>).
    +

    The available parameters are:

    +
      +

    • depth (values: integer or inf, default value: 3): depth of derivations if depth_bound is set to true

      • +

    • single_var (values: {true,false}, default value: false, valid for CEM, EMBLEM, SLIPCASE, SLIPCOVER and LEMUR): if set to true, there is a random variable for each clauses, instead of a separate random variable for each grounding of a clause

      • +

    • sample_size (values: integer, default value: 1000): total number of examples in case in which the models in the .kb file contain a prob(P). fact. In that case, one model corresponds to sample_size*P examples

      • +

    • epsilon_em (values: real, default value: 0.1, valid for CEM, EMBLEM, SLIPCASE, SLIPCOVER and LEMUR): if the difference in the log likelihood in two successive EM iteration is smaller than epsilon_em, then EM stops

      • +

    • epsilon_em_fraction (values: real, default value: 0.01, valid for CEM, EMBLEM, SLIPCASE, SLIPCOVER and LEMUR): if the difference in the log likelihood in two successive EM iteration is smaller than epsilon_em_fraction*(-current log likelihood), then EM stops

      • +

    • iter (values: integer, defualt value: 1, valid for EMBLEM, SLIPCASE, SLIPCOVER and LEMUR): maximum number of iteration of EM parameter learning. If set to -1, no maximum number of iterations is imposed

      • +

    • iterREF (values: integer, defualt value: 1, valid for SLIPCASE, SLIPCOVER and LEMUR): maximum number of iteration of EM parameter learning for refinements. If set to -1, no maximum number of iterations is imposed.

      • +

    • random_restarts_number (values: integer, default value: 1, valid for CEM, EMBLEM, SLIPCASE, SLIPCOVER and LEMUR): number of random restarts of EM learning

      • +

    • random_restarts_REFnumber (values: integer, default value: 1, valid for SLIPCASE, SLIPCOVER and LEMUR): number of random restarts of EM learning for refinements

      • +

    • setrand (values: rand(integer,integer,integer)): seed for the random functions, see Yap manual for allowed values

      • +

    • minimal_step (values: [0,1], default value: 0.005, valid for RIB): minimal increment of γ

      • +

    • maximal_step (values: [0,1], default value: 0.1, valid for RIB): maximal increment of γ

      • +

    • logsize_fraction (values: [0,1], default value 0.9, valid for RIB): RIB stops when I(CH, T; Y) is above logsize_fraction times its maximum value (log|CH, T|, see [12])

      • +

    • delta (values: negative integer, default value -10, valid for RIB): value assigned to log0

      • +

    • epsilon_fraction (values: integer, default value 100, valid for RIB): in the computation of the step, the value of ϵ of [12] is obtained as log|CH, T|×epsilon_fraction

      • +

    • max_rules (values: integer, default value: 6000, valid for RIB and SLIPCASE): maximum number of ground rules. Used to set the size of arrays for storing internal statistics. Can be increased as much as memory allows.

      • +

    • logzero (values: negative real, default value log(0.000001), valid for SLIPCASE, SLIPCOVER and LEMUR): value assigned to log0

      • +

    • examples (values: atoms,interpretations, default value atoms, valid for SLIPCASE): determines how BDDs are built: if set to interpretations, a BDD for the conjunction of all the atoms for the target predicates in each interpretations is built. If set to atoms, a BDD is built for the conjunction of a group of atoms for the target predicates in each interpretations. The number of atoms in each group is determined by the parameter group

      • +

    • group (values: integer, default value: 1, valid for SLIPCASE): number of target atoms in the groups that are used to build BDDs

      • +

    • nax_iter (values: integer, default value: 10, valid for SLIPCASE and SLIPCOVER): number of interations of beam search

      • +

    • max_var (values: integer, default value: 1, valid for SLIPCASE, SLIPCOVER and LEMUR): maximum number of distinct variables in a clause

      • +

    • verbosity (values: integer in [1,3], default value: 1): level of verbosity of the algorithms

      • +

    • beamsize (values: integer, default value: 20, valid for SLIPCASE and SLIPCOVER): size of the beam

      • +

    • mcts_beamsize (values: integer, default value: 3, valid for LEMUR): size of the MCTS beam

      • +

    • mcts_visits (values: integer, default value: +inf, valid for LEMUR): maximum number of visits (Nicola controlla)

      • +

    • megaex_bottom (values: integer, default value: 1, valid for SLIPCOVER): number of mega-examples on which to build the bottom clauses

      • +

    • initial_clauses_per_megaex (values: integer, default value: 1, valid for SLIPCOVER): number of bottom clauses to build for each mega-example

      • +

    • d (values: integer, default value: 10000, valid for SLIPCOVER): number of saturation steps when building the bottom clause

      • +

    • max_iter_structure (values: integer, default value: 1, valid for SLIPCOVER): maximum number of theory search iterations

      • +

    • background_clauses (values: integer, default value: 50, valid for SLIPCOVER): maximum numbers of background clauses

      • +

    • maxdepth_var (values: integer, default value: 2, valid for SLIPCOVER and LEMUR): maximum depth of variables in clauses (as defined in [10]).

      • +

    • score (values: ll, aucpr, default value ll, valid for SLIPCOVER): determines the score function for refinement: if set to ll, log likelihood is used, if set to aucpr, the area under the Precision-Recall curve is used.

      • +
    +

    Commands

    +

    To execute CEM, load em.pl with

    +
    ?:- use_module(library('cplint/em')).
    +

    and call:

    +
    ?:- em(stem).
    +

    To execute RIB, load rib.pl with

    +
    ?:- use_module(library('cplint/rib')).
    +

    and call:

    +
    ?:- ib_par(stem).
    +

    To execute EMBLEM, load slipcase.pl with

    +
    ?:- use_module(library('cplint/slipcase')).
    +

    and call

    +
    ?:- em(stem).
    +

    To execute SLIPCASE, load slipcase.pl with

    +
    ?:- use_module(library('cplint/slipcase')).
    +

    and call

    +
    ?:- sl(stem).
    +

    To execute SLIPCOVER, load slipcover.pl with

    +
    ?:- use_module(library('cplint/slipcover')).
    +

    and call

    +
    ?:- sl(stem).
    +

    To execute LEMUR, load lemur.pl with

    +
    ?:- use_module(library('cplint/lemur')).
    +

    and call

    +
    ?:- "mcts(stem,depth,c,iter,rules,covering)
    +

    where depth (integer) is the maximum number of random specialization steps in the default policy, C (real) is the value of the MCTS C constant, iter (integer) is the number of UCT rounds, rules (integer) is the maximum number of clauses to be learned and covering (Boolean) dentoes whether the search is peformed in the space of clauses (true) or theories (false) (Nicola controlla).

    +

    Testing

    +

    To test the theories learned, load test.pl with

    +
    ?:- use_module(library('cplint/test')).
    +

    and call

    +
    ?:- main([<stem_fold1>,...,<stem_foldn>],[<testing_set_fold1>,...,
+  <testing_set_foldn>]).
    +

    For example, if you want to test the theory in ai_train.rules on the set ai.kb, you can call

    +
    ?:- main([ai_train],[ai]).
    +

    The testing program has the following parameter:

    +
      +

    • neg_ex (values: given, cw, default value: cw): if set to given, the negative examples are taken from <testing_set_foldi>.kb, i.e., those example ex stored as neg(ex); if set to cw, the negative examples are generated according to the closed world assumption, i.e., all atoms for target predicates that are not positive examples. The set of all atoms is obtained by collecting the set of constants for each type of the arguments of the target predicate.

      • +
    +

    The testing program produces the following output in the current folder:

    +
      +

    • cll.pl: for each fold, the list of examples orderd by their probability of being true

      • +

    • areas.csv: the areas under the Precision-Recall curve and the Receiver Operating Characteristic curve

      • +

    • curve_roc.m: a Matlab file for plotting the Receiver Operating Characteristic curve

      • +

    • curve_pr.m: a Matlab file for plotting the Precision-Recall curve

      • +
    +

    Learning Examples

    +

    The subfolders em, rib, slipcase and slipcover of the packages/cplint folder in Yap git distribution contain examples of input and output files for the learning algorithms.

    +

    License

    +

    cplint, as Yap, follows the Artistic License 2.0 that you can find in Yap CVS root dir. The copyright is by Fabrizio Riguzzi.

    +

    The modules in the approx subdirectory use SimplecuddLPADs, a modification of the Simplecudd library whose copyright is by Katholieke Universiteit Leuven and that follows the Artistic License 2.0.

    +

    Some modules use the library CUDD for manipulating BDDs that is included in glu. For the use of CUDD, the following license must be accepted:

    +

    Copyright (c) 1995-2004, Regents of the University of Colorado

    +

    All rights reserved.

    +

    Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

    +
      +

    • Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

      • +

    • Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

      • +

    • Neither the name of the University of Colorado nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

      • +
    +

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
    +AND CONTRIBUTORS “AS IS†AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAU-SED
    +AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    +

    lpad.pl, semlpad.pl and cpl.pl are based on the SLG system by Weidong Chen and David Scott Warren, Copyright (C) 1993 Southern Methodist University, 1993 SUNY at Stony Brook, see the file COYPRIGHT_SLG for detailed information on this copyright.

    +
    +
    +

    1. K. R. Apt and M. Bezem. 1991. Acyclic programs. New Gener. Comput. 9, 3/4: 335–364.

    +
    +
    +

    2. Elena Bellodi and Fabrizio Riguzzi. 2011. EM over binary decision diagrams for probabilistic logic programs. Proceedings of the 26th italian conference on computational logic (CILC2011), pescara, italy, 31 august 31-2 september, 2011. Retrieved from http://www.ing.unife.it/docenti/FabrizioRiguzzi/Papers/BelRig-CILC11.pdf

    +
    +
    +

    3. Elena Bellodi and Fabrizio Riguzzi. 2011. EM over binary decision diagrams for probabilistic logic programs. Dipartimento di Ingegneria, Università di Ferrara, Italy. Retrieved from http://www.unife.it/dipartimento/ingegneria/informazione/informatica/rapporti-tecnici-1/CS-2011-01.pdf/view

    +
    +
    +

    4. Elena Bellodi and Fabrizio Riguzzi. 2011. Learning the structure of probabilistic logic programs. Inductive logic programming, 21th international conference, iLP 2011, london, uK, 31 july-3 august, 2011. Retrieved from http://ilp11.doc.ic.ac.uk/short_papers/ilp2011_submission_52.pdf

    +
    +
    +

    5. Elena Bellodi and Fabrizio Riguzzi. 2012. Expectation Maximization over binary decision diagrams for probabilistic logic programs. Intel. Data Anal. 16, 6.

    +
    +
    +

    6. Elena Bellodi and Fabrizio Riguzzi. 2013. Structure learning of probabilistic logic programs by searching the clause space. Theory and Practice of Logic Programming.

    +
    +
    +

    7. H. Blockeel. 2004. Probabilistic logical models for mendel’s experiments: An exercise. Inductive logic programming (ILP 2004), work in progress track.

    +
    +
    +

    8. Stefano Bragaglia and Fabrizio Riguzzi. 2011. Approximate inference for logic programs with annotated disjunctions. Inductive logic programming 20th international conference, iLP 2010, florence, italy, june 27-30, 2010. revised papers, Springer, 30–37. http://doi.org/10.1007/978-3-642-21295-6_7

    +
    +
    +

    9. Weidong Chen and David Scott Warren. 1996. Tabled evaluation with delaying for general logic programs. jacm 43, 1: 20–74.

    +
    +
    +

    10. William W. Cohen. 1995. Pac-learning non-recursive prolog clauses. Artif. Intell. 79, 1: 1–38.

    +
    +
    +

    11. L. De Raedt, A. Kimmig, and H. Toivonen. 2007. ProbLog: A probabilistic Prolog and its application in link discovery. International joint conference on artificial intelligence, 2462–2467.

    +
    +
    +

    12. G. Elidan and N. Friedman. 2005. Learning hidden variable networks: The information bottleneck approach. Journal of Machine Learning Research 6: 81–127.

    +
    +
    +

    13. L. Getoor, N. Friedman, D. Koller, and A. Pfeffer. 2001. Learning probabilistic relational models. In Relational data mining, Saso Dzeroski and Nada Lavrac (eds.). Springer-Verlag, Berlin.

    +
    +
    +

    14. L. Getoor, N. Friedman, D. Koller, and B. Taskar. 2002. Learning probabilistic models of relational structure. Journal of Machine Learning Research 3: 679–707.

    +
    +
    +

    15. David Poole. 1997. The independent choice logic for modelling multiple agents under uncertainty. Artificial Intelligence 94, 1-2: 7–56.

    +
    +
    +

    16. Fabrizio Riguzzi and Nicola Di Mauro. 2011. Applying the information bottleneck to statistical relational learning. Machine Learning. http://doi.org/10.1007/s10994-011-5247-6

    +
    +
    +

    17. Fabrizio Riguzzi. 2007. A top down interpreter for LPAD and CP-logic. Congress of the italian association for artificial intelligence, Springer, 109–120. http://doi.org/10.1007/978-3-540-74782-6\string_11

    +
    +
    +

    18. Fabrizio Riguzzi. 2007. A top down interpreter for LPAD and CP-logic. Proceedings of the 14th rCRA workshop experimental evaluation of algorithms for solving problems with combinatorial explosion.

    +
    +
    +

    19. Fabrizio Riguzzi. 2009. Extended semantics and inference for the Independent Choice Logic. Logic Journal of the IGPL 17, 6: 589–629. http://doi.org/10.1093/jigpal/jzp025

    +
    +
    +

    20. Fabrizio Riguzzi. 2011. MCINTYRE: A Monte Carlo algorithm for probabilistic logic programming. Proceedings of the 26th italian conference on computational logic (CILC2011), pescara, italy, 31 august-2 september, 2011. Retrieved from http://www.ing.unife.it/docenti/FabrizioRiguzzi/Papers/Rig-CILC11.pdf

    +
    +
    +

    21. V. Santos Costa, D. Page, M. Qazi, and J. Cussens. 2003. CLP(ℬð’©): Constraint logic programming for probabilistic knowledge. Uncertainty in artificial intelligence, Morgan Kaufmann.

    +
    +
    +

    22. J. Vennekens and S. Verbaeten. 2003. Logic programs with annotated disjunctions. K. U. Leuven. Retrieved from http://www.cs.kuleuven.ac.be/\string~joost/techrep.ps

    +
    +
    +

    23. J. Vennekens, M. Denecker, and M. Bruynooghe. 2006. Representing causal information about a probabilistic process. Proceedings of the 10th european conference on logics in artificial intelligence, Springer.

    +
    +
    +

    24. J. Vennekens, Marc Denecker, and Maurice Bruynooghe. 2009. CP-logic: A language of causal probabilistic events and its relation to logic programming. Theory Pract. Log. Program. 9, 3: 245–308.

    +
    +
    +

    25. J. Vennekens, S. Verbaeten, and M. Bruynooghe. 2004. Logic programs with annotated disjunctions. International conference on logic programming, Springer, 195–209.

    +
    +
    + + diff --git a/packages/cplint/doc/manual.pdf b/packages/cplint/doc/manual.pdf index 5771d7bcc..adde428d6 100644 Binary files a/packages/cplint/doc/manual.pdf and b/packages/cplint/doc/manual.pdf differ diff --git a/packages/cplint/doc/manual.tex b/packages/cplint/doc/manual.tex index d5b8e340e..8f7720b1a 100644 --- a/packages/cplint/doc/manual.tex +++ b/packages/cplint/doc/manual.tex @@ -1,23 +1,24 @@ -\ifnum\pdfoutput>0 % pdflatex compilation -\documentclass[a4paper,10pt]{article} +%\ifnum\pdfoutput>0 % pdflatex compilation +\documentclass[a4paper,10pt]{scrartcl} \usepackage[pdftex]{graphicx} \DeclareGraphicsExtensions{.pdf,.png,.jpg} \RequirePackage[hyperindex]{hyperref} -\else % htlatex compilation -\documentclass{article} -\usepackage{graphicx} -\DeclareGraphicsExtensions{.png, .gif, .jpg} -\newcommand{\href}[2]{\Link[#1]{}{} #2 \EndLink} -\newcommand{\hypertarget}[2]{\Link[]{}{#1} #2 \EndLink} -\newcommand{\hyperlink}[2]{\Link[]{#1}{} #2 \EndLink} -\newcommand{\url}[1]{\Link[#1]{}{} #1 \EndLink} -\fi +%\else % htlatex compilation +%\documentclass{article} +%\usepackage{graphicx} +%\DeclareGraphicsExtensions{.png, .gif, .jpg} +%\newcommand{\href}[2]{\Link[#1]{}{} #2 \EndLink} +%\newcommand{\hypertarget}[2]{\Link[]{}{#1} #2 \EndLink} +%\newcommand{\hyperlink}[2]{\Link[]{#1}{} #2 \EndLink} +%\newcommand{\url}[1]{\Link[#1]{}{} #1 \EndLink} +%\fi \begin{document} \title{\texttt{cplint} Manual} +\subtitle{Yap Version} \author{Fabrizio Riguzzi\\ fabrizio.riguzzi@unife.it} @@ -30,8 +31,11 @@ fabrizio.riguzzi@unife.it} \texttt{cplint} is a suite of programs for reasoning with ICL \cite{DBLP:journals/ai/Poole97}, LPADs \cite{VenVer03-TR,VenVer04-ICLP04-IC} and CP-logic programs \cite{VenDenBru-JELIA06,DBLP:journals/tplp/VennekensDB09}. It contains programs both for inference and learning. +\texttt{cplint} is available in two versions, one for Yap Prolog and one for SWI-Prolog. They differ slightly in the features offered. +This manual is about the Yap version. You can find the manual for the SWI-Prolog version at \url{http://ds.ing.unife.it/~friguzzi/software/cplint-swi/manual.html}. + \section{Installation} -\texttt{cplint} is distributed in source code in the source code development tree of Yap. It includes Prolog and C files. Download it by following the instruction in \url{http://www.dcc.fc.up.pt/\string ~vsc/Yap/downloads.html}. +\texttt{cplint} is distributed in the source code development tree of Yap. It includes Prolog and C files. Download it by following the instruction in \url{http://www.dcc.fc.up.pt/\string ~vsc/Yap/downloads.html}. \texttt{cplint} requires \href{http://vlsi.colorado.edu/\string ~fabio/CUDD/}{CUDD}. You can download CUDD from \url{ftp://vlsi.colorado.edu/pub/cudd-2.5.0.tar.gz}. diff --git a/packages/cplint/doc/manual0x.png b/packages/cplint/doc/manual0x.png deleted file mode 100644 index 395c9bc8d..000000000 Binary files a/packages/cplint/doc/manual0x.png and /dev/null differ diff --git a/packages/cuda/CMakeLists.txt b/packages/cuda/CMakeLists.txt index 7fe5fd97c..01f344995 100644 --- a/packages/cuda/CMakeLists.txt +++ b/packages/cuda/CMakeLists.txt @@ -90,6 +90,7 @@ endif( THRUST_INCLUDE_DIR ) install(TARGETS libcuda LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) install(FILES ${PL_SOURCES} diff --git a/packages/gecode/CMakeLists.txt b/packages/gecode/CMakeLists.txt index 8c1959d6c..a74e68b1b 100644 --- a/packages/gecode/CMakeLists.txt +++ b/packages/gecode/CMakeLists.txt @@ -46,6 +46,7 @@ if (GECODE_FOUND) install(TARGETS gecode_yap LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) install(FILES gecode.yap @@ -57,3 +58,4 @@ if (GECODE_FOUND) ) endif (GECODE_FOUND) + diff --git a/packages/jpl/CMakeLists.txt b/packages/jpl/CMakeLists.txt index fe41449cb..0e8f95591 100644 --- a/packages/jpl/CMakeLists.txt +++ b/packages/jpl/CMakeLists.txt @@ -3,9 +3,10 @@ set (JPL_SOURCES src/c/jpl.c) -macro_optional_find_package(Java ON) -find_package(Java COMPONENTS Development) -#find_package(Java COMPONENTS Runtime) +find_package(Java COMPONENTS Runtime Development) +# find_package(Java COMPONENTS Development) +# find_package(Java COMPONENTS Runtime) +#find_package(JavaLibs) macro_log_feature (Java_Development_FOUND "Java" "Use Java System" "http://www.java.org" FALSE) @@ -53,5 +54,4 @@ if (Java_Development_FOUND) DESTINATION ${libpl} ) - endif (Java_Development_FOUND) diff --git a/packages/myddas/mysql/CMakeLists.txt b/packages/myddas/mysql/CMakeLists.txt index 551f31e6d..c8318b8f9 100644 --- a/packages/myddas/mysql/CMakeLists.txt +++ b/packages/myddas/mysql/CMakeLists.txt @@ -33,6 +33,7 @@ set_target_properties (Yapmysql PROPERTIES install(TARGETS Yapmysql LIBRARY DESTINATION ${libdir} + ARCHIVE DESTINATION ${libdir} ) else() diff --git a/packages/myddas/odbc/CMakeLists.txt b/packages/myddas/odbc/CMakeLists.txt index 3969acbc9..fb0701890 100644 --- a/packages/myddas/odbc/CMakeLists.txt +++ b/packages/myddas/odbc/CMakeLists.txt @@ -34,5 +34,6 @@ set_target_properties (Yapodbc PROPERTIES install(TARGETS Yapodbc LIBRARY DESTINATION ${libdir} + ARCHIVE DESTINATION ${libdir} ) diff --git a/packages/myddas/postgres/CMakeLists.txt b/packages/myddas/postgres/CMakeLists.txt index 3aab6b082..a47f0e1fb 100644 --- a/packages/myddas/postgres/CMakeLists.txt +++ b/packages/myddas/postgres/CMakeLists.txt @@ -30,6 +30,7 @@ if (PostgreSQL_FOUND) install(TARGETS Yappostgres LIBRARY DESTINATION ${libdir} + ARCHIVE DESTINATION ${libdir} ) else() add_definitions (-DMYDDAS_PostgreSQL=0) diff --git a/packages/myddas/sqlite3/CMakeLists.txt b/packages/myddas/sqlite3/CMakeLists.txt index 0e4ce7186..578cd6aac 100644 --- a/packages/myddas/sqlite3/CMakeLists.txt +++ b/packages/myddas/sqlite3/CMakeLists.txt @@ -26,6 +26,7 @@ if (SQLITE3_FOUND) install(TARGETS Yapsqlite3 LIBRARY DESTINATION ${libdir} - ) + ARCHIVE DESTINATION ${libdir} + ) endif (SQLITE3_FOUND) diff --git a/packages/python/CMakeLists.txt b/packages/python/CMakeLists.txt index 54955ac55..9d962b05c 100644 --- a/packages/python/CMakeLists.txt +++ b/packages/python/CMakeLists.txt @@ -53,7 +53,8 @@ if (PYTHONLIBS_FOUND) # PYTHONLIBS_FOUND - have the Python l install(TARGETS libpython LIBRARY DESTINATION ${dlls} - ) + ARCHIVE DESTINATION ${dlls} + ) install(FILES python.pl DESTINATION ${libpl} diff --git a/packages/raptor/CMakeLists.txt b/packages/raptor/CMakeLists.txt index a72a9f8c4..8b0e35df6 100644 --- a/packages/raptor/CMakeLists.txt +++ b/packages/raptor/CMakeLists.txt @@ -59,7 +59,8 @@ INCLUDE_DIRECTORIES( install(TARGETS libxml2 LIBRARY DESTINATION ${dlls} - ) + ARCHIVE DESTINATION ${dlls} + ) INSTALL(FILES xml2.yap DESTINATION ${libpl}) @@ -106,6 +107,8 @@ IF (RAPTOR_FOUND) install(TARGETS raptor LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} + ) INSTALL(FILES raptor.yap DESTINATION ${libpl}) diff --git a/packages/real/CMakeLists.txt b/packages/real/CMakeLists.txt index 000992097..87f876235 100644 --- a/packages/real/CMakeLists.txt +++ b/packages/real/CMakeLists.txt @@ -3,11 +3,11 @@ PROJECT ( YAP_REAL C ) macro_optional_find_package (R ON) - macro_log_feature (R_HOME "R" + macro_log_feature (R_FOUND "R" "Use R Environment" "http://www.r.org" FALSE) -if (R_HOME) +if (R_FOUND) set (REAL_SOURCES real.c @@ -25,14 +25,12 @@ include_directories ( ) - #R_COMMAND - Path to R command - # R_HOME - Path to 'R home', as reported by R - # R_INCLUDE_DIR - Path to R include directory - # R_LIBRARY_BASE - Path to R library - # R_LIBRARY_BLAS - Path to Rblas / blas library - # R_LIBRARY_LAPACK - Path to Rlapack / lapack library - # R_LIBRARY_READLINE - Path to readline library - # R_LIBRARIES - Array of: R_LIBRARY_BASE, R_LIBRARY_BLAS, R_LIBRARY_LAPACK, R_LIBRARY_BASE [, R_LIBRARY_READLINE] +# The module defines the following variables: +# R_FOUND - System has R +# R_EXECUTABLE - The R interpreter +# R_INCLUDE_DIR - the R include directory +# R_LIBRARIES - The libraries needed to use R +# R_VERSION_STRING - R version add_library (real SHARED ${REAL_SOURCES}) @@ -48,6 +46,7 @@ include_directories ( install(TARGETS real LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) install(FILES real.pl @@ -55,4 +54,4 @@ include_directories ( ) -endif (R_HOME) +endif (R_FOUND) diff --git a/packages/real/real.pl b/packages/real/real.pl index 812d7e857..b54b9f80a 100755 --- a/packages/real/real.pl +++ b/packages/real/real.pl @@ -10,6 +10,16 @@ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/** + +@file real.pl +@author Nicos Angelopoulos +@author Vitor Santos Costa +@version 1:0:4, 2013/12/25, sinter_class +@license Perl Artistic License + +*/ + :- module(real, [ start_r/0, end_r/0, @@ -64,7 +74,7 @@ %:- set_prolog_flag(double_quotes, string ). -/** An interface to the R statistical software. +/** @defgroup libReal An interface to the R statistical software. @ingroup packages #### Introduction @@ -269,10 +279,6 @@ logical :- #### Info -@author Nicos Angelopoulos -@author Vitor Santos Costa -@version 1:0:4, 2013/12/25, sinter_class -@license Perl Artistic License @see http://stoics.org.uk/~nicos/sware/real @see pack(real/examples/for_real) @see pack(real/doc/real.html) diff --git a/packages/swi-minisat2/C/CMakeLists.txt b/packages/swi-minisat2/C/CMakeLists.txt index e5571b12a..919549d8e 100644 --- a/packages/swi-minisat2/C/CMakeLists.txt +++ b/packages/swi-minisat2/C/CMakeLists.txt @@ -44,7 +44,7 @@ pl-minisat.C install ( TARGETS minisat2 RUNTIME DESTINATION ${bindir} - ARCHIVE DESTINATION ${libdir} + ARCHIVE DESTINATION ${dlls} LIBRARY DESTINATION ${dlls} ) diff --git a/packages/swig/java/#CMakeLists.txt# b/packages/swig/java/#CMakeLists.txt# new file mode 100644 index 000000000..f7a825c5a --- /dev/null +++ b/packages/swig/java/#CMakeLists.txt# @@ -0,0 +1,95 @@ + + +macro_optional_find_package(Java ON) + + find_package(Java COMPONENTS Runtime Development) + #find_package(Java COMPONENTS Runtime) + +macro_log_feature (Java_Development_FOUND "Java" + "Use Java System" + "http://www.java.org" FALSE) +macro_optional_find_package(JNI ON) + macro_log_feature (JNI_FOUND "JNI" + "Use Java Native Interface" + "http://www.java.org" FALSE) + + +if (Java_Development_FOUND) + + include ( UseJava ) + include ( UseSWIG ) + + + # SET(CMAKE_SWIG_FLAGS -package YAP) + + set (CMAKE_SWIG_OUTDIR ${CMAKE_CURRENT_BINARY_DIR} ) + + SET(SWIG_SOURCES + ../yap.i + ) + + #set (CMAKE_JAVA_CLASS_OUTPUT_PATH java) + + + SET_SOURCE_FILES_PROPERTIES(${SWIG_SOURCES} PROPERTIES CPLUSPLUS ON) + + + include_directories ( + ${CMAKE_SOURCE_DIR}/CXX + ${JAVA_INCLUDE_DIRS} + ${JNI_INCLUDE_DIRS} + ) + + if ( ${C_COMPILER} MATCHES "Clang") + set( CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-missing-prototypes") + endif() + if ( ${C_COMPILER} MATCHES "GNU") + set( CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -Wno-missing-declarations") + endif() + #SET(CMAKE_SWIG_FLAGS "${CMAKE_SWIG_FLAGS} ") + + SWIG_ADD_MODULE(Native java ${SWIG_SOURCES} + ) + + add_dependencies(Native Yap++ ) + + SWIG_LINK_LIBRARIES (Native Yap++ ) + + + set(CMAKE_JNI_TARGET 1) + ADD_JAR( NativeJar + SOURCES "../../../misc/icons/yap_16x16x32.png" + DEPENDS Native + PROPERTIES OUTPUT_NAME Native + ) + install_jar(NativeJar ${libpl}) + add_dependencies(NativeJar Native ) + #install_jni_symlink(NativeJar .) + + + ADD_CUSTOM_COMMAND(TARGET NativeJar + POST_BUILD + COMMAND cmake -E echo "Compiling Java files..." + COMMAND ${Java_JAVAC_EXECUTABLE} *.java -cp . + COMMAND cmake -E echo "Creating jar file..." + COMMAND ${Java_JAR_EXECUTABLE} -ufM Native.jar *.class + ) + + ADD_JAR( JavaYAP + SOURCES "JavaYAP.java" + ENTRY_POINT JavaYAP + INCLUDE_JARS NativeJar ) + + SET(CMAKE_JAVA_COMPILE_FLAGS "-source" "1.8" "-target" "1.8") +install( TARGETS Native + RUNTIME DESTINATION ${bindir} + ARCHIVE DESTINATION ${libdir} + LIBRARY DESTINATION ${libdir} +) + +install_jar(JavaYAP ${libpl}) +#install_jni_symlink(JavaYAP ${libpl}) + + + + Endif (Java_Development_FOUND) diff --git a/packages/swig/java/CMakeLists.txt b/packages/swig/java/CMakeLists.txt index 6c0516739..38b628cee 100644 --- a/packages/swig/java/CMakeLists.txt +++ b/packages/swig/java/CMakeLists.txt @@ -2,10 +2,11 @@ macro_optional_find_package(Java ON) - find_package(Java COMPONENTS Runtime Development) - #find_package(Java COMPONENTS Runtime) - -macro_log_feature (Java_Development_FOUND "Java" +#find_package(Java) +find_package(Java COMPONENTS Runtime Development) +find_package(JNI) + +macro_log_feature (Java_FOUND "Java" "Use Java System" "http://www.java.org" FALSE) macro_optional_find_package(JNI ON) @@ -14,7 +15,7 @@ macro_optional_find_package(JNI ON) "http://www.java.org" FALSE) -if (Java_Development_FOUND) +if (Java_FOUND AND JNI_FOUND) include ( UseJava ) include ( UseSWIG ) @@ -91,4 +92,4 @@ install_jar(JavaYAP ${libpl}) - Endif (Java_Development_FOUND) + Endif (Java_FOUND AND JNI_FOUND) diff --git a/pl/absf.md b/pl/absf.md deleted file mode 100644 index 1f589108d..000000000 --- a/pl/absf.md +++ /dev/null @@ -1,107 +0,0 @@ - -@addtogroup absolute_file_name - -@pred absolute_file_name(+File:atom, +Options:list, +Path:atom) is nondet -@pred absolute_file_name(-File:atom, +Path:atom, +Options:list) is nondet - - _Options_ is a list of options to guide the conversion: - - - extensions(+ _ListOfExtensions_) - - List of file-name suffixes to add to try adding to the file. The - Default is the empty suffix, `''`. For each extension, - absolute_file_name/3 will first add the extension and then verify - the conditions imposed by the other options. If the condition - fails, the next extension of the list is tried. Extensions may - be specified both with dot, as `.ext`, or without, as plain - `ext`. - - - relative_to(+ _FileOrDir_ ) - - Resolve the path relative to the given directory or directory the - holding the given file. Without this option, paths are resolved - relative to the working directory (see working_directory/2) or, - if _Spec_ is atomic and absolute_file_name/3 is executed - in a directive, it uses the current source-file as reference. - - - access(+ _Mode_ ) - - Imposes the condition access_file( _File_ , _Mode_ ). _Mode_ is one of `read`, `write`, `append`, `exist` or - `none` (default). - - See also access_file/2. - - - file_type(+ _Type_ ) - - Defines suffixes matching one of several pre-specified type of files. Default mapping is as follows: - - 1. `txt` implies `[ '' ]`, - - 2. `prolog` implies `['.yap', '.pl', '.prolog', '']`, - - 3. `executable` implies `['.so', ',dylib', '.dll']` depending on the Operating system, - - 4. `qly` implies `['.qly', '']`, - - 5. `directory` implies `['']`, - - 6. The file-type `source` is an alias for `prolog` designed to support compatibility with SICStus Prolog. See also prolog_file_type/2. - - Notice that this predicate only - returns non-directories, unless the option `file_type(directory)` is - specified, or unless `access(none)`. - - - file_errors(`fail`/`error`) - - If `error` (default), throw `existence_error` exception - if the file cannot be found. If `fail`, stay silent. - - - solutions(`first`/`all`) - - If `first` (default), commit to the first solution. Otherwise - absolute_file_name will enumerate all solutions via backtracking. - - - expand(`true`/`false`) - - If `true` (default is `false`) and _Spec_ is atomic, call - expand_file_name/2 followed by member/2 on _Spec_ before - proceeding. This is originally a SWI-Prolog extension, but - whereas SWI-Prolog implements its own conventions, YAP uses the - shell's `glob` primitive. - - - glob(`Pattern`) - - If _Pattern_ is atomic, add the pattern as a suffix to the current expansion, and call - expand_file_name/2 followed by member/2 on the result. This is originally a SICStus Prolog exception. - - Both `glob` and `expand` rely on the same underlying - mechanism. YAP gives preference to `glob`. - - - verbose_file_search(`true`/`false`) - - If `true` (default is `false`) output messages during - search. This is often helpful when debugging. Corresponds to the - SWI-Prolog flag `verbose_file_search` (also available in YAP). - - -Compatibility considerations to common argument-order in ISO as well -as SICStus absolute_file_name/3 forced us to be flexible here. -If the last argument is a list and the second not, the arguments are -swapped, making the call -~~~~~~~~~~~prolog - absolute_file_name(+ _Spec_ , - _Path_ ,+ _Options_ ) -~~~~~~~~~~~ - valid as well. - - -@pred user:library_directory(?Directory:atom) is nondet, dynamic - -Dynamic, multi-file predicate that succeeds when _Directory_ is a -current library directory name. Asserted in the user module. - -Library directories are the places where files specified in the form -`library( _File_ )` are searched by the predicates consult/1, -reconsult/1, use_module/1, ensure_loaded/1, and load_files/2. - -This directory is initialized by a rule that calls the system predicate -system_library/1. diff --git a/pl/absf.yap b/pl/absf.yap index 5dc87d98a..2246fafe5 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -8,10 +8,14 @@ * * *************************************************************************/ -%% @file absf.yap -%% @author L.Damas, V.S.Costa +/** -%% @{ + + + @file absf.yap + @author L.Damas, V.S.Costa + +*/ :- system_module( absf, [absolute_file_name/2, absolute_file_name/3, @@ -21,186 +25,124 @@ remove_from_path/1], ['$full_filename'/3, '$system_library_directories'/2]). -/** @defgroup absf File Name Resolution +/** - @ingroup builtins +@defgroup AbsoluteFileName File Name Resolution + @ingroup builtins - Support for file name resolution through absolute_file_name/3 and + Support for file name resolution through absolute_file_name/3 and friends. These utility built-ins describe a list of directories that are used by load_files/2 to search. They include pre-compiled paths plus user-defined directories, directories based on environment variables and registry information to search for files. - **/ +@{ + +*/ + :- use_system_module( '$_boot', ['$system_catch'/4]). :- use_system_module( '$_errors', ['$do_error'/2]). :- use_system_module( '$_lists', [member/2]). -:- multifile user:library_directory/1. - -:- dynamic user:library_directory/1. -%% user:library_directory( ?Dir ) -% Specifies the set of directories where -% one can find Prolog libraries. -% -% 1. honor YAPSHAREDIR -user:library_directory( Dir ) :- - getenv( 'YAPSHAREDIR', Dir0), - absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ). -%% 2. honor user-library -user:library_directory( Dir ) :- - absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ). -%% 3. honor current directory -user:library_directory( Dir ) :- - absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ). -%% 4. honor default location. -user:library_directory( Dir ) :- - system_library( Dir ). - /** - @pred user:commons_directory(? _Directory_:atom) is nondet, dynamic - State the location of the Commons Prolog Initiative. +@pred absolute_file_name( -File:atom, +Path:atom, +Options:list) is nondet - This directory is initialized as a rule that calls the system predicate - library_directories/2. +_Options_ is a list of options to guide the conversion: + + - extensions(+ _ListOfExtensions_) + + List of file-name suffixes to add to try adding to the file. The + Default is the empty suffix, `''`. For each extension, + absolute_file_name/3 will first add the extension and then verify + the conditions imposed by the other options. If the condition + fails, the next extension of the list is tried. Extensions may + be specified both with dot, as `.ext`, or without, as plain + `ext`. + + - relative_to(+ _FileOrDir_ ) + + Resolve the path relative to the given directory or directory the + holding the given file. Without this option, paths are resolved + relative to the working directory (see working_directory/2) or, + if _Spec_ is atomic and absolute_file_name/3 is executed + in a directive, it uses the current source-file as reference. + + - access(+ _Mode_ ) + + Imposes the condition access_file( _File_ , _Mode_ ). _Mode_ is one of `read`, `write`, `append`, `exist` or + `none` (default). + + See also access_file/2. + + - file_type(+ _Type_ ) + + Defines suffixes matching one of several pre-specified type of files. Default mapping is as follows: + + 1. `txt` implies `[ '' ]`, + + 2. `prolog` implies `['.yap', '.pl', '.prolog', '']`, + + 3. `executable` implies `['.so', ',dylib', '.dll']` depending on the Operating system, + + 4. `qly` implies `['.qly', '']`, + + 5. `directory` implies `['']`, + + 6. The file-type `source` is an alias for `prolog` designed to support compatibility with SICStus Prolog. See also prolog_file_type/2. + + Notice that this predicate only + returns non-directories, unless the option `file_type(directory)` is + specified, or unless `access(none)`. + + - file_errors(`fail`/`error`) + + If `error` (default), throw `existence_error` exception + if the file cannot be found. If `fail`, stay silent. + + - solutions(`first`/`all`) + + If `first` (default), commit to the first solution. Otherwise + absolute_file_name will enumerate all solutions via backtracking. + + - expand(`true`/`false`) + + If `true` (default is `false`) and _Spec_ is atomic, call + expand_file_name/2 followed by member/2 on _Spec_ before + proceeding. This is originally a SWI-Prolog extension, but + whereas SWI-Prolog implements its own conventions, YAP uses the + shell's `glob` primitive. + + Notice that in `glob` mode YAP will fail if it cannot find a matching file, as `glob` + implicitely tests for existence when checking for patterns. + + - glob(`Pattern`) + + If _Pattern_ is atomic, add the pattern as a suffix to the current expansion, and call + expand_file_name/2 followed by member/2 on the result. This is originally a SICStus Prolog exception. + + Both `glob` and `expand` rely on the same underlying + mechanism. YAP gives preference to `glob`. + + - verbose_file_search(`true`/`false`) + + If `true` (default is `false`) output messages during + search. This is often helpful when debugging. Corresponds to the + SWI-Prolog flag `verbose_file_search` (also available in YAP). + + +Compatibility considerations to common argument-order in ISO as well +as SICStus absolute_file_name/3 forced us to be flexible here. +If the last argument is a list and the second not, the arguments are +swapped, thus the call +~~~~~~~~~~~~ +?- absolute_file_name( 'pl/absf.yap', [], Path) +~~~~~~~~~~~~ + is valid as well. */ -:- multifile user:commons_directory/1. - -:- dynamic user:commons_directory/1. - - -user:commons_directory( Path ):- - system_commons( Path ). - -/** - @pred user:foreign_directory(? _Directory_:atom) is nondet, dynamic - - State the location of the Foreign Prolog Initiative. - - This directory is initialized as a rule that calls the system predicate - library_directories/2. -*/ - -:- multifile user:foreign_directory/1. - -:- dynamic user:foreign_directory/1. - -user:foreign_directory( Path ):- - system_foreign( Path ). - -/** - @pred user:prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic - - This multifile/dynamic predicate relates a file extension _Suffix_ - to a language or file type _Handler_. By - default, it supports the extensions yap, pl, and prolog for prolog files and - uses one of dll, so, or dylib for shared objects. Initial definition is: - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog - prolog_file_type(yap, prolog). - prolog_file_type(pl, prolog). - prolog_file_type(prolog, prolog). - prolog_file_type(qly, prolog). - prolog_file_type(qly, qly). - prolog_file_type(A, prolog) :- - current_prolog_flag(associate, A), - A \== prolog, - A \==pl, - A \== yap. - prolog_file_type(A, executable) :- - current_prolog_flag(shared_object_extension, A). -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -*/ - -:- multifile user:prolog_file_type/2. - -:- dynamic user:prolog_file_type/2. - -user:prolog_file_type(yap, prolog). -user:prolog_file_type(pl, prolog). -user:prolog_file_type(prolog, prolog). -user:prolog_file_type(A, prolog) :- - current_prolog_flag(associate, A), - A \== prolog, - A \== pl, - A \== yap. -user:prolog_file_type(qly, qly). -user:prolog_file_type(A, executable) :- - current_prolog_flag(shared_object_extension, A). - - -/** - @pred user:file_search_path(+Name:atom, -Directory:atom) is nondet - - Allows writing file names as compound terms. The _Name_ and - _DIRECTORY_ must be atoms. The predicate may generate multiple - solutions. The predicate is originally defined as follows: - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog -file_search_path(library, Dir) :- - library_directory(Dir). -file_search_path(commons, Dir) :- - commons_directory(Dir). -file_search_path(swi, Home) :- - current_prolog_flag(home, Home). -file_search_path(yap, Home) :- - current_prolog_flag(home, Home). -file_search_path,(system, Dir) :- - prolog_flag(host_type, Dir). -file_search_path(foreign, Dir) :- - foreign_directory(Dir). -file_search_path(path, C) :- - ( getenv('PATH', A), - ( current_prolog_flag(windows, true) - -> atomic_list_concat(B, ;, A) - ; atomic_list_concat(B, :, A) - ), - lists:member(C, B) - ). - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Thus, `compile(library(A))` will search for a file using - library_directory/1 to obtain the prefix, - whereas 'compile(system(A))` would look at the `host_type` flag. - -@} - -*/ - -:- multifile user:file_search_path/2. - -:- dynamic user:file_search_path/2. - -user:file_search_path(library, Dir) :- - user:library_directory(Dir). -user:file_search_path(commons, Dir) :- - user:commons_directory(Dir). -user:file_search_path(swi, Home) :- - current_prolog_flag(home, Home). -user:file_search_path(yap, Home) :- - current_prolog_flag(home, Home). -user:file_search_path(system, Dir) :- - prolog_flag(host_type, Dir). -user:file_search_path(foreign, Dir) :- - working_directory(Dir,Dir). -user:file_search_path(foreign, yap('lib/Yap')). -user:file_search_path(path, C) :- - ( getenv('PATH', A), - ( current_prolog_flag(windows, true) - -> atomic_list_concat(B, ;, A) - ; atomic_list_concat(B, :, A) - ), - lists:member(C, B) - ). - -%%@} - absolute_file_name(File,TrueFileName,Opts) :- ( var(TrueFileName) -> true ; @@ -296,7 +238,7 @@ absolute_file_name(File0,File) :- '$extend_path_directory'(Name, A, File, Opts, NewFile, Call). '$find_in_path'(File0,Opts,NewFile,_) :- '$cat_file_name'(File0,File), !, - '$add_path'(File, PFile), + '$add_path'(File, Opts, PFile), '$get_abs_file'(PFile,Opts,AbsFile), '$absf_trace'('~w to ~w', [PFile, NewFile] ), '$search_in_path'(AbsFile,Opts,NewFile). @@ -361,7 +303,9 @@ absolute_file_name(File0,File) :- atom_codes(DA,[D]), atom_concat( [File1, DA, Glob], File2 ), expand_file_name(File2, ExpFiles), - '$enumerate_glob'(File1, ExpFiles, ExpFile) + % glob is not very much into failing + %[File2] \== ExpFiles, + '$enumerate_glob'(File2, ExpFiles, ExpFile) ; Expand == true -> @@ -373,9 +317,9 @@ absolute_file_name(File0,File) :- '$absf_trace'(' With globbing (glob=~q;expand=~a): ~w', [Glob,Expand,ExpFile] ). -'$enumerate_glob'(File1, [ExpFile], ExpFile) :- +'$enumerate_glob'(_File1, [ExpFile], ExpFile) :- !. -'$enumerate_glob'(File1, ExpFiles, ExpFile) :- +'$enumerate_glob'(_File1, ExpFiles, ExpFile) :- lists:member(ExpFile, ExpFiles), file_base_name( ExpFile, Base ), Base \= '.', @@ -413,10 +357,14 @@ absolute_file_name(File0,File) :- '$add_type_extensions'(_,File,File) :- '$absf_trace'(' wo extension ~w?', [File] ). -'$add_path'(File, File) :- +'$add_path'(File, _, File) :- is_absolute_file_name(File), !. -'$add_path'(File, File) :- - working_directory(Dir, Dir), +'$add_path'(File, Opts, File) :- + ( get_abs_file_parameter( relative_to, Opts, Dir ) -> + true + ; + working_directory(Dir, Dir) + ), '$dir_separator'( D ), atom_codes( DSep, [D] ), atomic_concat([Dir, DSep,File],PFile), @@ -570,6 +518,8 @@ add_to_path(New,Pos) :- /** @pred remove_from_path(+Directory:atom) is det,deprecated +@} + */ remove_from_path(New) :- '$check_path'(New,Path), recorded('$path',Path,R), erase(R). @@ -579,3 +529,186 @@ remove_from_path(New) :- '$check_path'(New,Path), '$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !. '$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). '$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). + +/** + @defgroup pathconf Configuration of the Prolog file search path + @ingroup AbsoluteFileName + + Prolog systems search follow a complex search on order to track down files. + +@{ +**/ + +/** +@pred user:library_directory(?Directory:atom) is nondet, dynamic + +Dynamic, multi-file predicate that succeeds when _Directory_ is a +current library directory name. Asserted in the user module. + +Library directories are the places where files specified in the form +`library( _File_ )` are searched by the predicates consult/1, +reconsult/1, use_module/1, ensure_loaded/1, and load_files/2. + +This directory is initialized by a rule that calls the system predicate +system_library/1. +*/ +:- multifile user:library_directory/1. + +:- dynamic user:library_directory/1. +%% Specifies the set of directories where +% one can find Prolog libraries. +% +% 1. honor YAPSHAREDIR +user:library_directory( Dir ) :- + getenv( 'YAPSHAREDIR', Dir0), + absolute_file_name( Dir0, [file_type(directory), expand(true),file_errors(fail)], Dir ). +%% 2. honor user-library +user:library_directory( Dir ) :- + absolute_file_name( '~/share/Yap', [file_type(directory), expand(true),file_errors(fail)], Dir ). +%% 3. honor current directory +user:library_directory( Dir ) :- + absolute_file_name( '.', [file_type(directory), expand(true),file_errors(fail)], Dir ). +%% 4. honor default location. +user:library_directory( Dir ) :- + system_library( Dir ). + +/** + @pred user:commons_directory(? _Directory_:atom) is nondet, dynamic + + State the location of the Commons Prolog Initiative. + + This directory is initialized as a rule that calls the system predicate + library_directories/2. +*/ + +:- multifile user:commons_directory/1. + +:- dynamic user:commons_directory/1. + + +user:commons_directory( Path ):- + system_commons( Path ). + +/** + @pred user:foreign_directory(? _Directory_:atom) is nondet, dynamic + + State the location of the Foreign Prolog Initiative. + + This directory is initialized as a rule that calls the system predicate + library_directories/2. +*/ + +:- multifile user:foreign_directory/1. + +:- dynamic user:foreign_directory/1. + +user:foreign_directory( Path ):- + system_foreign( Path ). + +/** + @pred user:prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic + + This multifile/dynamic predicate relates a file extension _Suffix_ + to a language or file type _Handler_. By + default, it supports the extensions yap, pl, and prolog for prolog files and + uses one of dll, so, or dylib for shared objects. Initial definition is: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog + prolog_file_type(yap, prolog). + prolog_file_type(pl, prolog). + prolog_file_type(prolog, prolog). + prolog_file_type(qly, prolog). + prolog_file_type(qly, qly). + prolog_file_type(A, prolog) :- + current_prolog_flag(associate, A), + A \== prolog, + A \==pl, + A \== yap. + prolog_file_type(A, executable) :- + current_prolog_flag(shared_object_extension, A). +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +*/ + +:- multifile user:prolog_file_type/2. + +:- dynamic user:prolog_file_type/2. + +user:prolog_file_type(yap, prolog). +user:prolog_file_type(pl, prolog). +user:prolog_file_type(prolog, prolog). +user:prolog_file_type(A, prolog) :- + current_prolog_flag(associate, A), + A \== prolog, + A \== pl, + A \== yap. +user:prolog_file_type(qly, qly). +user:prolog_file_type(A, executable) :- + current_prolog_flag(shared_object_extension, A). + + +/** + @pred user:file_search_path(+Name:atom, -Directory:atom) is nondet + + Allows writing file names as compound terms. The _Name_ and + _DIRECTORY_ must be atoms. The predicate may generate multiple + solutions. The predicate is originally defined as follows: + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~prolog +file_search_path(library, Dir) :- + library_directory(Dir). +file_search_path(commons, Dir) :- + commons_directory(Dir). +file_search_path(swi, Home) :- + current_prolog_flag(home, Home). +file_search_path(yap, Home) :- + current_prolog_flag(home, Home). +file_search_path,(system, Dir) :- + prolog_flag(host_type, Dir). +file_search_path(foreign, Dir) :- + foreign_directory(Dir). +file_search_path(path, C) :- + ( getenv('PATH', A), + ( current_prolog_flag(windows, true) + -> atomic_list_concat(B, ;, A) + ; atomic_list_concat(B, :, A) + ), + lists:member(C, B) + ). + +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + Thus, `compile(library(A))` will search for a file using + library_directory/1 to obtain the prefix, + whereas 'compile(system(A))` would look at the `host_type` flag. + +*/ + +:- multifile user:file_search_path/2. + +:- dynamic user:file_search_path/2. + +user:file_search_path(library, Dir) :- + user:library_directory(Dir). +user:file_search_path(commons, Dir) :- + user:commons_directory(Dir). +user:file_search_path(swi, Home) :- + current_prolog_flag(home, Home). +user:file_search_path(yap, Home) :- + current_prolog_flag(home, Home). +user:file_search_path(system, Dir) :- + prolog_flag(host_type, Dir). +user:file_search_path(foreign, Dir) :- + working_directory(Dir,Dir). +user:file_search_path(foreign, yap('lib/Yap')). +user:file_search_path(path, C) :- + ( getenv('PATH', A), + ( current_prolog_flag(windows, true) + -> atomic_list_concat(B, ;, A) + ; atomic_list_concat(B, :, A) + ), + lists:member(C, B) + ). + + +%% @} \ No newline at end of file diff --git a/pl/arith.yap b/pl/arith.yap index 9448ad320..e788c060d 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -15,7 +15,9 @@ * * *************************************************************************/ -% the default mode is on + % the default mode is on + +%% @file arith.yap :- system_module( '$_arith', [compile_expressions/0, expand_exprs/2, @@ -112,7 +114,7 @@ q(A):- A is 22. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -w*/ +*/ do_not_compile_expressions :- set_value('$c_arith',[]). '$c_built_in'(IN, M, H, OUT) :- @@ -335,7 +337,9 @@ expand_expr(Op, X, Y, O, Q, P) :- '$do_and'(Z = X, Y = W, E). -'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod). +'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod) :- + callable(NT), + atom(Mod). %% contains_illegal_dcgnt(+Term) is semidet. % diff --git a/pl/atoms.yap b/pl/atoms.yap index e5036550c..d2f7e3aed 100644 --- a/pl/atoms.yap +++ b/pl/atoms.yap @@ -50,7 +50,7 @@ atom_concat(Xs,At) :- % just slice first atom '$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :- atom(At0), !, - sub_atom(At0, 0, _Sz, L, Ata ), + sub_atom(At0, 0, _Sz, L, _Ata ), sub_atom(At, _, L, 0, Atr ), %remainder '$atom_concat_constraints'(Xs, 0, Atr, Unbound). % first hole: Follow says whether we have two holes in a row, At1 will be our atom diff --git a/pl/boot.yap b/pl/boot.yap index e62dd092b..ce3d4c355 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -7,7 +7,7 @@ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014 * * * ************************************************************************** -* * +* Ptv * * File: boot.yap * * Last rev: 8/2/88 * * mods: * @@ -15,15 +15,15 @@ * * *************************************************************************/ -%% @{ - /** - +@file boot.yap @defgroup YAPControl Control Predicates @ingroup builtins */ +%% @{ + /** @pred :_P_ ; :_Q_ is iso @@ -55,31 +55,17 @@ This predicate might be defined as: ~~~~~~~~~~~~ if _P_ did not include "cuts". -If _P_ includes cuts, the cuts are defined to be scoped by _P_: they canno cut over the calling prredicate. +If _P_ includes cuts, the cuts are defined to be scoped by _P_: they cannot cut over the calling prredicate. ~~~~~~~~~~~~ go(P). - :- \+ P, !, fail. + +:- \+ P, !, fail. \+(_). ~~~~~~~~~~~~ */ - -/** @pred not :_P_ - - -Goal _P_ is not provable. The same as `\+ _P_`. - -This predicate is kept for compatibility with C-Prolog and previous -versions of YAP. Uses of not/1 should be replaced by -`\+`/1, as YAP does not implement true negation. - - -*/ - - - /** @pred :_Condition__ -> :_Action_ is iso @@ -185,8 +171,8 @@ list, since backtracking could not "pass through" the cut. */ -system_module(Mod, _SysExps, _Decls) :- !, - new_system_module(Mod). +system_module(Mod, _SysExps, _Decls) :- ! . +% new_system_module(Mod). use_system_module(_init, _SysExps) :- !. @@ -308,7 +294,7 @@ private(_). arg(1, AOB, A), arg(2, AOB, B), !, - '$binary_op_as_integer'(Op,IOp). + '$inbrary_op_as_integer'(Op,IOp). '$prepare_goals'((A,B),(A,B),_Any). '$prepare_clause'((H :- B), (H:-NB)) :- @@ -519,13 +505,13 @@ true :- true. ). - '$erase_sets' :- - eraseall('$'), +'$erase_sets' :- + eraseall('$'), eraseall('$$set'), eraseall('$$one'), eraseall('$reconsulted'), fail. - '$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',"",_). - '$erase_sets'. +'$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',"",_). +'$erase_sets'. '$version' :- current_prolog_flag(version_git,VersionGit), @@ -719,15 +705,18 @@ number of steps. '$continue_with_command'(top,V,_,G,_) :- '$query'(G,V). + %% + % @pred '$go_compile_clause'(G,Vs,Pos, Where, Source) is det % + % interfaces the loader and the compiler % not 100% compatible with SICStus Prolog, as SICStus Prolog would put % module prefixes all over the place, although unnecessarily so. % - % G is the goal to compile - % Vs the named variables - % Pos the source position - % N where to add first or last - % Source the original clause + % @param [in] _G_ is the clause to compile + % @param [in] _Vs_ a list of varables and their name + % @param [in] _Pos_ the source-code position + % @param [in] _N_ a flag telling whether to add first or last + % @param [in] _Source_ the original clause '$go_compile_clause'(G,Vs,Pos, Where, Source) :- '$precompile_term'(G, G0, G1), !, @@ -1379,29 +1368,37 @@ bootstrap(F) :- prolog_flag(agc_margin,_,Old), !. '$loop'(Stream,Status) :- + % start_low_level_trace, + '$current_module'( OldModule ), repeat, - prompt1(': '), prompt(_,' '), - '$current_module'(OldModule), - '$system_catch'('$enter_command'(Stream,OldModule,Status), OldModule, Error, - user:'$LoopError'(Error, Status)), + '$system_catch'( '$enter_command'(Stream,OldModule,Status), + OldModule, Error, + user:'$LoopError'(Error, Status) + ), !. -'$enter_command'(Stream,Mod,Status) :- - !, - read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]), +'$enter_command'(Stream, Mod, Status) :- + prompt1(': '), prompt(_,' '), + Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)], + ( + Status == top + -> + read_term(Stream, Command, Options) + ; + read_clause(Stream, Command, Options) + ), '$command'(Command,Vars,Pos, Status). -'$enter_command'(_Stream, _Mod, _HeadMob). +/** @pred user:expand_term( _T_,- _X_) is dynamic,multifile. -/** @pred expand_term( _T_,- _X_) + This user-defined predicate is called by YAP after + reading goals and clauses. -This predicate is used by YAP for preprocessingStatus) :- - read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]), - '$command'(Command,Vars,Pos,Status). - -'$abort_loop'(Stream) :- - '$do_error'(permission_error(input,closed_stream,Stream), loop). + - _Module_:`expand_term(` _T_ , _X_) is called first on the + current source module _Module_ ; if i + - `user:expand_term(` _T_ , _X_ `)` is available on every module. + */ /* General purpose predicates */ diff --git a/pl/consult.yap b/pl/consult.yap index 727939a56..0acf8a650 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -97,7 +97,7 @@ files and to set-up the Prolog environment. We discuss /** - @pred load_files(+ _Files_, + _Options_) + @pred load_files(+_Files_, +_Options_) Implementation of the consult/1 family. Execution is controlled by the following flags: @@ -473,9 +473,10 @@ load_files(Files,Opts) :- % check if there is a qly file % start_low_level_trace, '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,qload_file(File)), - open( F, read, Stream , [type(binary)] ), + open( F, read, Stream , [type(binary)] ), ( '$q_header'( Stream, Type ), + writeln(File:Type), Type == file -> ! @@ -1418,7 +1419,7 @@ initialization(_G,_OPT) :- '$initialization'(G,OPT) :- error:must_be_of_type(callable, G, initialization(G,OPT)), error:must_be_of_type(oneof([after_load, now, restore]), - OPT, initialization(G0,OPT)), + OPT, initialization(G,OPT)), ( OPT == now -> diff --git a/pl/control.yap b/pl/control.yap index 1d5cd8b04..32e04e3c7 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -81,10 +81,10 @@ /** -@{ - @addtogroup YAPControl +%% @{ + */ diff --git a/pl/debug.yap b/pl/debug.yap index 301513fc4..ee7885842 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -541,7 +541,7 @@ be lost. G10 = NM:NG, '$do_spy'(NG, NM, CP, spy). '$spycall'(G, M, _, _) :- - '$tabled_predicate'(G,M), + ( '$is_system_predicate'(G,M) ; '$tabled_predicate'(G,M) ), !, '$continue_debugging_goal'(no, '$execute_nonstop'(G,M)). '$spycall'(G, M, CalledFromDebugger, InRedo) :- @@ -1050,7 +1050,7 @@ be lost. G =.. [F|BGs], '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s), G1 =.. [F|BG1s]. -'$debugger_process_meta_arguments'(G, M, G). +'$debugger_process_meta_arguments'(G, _M, G). '$ldebugger_process_meta_args'([], _, [], []). '$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$spy'([M1|G1])|BG1s]) :- diff --git a/pl/error.yap b/pl/error.yap index 628608d11..a958a18ae 100644 --- a/pl/error.yap +++ b/pl/error.yap @@ -23,8 +23,9 @@ is_of_type/2 % +Type, +Term ]). -/** @defgroup error Error generating support -@ingroup builtin +/** + @defgroup error Error generating support +@ingroup YAPError This SWI module provides predicates to simplify error generation and checking. Adapted to use YAP built-ins. @@ -36,6 +37,9 @@ predicates are simple wrappers around throw/1 to simplify throwing the most common ISO error terms. YAP reuses the code with some extensions, and supports interfacing to some C-builtins. + +@{ + */ :- multifile @@ -255,3 +259,5 @@ must_be_instantiated(X) :- must_be_instantiated(X, Comment) :- ( var(X) -> instantiation_error(X, Comment) ; true). + +%% @} diff --git a/pl/errors.yap b/pl/errors.yap index f94932577..e81d9c20f 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -11,210 +11,84 @@ * File: errors.yap * * comments: error messages for YAP * * * -* Last rev: $Date: 2008-07-22 23:34:50 $,$Author: vsc $ * -* $Log: not supported by cvs2svn $ -* Revision 1.89 2008/06/12 10:55:52 vsc -* fix syntax error messages -* -* Revision 1.88 2008/04/04 10:02:44 vsc -* implement thread_cancel using signals -* use duplicate_term instead of copy_term in throw: throw may lose -* reference to term. -* -* Revision 1.87 2008/03/17 12:08:28 vsc -* avoid silly message -* -* Revision 1.86 2008/02/23 01:32:31 vsc -* fix chr bootstrap. -* -* Revision 1.85 2008/02/22 15:08:37 vsc -* Big update to support more SICStus/SWI like message handling -* fix YAPSHAREDIR -* fix yap.tex (Bernd) -* -* Revision 1.84 2008/01/23 17:57:55 vsc -* valgrind it! -* enable atom garbage collection. -* -* Revision 1.83 2007/11/26 23:43:10 vsc -* fixes to support threads and assert correctly, even if inefficiently. -* -* Revision 1.82 2007/09/27 23:02:00 vsc -* encoding/1 -* -* Revision 1.81 2007/09/27 15:25:34 vsc -* upgrade JPL -* -* Revision 1.80 2007/01/24 14:20:04 vsc -* Fix typos across code -* Change debugger to backtrack more alike byrd model -* Fix typo in debugger option f -* -* Revision 1.79 2006/12/13 16:10:26 vsc -* several debugger and CLP(BN) improvements. -* -* Revision 1.78 2006/05/22 16:12:01 tiagosoares -* MYDDAS: MYDDAS version boot message -* -* Revision 1.77 2006/04/10 19:24:52 vsc -* fix syntax error message handling -* improve redblack trees and use it to reimplement association lists and -* to have better implementation of several graph algorithms. -* -* Revision 1.76 2006/04/05 00:16:55 vsc -* Lots of fixes (check logfile for details -* -* Revision 1.75 2006/02/24 14:26:37 vsc -* fix informational_messages -* -* Revision 1.74 2006/01/26 19:20:00 vsc -* syntax error was giving the offset -* -* Revision 1.73 2006/01/20 04:35:28 vsc -* -* fix error message -* -* Revision 1.72 2005/11/23 13:24:00 vsc -* cleanups in OS interface predicates. -* -* Revision 1.71 2005/11/10 01:27:12 vsc -* fix debugger message for EOF input -* fix fix to setof -* fix profiler spewing out hidden atoms. -* -* Revision 1.70 2005/11/03 18:27:10 vsc -* fix quote -* -* Revision 1.69 2005/11/01 18:54:06 vsc -* small fixes -* -* Revision 1.68 2005/10/29 01:28:37 vsc -* make undefined more ISO compatible. -* -* Revision 1.67 2005/10/28 17:38:50 vsc -* sveral updates -* -* Revision 1.66 2005/10/18 17:04:43 vsc -* 5.1: -* - improvements to GC -* 2 generations -* generic speedups -* - new scheme for attvars -* - hProlog like interface also supported -* - SWI compatibility layer -* - extra predicates -* - global variables -* - moved to Prolog module -* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart -* Demoen and Jan Wielemacker -* - load_files/2 -* -* from 5.0.1 -* -* - WIN32 missing include files (untested) -* - -L trouble (my thanks to Takeyuchi Shiramoto-san)! -* - debugging of backtrable user-C preds would core dump. -* - redeclaring a C-predicate as Prolog core dumps. -* - badly protected YapInterface.h. -* - break/0 was failing at exit. -* - YAP_cut_fail and YAP_cut_succeed were different from manual. -* - tracing through data-bases could core dump. -* - cut could break on very large computations. -* - first pass at BigNum issues (reported by Roberto). -* - debugger could get go awol after fail port. -* - weird message on wrong debugger option. -* -* Revision 1.65 2005/05/25 21:43:33 vsc -* fix compiler bug in 1 << X, found by Nuno Fonseca. -* compiler internal errors get their own message. -* -* Revision 1.64 2005/05/25 18:18:02 vsc -* fix error handling -* configure should not allow max-memory and use-malloc at same time -* some extensions for jpl -* -* Revision 1.63 2005/04/20 20:06:26 vsc -* try to improve error handling and warnings from within consults. -* -* Revision 1.62 2005/04/07 17:55:05 ricroc -* Adding tabling support for mixed strategy evaluation (batched and local scheduling) -* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure. -* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default). -* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local). -* -* Revision 1.61 2005/02/21 16:50:21 vsc -* amd64 fixes -* library fixes -* -* Revision 1.60 2005/01/28 23:14:41 vsc -* move to Yap-4.5.7 -* Fix clause size -* -* Revision 1.59 2005/01/13 05:47:27 vsc -* lgamma broke arithmetic optimisation -* integer_y has type y -* pass original source to checker (and maybe even use option in parser) -* use warning mechanism for checker messages. -* -* Revision 1.58 2004/11/19 21:32:53 vsc -* change abort so that it won't be caught by handlers. -* -* Revision 1.57 2004/10/27 15:56:34 vsc -* bug fixes on memory overflows and on clauses :- fail being ignored by clause. -* -* Revision 1.56 2004/10/04 18:56:20 vsc -* fixes for thread support -* fix indexing bug (serious) -* -* Revision 1.55 2004/09/17 19:34:53 vsc -* simplify frozen/2 -* -* Revision 1.54 2004/07/22 21:32:22 vsc -* debugger fixes -* initial support for JPL -* bad calls to garbage collector and gc -* debugger fixes -* -* Revision 1.53 2004/06/23 17:24:20 vsc -* New comment-based message style -* Fix thread support (at least don't deadlock with oneself) -* small fixes for coroutining predicates -* force Yap to recover space in arrays of dbrefs -* use private predicates in debugger. -* -* Revision 1.52 2004/06/18 15:41:19 vsc -* fix extraneous line in yes/no messages -* -* Revision 1.51 2004/06/09 03:32:03 vsc -* fix bugs -* -* Revision 1.50 2004/04/27 16:21:25 vsc -* stupid bug * * * * *************************************************************************/ /** @defgroup YAPError Error Handling + @ingroup YAPControl The error handler is called when there is an execution error or a warning needs to be displayed. The handlers include a number of hooks to allow user-control. +Errors are terms of the form: + - error( domain_error( Domain, Culprit )` + - error( evaluation_error( Expression, Culprit )` + - error( existence_error( Object, Culprit )` + - error( instantiation_error )` + - error( permission_error( Error, Permission, Culprit)` + - error( representation_error( Domain, Culprit )` + - error( resource_error( Resource, Culprit )` + - error( syntax_error( Error )` + - error( system_error( Domain, Culprit )` + - error( type_error( Type, Culprit )` + - error( uninstantiation_error( Culprit )` + +@{ */ -:- system_module( '$_errors', [message_to_string/2, - print_message/2], ['$Error'/1, - '$do_error'/2]). +:- system_module( '$_errors', [system_error/2], ['$Error'/1, + '$do_error'/2, + system_error/3, + system_error/2]). :- use_system_module( '$messages', [file_location/2, generate_message/3, translate_message/3]). +/** + * @pred system_error( +Error, +Cause) + * + * Generate a system error _Error_, informing the possible cause _Cause_. + * + */ +system_error(Type,Goal) :- + '$do_error'(Type,Goal). + + +'$do_error'(Type,Goal) :- +% format('~w~n', [Type]), + ancestor_location(Call, Caller), + throw(error(Type, [ + [g|g(Goal)], + [p|Call], + [e|Caller]])). + +/** + * @pred system_error( +Error, +Cause, +Culprit) + * + * Generate a system error _Error_, informing the source goal _Cause_ and a possible _Culprit_. + * + * + * ~~~~~~~~~~ + * ~~~~~~~~~~ + * + * + */ +system_error(Type,Goal,Culprit) :- + % format('~w~n', [Type]), + ancestor_location(Call, Caller), + throw(error(Type, [ + [i|Culprit], + [g|g(Goal)], + [p|Call], + [e|Caller]])). '$do_error'(Type,Goal) :- @@ -263,3 +137,5 @@ to allow user-control. print_message(error,error(Msg, Where)), !. '$process_error'(Throw, _) :- print_message(error,error(unhandled_exception,Throw)). + +%% @} \ No newline at end of file diff --git a/pl/grammar.yap b/pl/grammar.yap index fa862b502..cbec31924 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -66,6 +66,7 @@ right hand side of a grammar rule Grammar related built-in predicates: +@{ */ @@ -277,14 +278,14 @@ prolog:'$goal_expansion_allowed'. '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :- catch(prolog:'$translate_rule'( - (pseudo_nt --> Mod:NT), Rule), + (pseudo_nt --> Mod:NT), Rule), error(Pat,ImplDep), ( \+ '$harmless_dcgexception'(Pat), throw(error(Pat,ImplDep)) ) ), Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0), - Goal \== NewGoal0, + Mod:NT \== NewGoal0, % apply translation only if we are safe \+ '$contains_illegal_dcgnt'(NT), !, @@ -309,14 +310,12 @@ allowed_module(phrase(_,_),_). allowed_module(phrase(_,_,_),_). -system:goal_expansion(Mod:phrase(NT,Xs, Xs),Mod:NewGoal) :- - source_module(M), - nonvar(NT), nonvar(Mod), +system:goal_expansion(Mod:phrase(NT,Xs0, Xs),Mod:NewGoal) :- + nonvar(NT), nonvar(Mod), !, '$goal_expansion_allowed', '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal). -system:goal_expansion(Mod:phrase(NT,Xs0),Mod:NewGoal) :- - source_module(M), +system:goal_expansion(Mod:phrase(NT,Xs),Mod:NewGoal) :- nonvar(NT), nonvar(Mod), '$goal_expansion_allowed', '$c_built_in_phrase'(NT, [], Xs, Mod, NewGoal). diff --git a/pl/hacks.yap b/pl/hacks.yap index bbc75f4a9..80641cc16 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -16,6 +16,9 @@ * * *************************************************************************/ + +%% @file pl/hacks.yap + :- module('$hacks', [display_stack_info/4, display_stack_info/6, diff --git a/pl/init.yap b/pl/init.yap index e126353c9..bc39d57be 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -113,10 +113,10 @@ otherwise. format(user_error, X, Y), nl(user_error). '$early_print_message'(_, loading( C, F)) :- !, '$show_consult_level'(LC), - format(user_error, '~*|% ~a ~a...~n', [LC,C,F]). -'$early_print_message'(_, loaded(F,C,_M,T,H)) :- !, + format(user_error, '~*|% ~a ~w...~n', [LC,C,F]). +'$early_print_message'(_, loaded(F,C,M,T,H)) :- !, '$show_consult_level'(LC), - format(user_error, '~*|% ~a ~a ~d bytes in ~d seconds...~n', [LC, F ,C, H, T]). + format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [LC, M, F ,C, H, T]). '$early_print_message'(Level, Msg) :- source_location(F0, L), !, @@ -146,7 +146,7 @@ print_message(Level, Msg) :- :- bootstrap('atoms.yap'). :- bootstrap('os.yap'). :- bootstrap('absf.yap'). -:-set_prolog_flag(verbose, normal). +:- set_prolog_flag(verbose, normal). %:-set_prolog_flag(gc_trace, verbose). %:- set_prolog_flag( verbose_file_search, true ). @@ -166,10 +166,10 @@ print_message(Level, Msg) :- :- [ -'errors.yap', -'utils.yap', -'control.yap', -'flags.yap' + 'errors.yap', + 'utils.yap', + 'control.yap', + 'flags.yap' ]. @@ -246,7 +246,7 @@ rules. :- dynamic user:goal_expansion/3. :- multifile user:goal_expansion/2. - + :- dynamic user:goal_expansion/2. :- multifile system:goal_expansion/2. @@ -265,11 +265,7 @@ rules. :- use_module('attributes.yap'). :- use_module('corout.yap'). :- use_module('dialect.yap'). -:- use_module('history.pl'). :- use_module('dbload.yap'). -:- use_module('swi.yap'). -:- use_module('../swi/library/predopts.pl'). -:- use_module('../swi/library/menu.pl'). :- use_module('../library/ypp.yap'). :- use_module('../os/chartypes.yap'). :- ensure_loaded('../os/edio.yap'). diff --git a/pl/lists.yap b/pl/lists.yap index cad749eef..24861bc66 100644 --- a/pl/lists.yap +++ b/pl/lists.yap @@ -3,9 +3,7 @@ * @author VITOR SANTOS COSTA * @date Thu Nov 19 09:54:00 2015 * - * @brief core list operations - * - * @ingroup lists + * @addtogroup lists * @{ */ @@ -73,7 +71,7 @@ lists:append([H|T], L, [H|R]) :- lists:append(T, L, R). -:- set_prolog_flag(source, false). % :- no_source. +:- set_prolog_flag(source, true). % :- no_source. % lists:delete(List, Elem, Residue) % is true when List is a list, in which Elem may or may not occur, and @@ -90,7 +88,7 @@ eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee */ lists:delete([], _, []). lists:delete([Head|List], Elem, Residue) :- - Head == Elem, !, + Head = Elem, lists:delete(List, Elem, Residue). lists:delete([Head|List], Elem, [Head|Residue]) :- lists:delete(List, Elem, Residue). diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index cf0b344ed..72ab8b8b2 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -24,8 +24,12 @@ :- use_system_module( '$_modules', ['$do_import'/3]). -/** @defgroup LoadForeign Access to Foreign Language Programs -@ingroup builtins +/** + +@defgroup LoadForeign Access to Foreign Language Programs +@ingroup fli + +@{ */ @@ -49,7 +53,6 @@ if defined, or in the default library. YAP also supports the SWI-Prolog interface to loading foreign code: - */ load_foreign_files(Objs,Libs,Entry) :- source_module(M), @@ -205,5 +208,5 @@ call_shared_object_function( Handle, Function) :- '$call_shared_object_function'( Handle, Function), prolog_load_context(module, M), ignore( recordzifnot( '$foreign', M:'$swi_foreign'( Handle, Function ), _) ). -%%! @} +%% @} diff --git a/pl/messages.yap b/pl/messages.yap index 9db6be764..5d8422bc1 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -28,8 +28,6 @@ /** - @{ - @defgroup Messages Message Handling @ingroup YAPControl @@ -67,6 +65,7 @@ messages that do not produce output but that can be intercepted by hooks. The next table shows the main predicates and hooks associated to message handling in YAP: +@{ */ @@ -269,10 +268,13 @@ main_message(error(representation_error), _Source) --> main_message(error(type_error(Type,Who), _What), _Source) --> [ '~*|!!! ~q should be of type ~a' - [8,Who,Type]], [ nl ]. +main_message(error(system_error(Who), _What), _Source) --> + [ '~*|!!! ~q error' - [8,Who]], + [ nl ]. main_message(error(uninstantiation_error(T),_), _Source) --> [ '~*|!!! found ~q, expected unbound variable ' - [8,T], nl ]. -display_consulting(Level) --> +display_consulting(_Level) --> { source_location(F0, L), stream_property(_Stream, alias(loop_stream)) }, !, [ '~a:~d:0 found while compiling this file.'-[F0,L], nl ]. @@ -528,7 +530,8 @@ domain_error(Domain, Opt) --> extra_info( error(_,Extra), _ ) --> {lists:memberchk([i|Msg], Extra)}, !, - [' ~w~nx.' - [Msg] ]. + ['~*|user provided data is: ~q' - [10,Msg]], + [nl]. extra_info( _, _ ) --> []. @@ -587,7 +590,7 @@ list_of_preds([P|L]) --> list_of_preds(L). syntax_error_term(between(_I,_J,_L),LTaL) --> -% ['found at line ~d to line ~d' - [_I,_L], nl ], + ['error found at line ~d to line ~d' - [_I,_L], nl ], syntax_error_tokens(LTaL). syntax_error_tokens([]) --> []. diff --git a/pl/modules.yap b/pl/modules.yap index 0dd221d66..a3c8cfc62 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -347,7 +347,7 @@ system_module(Mod) :- % be careful here not to generate an undefined exception. -'$imported_predicate'(G, ImportingMod, G, prolog) :- +'$imported_predicate'(G, _ImportingMod, G, prolog) :- nonvar(G), '$is_system_predicate'(G, prolog), !. '$imported_predicate'(G, ImportingMod, G0, ExportingMod) :- ( var(G) -> true ; @@ -766,7 +766,7 @@ unload_module(Mod) :- module_state :- recorded('$module','$module'(HostF,HostM,SourceF, Everything, Line),_), format('HostF ~a, HostM ~a, SourceF ~w, Line ~d,~n Everything ~w.~n', [HostF,HostM,SourceF, Line, Everything]), - recorded('$import','$import'(HostM,M,G0,G,_N,_K),R), + recorded('$import','$import'(HostM,M,G0,G,_N,_K),_R), format(' ~w:~w :- ~w:~w.~n',[M,G,HostM,G0]), fail. module_state. diff --git a/pl/os.yap b/pl/os.yap index 65277490c..c0586db30 100644 --- a/pl/os.yap +++ b/pl/os.yap @@ -22,8 +22,6 @@ ], [] ). :- use_system_module( '$_errors', ['$do_error'/2]). -%% @{ - /** @defgroup YAPOS Access to Operating System Functionality @ingroup builtins @@ -31,6 +29,8 @@ The following built-in predicates allow access to underlying Operating System functionality. +%% @{ + */ /** @pred cd diff --git a/pl/preddyns.yap b/pl/preddyns.yap index c76162368..71a48c5d1 100644 --- a/pl/preddyns.yap +++ b/pl/preddyns.yap @@ -234,10 +234,12 @@ retract(M:C,R) :- !, '$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)). '$fetch_predicate_indicator_from_clause'((C :- _), M:Na/Ar) :- - !, - functor(C, Na, Ar). +!, + '$yap_strip_module'(C, M, C1), + functor(C1, Na, Ar). '$fetch_predicate_indicator_from_clause'(C, M:Na/Ar) :- - functor(C, Na, Ar). + '$yap_strip_module'(C, M, C1), + functor(C1, Na, Ar). /** @pred retractall(+ _G_) is iso diff --git a/pl/preds.yap b/pl/preds.yap index fd2a7b41f..bac89e802 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -117,7 +117,7 @@ Adds clause _C_ as the first clause for a static procedure. */ -asserta_static(CI) :- +asserta_static(C) :- '$assert'(C , asserta_static, _ ). @@ -137,7 +137,7 @@ static predicates, if source mode was on when they were compiled: */ -assertz_static(CI) :- +assertz_static(C) :- '$assert'(C , assertz_static, _ ). /** @pred clause(+ _H_, _B_) is iso @@ -292,7 +292,7 @@ abolish(X0) :- '$new_abolish'(V,M) :- var(V), !, '$abolish_all'(M). -'$new_abolish'(A,M) :- atom(A), !, +'$new_abolish'(A/V,M) :- atom(A), var(V), !, '$abolish_all_atoms'(A,M). '$new_abolish'(Na//Ar1, M) :- integer(Ar1), @@ -618,28 +618,35 @@ Defines the relation: indicator _P_ refers to a currently defined system predic system_predicate(P0) :- '$yap_strip_module'(P0, M, P), ( - P = A/Arity, ground(P) + var(P) + -> + P = A/Arity, + '$current_predicate'(A, M, T, system), + functor(T, A, Arity), + '$is_system_predicate'( T, M) + ; + ground(P), P = A/Arity -> functor(T, A, Arity), - '$current_predicate'(A, M, T, _system), + '$current_predicate'(A, M, T, system), '$is_system_predicate'( T, M) ; - P = A//Arity2, ground(P) + ground(P), P = A//Arity2 -> - Arity is Arity2-2, + Arity is Arity2+2, functor(T, A, Arity), - '$current_predicate'(A, M, T, _system), + '$current_predicate'(A, M, T, system), '$is_system_predicate'( T, M) ; P = A/Arity -> - '$current_predicate'(A, M, T, _system), + '$current_predicate'(A, M, T, system), '$is_system_predicate'( T, M), functor(T, A, Arity) ; P = A//Arity2 -> - '$current_predicate'(A, M, T, _system), + '$current_predicate'(A, M, T, system), '$is_system_predicate'( T, M), functor(T, A, Arity), Arity >= 2, diff --git a/pl/profile.yap b/pl/profile.yap index 0155aed2b..3601877a6 100644 --- a/pl/profile.yap +++ b/pl/profile.yap @@ -15,6 +15,12 @@ * * *************************************************************************/ +%% @file pl/profile.yap + +:- system_module( '$_profile', [profile_data/3, + profile_reset/0, + showprofres/0, + showprofres/1], []). /** @defgroup The_Count_Profiler The Count Profiler @ingroup Profiling @@ -28,8 +34,8 @@ backtracking. It provides exact information: are maintained. This may change in the future. + As an example, the following user-level program gives a list of the most often called procedures in a program. The procedure -`list_profile` shows all procedures, irrespective of module, and -the procedure `list_profile/1` shows the procedures being used in +list_profile/0 shows all procedures, irrespective of module, and +the procedure list_profile/1 shows the procedures being used in a specific module. ~~~~~ @@ -63,11 +69,6 @@ These are the current predicates to access and clear profiling data: */ -:- system_module( '$_profile', [profile_data/3, - profile_reset/0, - showprofres/0, - showprofres/1], []). - :- use_system_module( '$_errors', ['$do_error'/2]). @@ -76,7 +77,7 @@ These are the current predicates to access and clear profiling data: % describing a predicate; used e.g. on the tick profiler defined below :- multifile(user:prolog_predicate_name/2). -/** @pred profile_data(? _Na/Ar_, ? _Parameter_, - _Data_) +/** @pred profile_data( ?Na/Ar, ?Parameter, -Data_) Give current profile data on _Parameter_ for a predicate described diff --git a/pl/protect.yap b/pl/protect.yap index c9ff256e9..02b0a2c89 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -1,4 +1,4 @@ -xc/************************************************************************* +/************************************************************************* * * * YAP Prolog * * * diff --git a/pl/qly.yap b/pl/qly.yap index f044bfd80..e4a39ccd3 100755 --- a/pl/qly.yap +++ b/pl/qly.yap @@ -14,6 +14,9 @@ * comments: fast save/restore * * * *************************************************************************/ + +%% @file qly.yap + :- system_module( '$_qly', [qload_module/1, qsave_file/1, qsave_module/1, @@ -55,6 +58,8 @@ saved. YAP always tries to find saved states from the current directory first. If it cannot it will use the environment variable [YAPLIBDIR](@ref YAPLIBDIR), if defined, or search the default library directory. + +@{ */ /** @pred save_program(+ _F_) @@ -268,6 +273,9 @@ qend_program :- '$do_init_state' :- '$init_from_saved_state_and_args', fail. +'$do_init_state' :- + stream_property(user_input, tty(true)), + set_prolog_flag(readline, true). '$do_init_state'. % @@ -760,7 +768,7 @@ qload_file( F0 ) :- user:'$file_property'( '$lf_loaded'( F, Age, _ ) ), recordaifnot('$source_file','$source_file'( F, Age, SourceModule), _), fail. -'$qload_file'(_S, _SourceModule, File, FilePl, F0, _ImportList, _TOpts) :- +'$qload_file'(_S, _SourceModule, _File, FilePl, F0, _ImportList, _TOpts) :- b_setval('$user_source_file', F0 ), '$process_directives'( FilePl ), fail. @@ -784,3 +792,5 @@ qload_file( F0 ) :- fail. '$process_directives'( _FilePl ) :- abolish(user:'$file_property'/1). + +%% @} \ No newline at end of file diff --git a/pl/setof.yap b/pl/setof.yap index 37b189476..4a29ae632 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -25,9 +25,16 @@ * */ + +:- system_module( '$_setof', [(^)/2, + all/3, + bagof/3, + findall/3, + findall/4, + setof/3], []). + /** -@{ @defgroup Sets Collecting Solutions to a Goal @ingroup builtins @@ -40,41 +47,36 @@ predicates instead of writing his own routines. findall/3 gives you the fastest, but crudest solution. The other built-in predicates post-process the result of the query in several different ways: +@{ */ -:- system_module( '$_setof', [(^)/2, - all/3, - bagof/3, - findall/3, - findall/4, - setof/3], []). - :- use_system_module( '$_boot', ['$catch'/3]). :- use_system_module( '$_errors', ['$do_error'/2]). -% The "existential quantifier" symbol is only significant to bagof -% and setof, which it stops binding the quantified variable. -% op(200, xfy, ^) is defined during bootstrap. - % this is used by the all predicate :- op(50,xfx,same). +%% @pred ^/2 +% +% The "existential quantifier" symbol is only significant to bagof +% and setof, which it stops binding the quantified variable. +% op(200, xfy, ^) is defined during bootstrap. + _^Goal :- '$execute'(Goal). -% findall/3 is a simplified version of bagof which has an implicit -% existential quantifier on every variable. - /** @pred findall( _T_,+ _G_,- _L_) is iso +findall/3 is a simplified version of bagof which has an implicit + existential quantifier on every variable. Unifies _L_ with a list that contains all the instantiations of the term _T_ satisfying the goal _G_. diff --git a/swi/library/debug.pl b/swi/library/debug.pl index e13b76394..cc4e40262 100644 --- a/swi/library/debug.pl +++ b/swi/library/debug.pl @@ -39,7 +39,7 @@ assertion/1 % :Goal ]). -:- use_module(library(error)). +%% :- use_module(library(error)). :- use_module(library(lists)). :- set_prolog_flag(generate_debug_info, false). diff --git a/tmp/foreigns.yap b/tmp/foreigns.yap index 520c6a3bc..590706192 100644 --- a/tmp/foreigns.yap +++ b/tmp/foreigns.yap @@ -625,3 +625,91 @@ sys //2. sys //2. sys //2. sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. +sys //2. diff --git a/utf8proc/CMakeLists.txt b/utf8proc/CMakeLists.txt index 9cd371403..c2e77d0c3 100644 --- a/utf8proc/CMakeLists.txt +++ b/utf8proc/CMakeLists.txt @@ -37,4 +37,5 @@ set_target_properties (utf8proc PROPERTIES install(TARGETS utf8proc - LIBRARY DESTINATION ${libdir} ) + LIBRARY DESTINATION ${libdir} + ARCHIVE DESTINATION ${libdir}) diff --git a/utils/sysgraph b/utils/sysgraph index f06a7d2ee..ab42bbe90 100755 --- a/utils/sysgraph +++ b/utils/sysgraph @@ -11,6 +11,7 @@ :- use_module(library(lists)). :- use_module(library(maplist)). :- use_module(library(system)). +:- use_module(library(hacks)). :- use_module(library(analysis/graphs)). :- use_module(library(analysis/load)). @@ -29,7 +30,8 @@ private/2, module_on/3, exported/1, - dir/2, + dir/1, + sub_dir/2, consulted/2, op_export/3, library/1, @@ -38,8 +40,9 @@ do_comment/5, module_file/2. -% @short node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet +%% @pred node(?Module:module, ?Predicate:pred_indicator, ?File:file, ?Generator:atom) is nondet, dynamic. % +% graph nodes inline( !/0 ). @@ -66,7 +69,8 @@ main :- % 'swi/console'-user 'packages'-user ], -% maplist(distribute(D), Dirs, Paths), +% maplist(distribute(D), Dirs, Paths), + assert(root(D)), load( D, Dirs ), maplist( pl_graphs, Dirs ), fail. @@ -87,7 +91,8 @@ distribute( Root, File-Class, Path-Class) :- atom_concat([Root, /, File], Path ). init :- - retractall(dir(_)), + retractall(dir(_)), + retractall(s8Sadir(_)), retractall(edge(_)), retractall(private(_,_)), retractall(public(_,_)), @@ -127,7 +132,6 @@ doubles :- doubles. undefs :- - trace, format('UNDEFINED procedure calls:~n',[]), setof(M, Target^F^Line^NA^undef( ( Target :- F-M:NA ), Line ), Ms ), member( Mod, Ms ), @@ -201,13 +205,8 @@ remove_escapes([A|Cs], [A|NCs]) :- remove_escapes(Cs, NCs). remove_escapes( [], [] ). -always_strip_module(V, M, V1) :- var(V), !, - V = M:call(V1). -always_strip_module(M0:A, M0, call(A)) :- var(A), !. -always_strip_module(_:M0:A, M1, B) :- !, - always_strip_module(M0:A, M1, B). -always_strip_module(M0:A, M0, call(A)) :- var(A),!. -always_strip_module(M0:A, M0, A). +always_strip_module(V, M, V1) :- + fully_strip_module(V, M, V1). c_links :- open('tmp/foreigns.yap', write, S), @@ -293,108 +292,97 @@ doc( Comment, N ) :- % % % Directories into atoms -search_file( Loc , F, Type, FN ) :- - search_file0( Loc , F, Type, FN ), - !. -search_file( Loc , F, _FN ) :- - format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]), - fail. + +:- dynamic library/1. + +library('..'). + + +:- multifile user:prolog_file_type/2. + +:- dynamic user:prolog_file_type/2. + +prolog_file_type(c, '.c'). +prolog_file_type(c, '.h'). +prolog_file_type(c, '.h.cmake'). +prolog_file_type(c, '.i'). % % handle some special cases. % -search_file0( F, _, _Type, FN ) :- - doexpand(F, FN), !. -search_file0( A/B, F, Type, FN ) :- !, - term_to_atom(A/B, AB), - search_file0( AB, F, Type, FN ). -% libraries can be anywhere in the source. -search_file0( LibLoc, F, Type, FN ) :- - LibLoc =.. [Dir,File], - !, - ( term_to_atom( Dir/File, Full ) ; Full = File ), - search_file0( Full, F, Type, FN ). +search_file( library(boot/F) , LocF, Type, FN ) :- !, + search_file( '..'/pl/F , LocF, Type, FN ). %try to use your base -search_file0( Loc , F, c, FN ) :- - atom_concat( D, '.yap', F), - atom_concat( [ D, '/', Loc], F1), - check_suffix( F1 , c, NLoc ), - absolute_file_name( NLoc, FN), - file_base_name( FN, LocNam), - file_directory_name( FN, D), - dir( D, LocNam ). -search_file0( Loc , F, Type, FN ) :- - file_directory_name( F, FD), - check_suffix( Loc , Type, LocS ), - atom_concat( [ FD, '/', LocS], NLoc), - absolute_file_name( NLoc, FN), - file_base_name( FN, LocNam), - file_directory_name( FN, D), - dir( D, LocNam). -search_file0( Loc , _F, Type, FN ) :- - file_base_name( Loc, Loc0), - file_directory_name( Loc, LocD), - check_suffix( Loc0 , Type, LocS ), - dir( D, LocS), - sub_dir( D, DD), - atom_concat( [ DD, '/', LocD], NLoc), - absolute_file_name( NLoc, D), - atom_concat( [D,'/', LocS], FN). -search_file0( Loc , _F, Type, FN ) :- - file_base_name( Loc, Loc0), - check_suffix( Loc0 , Type, LocS ), - dir( D, LocS), - atom_concat( [D,'/', LocS], FN). -% you try using the parent +search_file( F0, LocF, Type, FN ) :- + filename(F0, F), + file_directory_name(LocF, LOC), + file_directory_name(F, D), + file_base_name(F, F1), + candidate_dir(LOC, '/', D, Left), + absolute_file_name(F1, [ + relative_to(Left), + file_type(Type),file_errors(fail), + access(read) ], FN ). +search_file( Loc , F, _FN ) :- + format('~n~n~n###############~n~n FAILED TO FIND ~w when at ~a~n~n###############~n~n~n', [Loc, F ]), + fail. -sub_dir( D, D ). -sub_dir( D, DD) :- - D \= '/', - atom_concat( D, '/..', DD0), - absolute_file_name( DD0, DDA), - sub_dir( DDA, DD). +candidate_dir( Loc, _, D, Loc) :- + % ensure that the prefix of F, D, is a suffix of Loc + match(D, Loc). +% next, try going down in the current subroot +candidate_dir( Loc, _Source, D, OLoc) :- + sub_dir(Loc, NLoc), + NLoc \= Source, + candidate_dir_down(NLoc, Source, D, OLoc). +% if that fails, go up +candidate_dir( Loc, _Source, D, OLoc) :- + sub_dir(NLoc, Loc), + candidate_dir( NLoc, Loc, D, OLoc). +candidate_dir( Loc, _Source, D, OLoc) :- + root(Loc), + root(NLoc), + NLoc \= Loc, + candidate_dir( NLoc, Loc, D, OLoc). + +candidate_dir_down(Loc, _Source, D, Loc) :- + % ensure that the prefix of F, D, is a suffix of Loc + match(D, Loc). +% next, try going down in the current subroot +candidate_dir( Loc, _Source, D, OLoc) :- + sub_dir(NLoc, Loc), + candidate_dir_down(NLoc, Source, D, OLoc). + +match('.', _Loc) :- !. +match(D, Loc) :- + file_base_name( D, B), + file_base_name( Loc, B), + file_directory_name( D, ND), + file_directory_name( D, NLoc), + match(ND, NLoc). + + +filename(A, A) :- atom(A), !. +filename(A/B, NAB) :- + filename(A, NA), + filename(B, NB), + atom_concat([NA,'/', NB], NAB). +filename( library(A), NAB ) :- + !, + filename(A, NA), + ( + library(L), + atom_concat( [L, '/', NA], NAB) + ; + NAB = NA + ). +filename( S, NAB ) :- + arg(1, S, A), + !, + NAB = NA. % files must be called .yap or .pl % if it is .yap... -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.yap', Loc ), !. -%, otherwise, .pl -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.pl', Loc ), !. -%, otherwise, .prolog -check_suffix( Loc , pl, Loc ) :- - atom_concat( _, '.prolog', Loc ), !. -%, otherwise, .P -% try adding suffix -check_suffix( Loc0 , pl, Loc ) :- - member( Suf , ['.yap', '.ypp', '.pl' , '.prolog']), - atom_concat( Loc0, Suf, Loc ). -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.c', Loc ), !. -%, otherwise, .pl -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.icc', Loc ), !. -%, otherwise, .prolog -check_suffix( Loc , c, Loc ) :- - atom_concat( _, '.cpp', Loc ), !. -%, otherwise, .P -% try adding suffix -check_suffix( Loc0 , c, Loc ) :- - member( Suf , ['.c', '.icc' , '.cpp']), - atom_concat( Loc0, Suf, Loc ). - - - -match_file( LocD, Loc0, Type, FN ) :- - var(LocD), !, - dir( LocD, Loc0 ), - atom_concat( [LocD, '/', Loc0], F ), - absolute_file_name( F, Type, FN ), - exists( FN ). -match_file( SufLocD, Loc0, Type, FN ) :- - dir( LocD, Loc0 ), - atom_concat(_, SufLocD, LocD ), - atom_concat( [LocD, '/', Loc0], Type, FN ). new_op( F, M, op(X,Y,Z) ) :- @@ -406,9 +394,9 @@ new_op( F, M, op( X, Y, Z) ) :- public( F, M, op( X, Y, Z) ). -ypp(F, error(syntax_error(syntax_error),[syntax_error(read(_228515),between(K,L,M),_,_L,_)-_]) ) :- - format('SYNTAX ERROR at file ~a, line ~d (~d - ~d).~n', [F,L,K,M] ), - break. +error(_F, Error) :- + print_message( error, Error ), + fail. preprocess_file(F,NF) :- atom_concat(_, '.ypp', F ), !, @@ -418,19 +406,15 @@ preprocess_file(F,F). %%%%%%% -%% declare a concept export1able -public( F, M, op(X,Y,Z) ) :- - retract( private( F, M:op(X,Y,Z) ) ), - fail. +%% declare a concept exportable public( F, M, op(X,Y,Z) ) :- !, - assert( op_export(F, _M, op(X,Y,Z) ) ), - assert_new( public( F, M:op(X,Y,Z) ) ), ( - ( M == user ; M == prolog ) - -> - op( X, Y, prolog:Z ) - ; - op( X, Y, M:Z ) + assert_new( public( F, op(X,Y,Z) ) ), + directive( op(X,Y,M:Z), F, M ), + retract( private( F, op(X,Y,Z)) ), + fail + ; + true ). public( F, M, M:N/Ar ) :- retract( private( F, M:N/Ar ) ), diff --git a/yap-6.3.anjuta b/yap-6.3.anjuta new file mode 100644 index 000000000..f32fd98be --- /dev/null +++ b/yap-6.3.anjuta @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/yap-6.3.workspace b/yap-6.3.workspace new file mode 100644 index 000000000..d99feaecc --- /dev/null +++ b/yap-6.3.workspace @@ -0,0 +1,14 @@ + + + + + + + + + + + + + + diff --git a/yap-6.project b/yap-6.project new file mode 100644 index 000000000..fbca4ad1d --- /dev/null +++ b/yap-6.project @@ -0,0 +1,1154 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +