Merge branch 'master' of xato:0517

packages/python/swig/yap4py/prolog/pl/absf.yap

@@ -0,0 +1,561 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014	 *
+*									 *
+*************************************************************************/
+
+/**
+
+ @file absf.yap
+ @author L.Damas, V.S.Costa
+
+ @defgroup AbsoluteFileName File Name Resolution
+ @ingroup builtins
+
+ 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.
+
+@{
+
+*/
+:- system_module( absf, [absolute_file_name/2,
+        absolute_file_name/3,
+        add_to_path/1,
+        add_to_path/2,
+        path/1,
+        remove_from_path/1], ['$full_filename'/3,
+        '$system_library_directories'/2]).
+
+
+:- use_system_module( '$_boot', ['$system_catch'/4]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_lists', [member/2]).
+
+/**
+
+@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.
+
+     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.
+*/
+
+absolute_file_name(File,TrueFileName,Opts) :-
+    ( var(TrueFileName) ->
+	    true ;
+      atom(TrueFileName), TrueFileName \= []
+    ),
+    !,
+    absolute_file_name(File,Opts,TrueFileName).
+absolute_file_name(File,Opts,TrueFileName) :-
+    '$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
+
+/**
+  @pred absolute_file_name(+Name:atom,+Path:atom) is nondet
+
+  Converts the given file specification into an absolute path, using default options. See absolute_file_name/3 for details on the options.
+*/
+absolute_file_name(V,Out) :- var(V),
+ !,	% absolute_file_name needs commenting.
+	'$do_error'(instantiation_error, absolute_file_name(V, Out)).
+absolute_file_name(user,user) :- !.
+absolute_file_name(File0,File) :-
+	'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)).
+
+'$full_filename'(F0, F, G) :-
+	'$absolute_file_name'(F0,[access(read),
+                              file_type(prolog),
+                              file_errors(fail),
+                              solutions(first),
+                              expand(true)],F,G).
+
+'$absolute_file_name'(File,LOpts,TrueFileName, G) :-
+				%   must_be_of_type( atom, File ),
+	( var(File) -> instantiation_error(File) ; true),
+	abs_file_parameters(LOpts,Opts),
+	current_prolog_flag(open_expands_filename, OldF),
+	current_prolog_flag( fileerrors, PreviousFileErrors ),
+	current_prolog_flag( verbose_file_search, PreviousVerbose ),
+	get_abs_file_parameter( verbose_file_search, Opts,Verbose ),
+	get_abs_file_parameter( expand, Opts, Expand ),
+	set_prolog_flag( verbose_file_search,  Verbose ),
+	get_abs_file_parameter( file_errors, Opts, FErrors ),
+	get_abs_file_parameter( solutions, Opts, First ),
+	(  FErrors == fail -> FileErrors = false ; FileErrors = true ),
+	set_prolog_flag( fileerrors, FileErrors ),
+	set_prolog_flag(file_name_variables, Expand),
+	'$absf_trace'(File),
+	'$absf_trace_options'(LOpts),
+    HasSol = t(no),
+    (
+     % look for solutions
+         '$find_in_path'(File, Opts,TrueFileName),
+        (     (First == first -> ! ; nb_setarg(1, HasSol, yes) ),
+	           set_prolog_flag( fileerrors, PreviousFileErrors ),
+	           set_prolog_flag( open_expands_filename, OldF),
+	           set_prolog_flag( verbose_file_search, PreviousVerbose ),
+ 	          '$absf_trace'(' |------- found  ~a', [TrueFileName])
+	       ;
+                set_prolog_flag( fileerrors, FileErrors ),
+                set_prolog_flag( verbose_file_search, Verbose ),
+	           set_prolog_flag( file_name_variables, Expand ),
+	           '$absf_trace'(' |------- restarted search for  ~a', [File]),
+	           fail
+         )
+ 	 ;
+	 % finished
+	 %	 	stop_low_level_trace,
+	 '$absf_trace'(' !------- failed.', []),
+	 set_prolog_flag( fileerrors, PreviousFileErrors ),
+	 set_prolog_flag( verbose_file_search, PreviousVerbose ),
+	 set_prolog_flag(file_name_variables, OldF),
+     % check if no solution
+     arg(1,HasSol,no),
+     FileErrors = error,
+	 '$do_error'(existence_error(file,File),G)
+	).
+
+% This sequence must be followed:
+% user and user_input are special;
+% library(F) must check library_directories
+% T(F) must check file_search_path
+% all must try search in path
+'$find_in_path'(user,_,user_input) :- !.
+'$find_in_path'(user_input,_,user_input) :- !.
+'$find_in_path'(user_output,_,user_ouput) :- !.
+'$find_in_path'(user_error,_,user_error) :- !.
+'$find_in_path'(Name, Opts, File) :-
+%    (	atom(Name) -> true ; start_low_level_trace ),
+    get_abs_file_parameter( file_type, Opts, Type ),
+    get_abs_file_parameter( access, Opts, Access ),
+    get_abs_file_parameter( expand, Opts, Expand ),
+    '$absf_trace'('start with ~w', [Name]),
+    '$core_file_name'(Name, Opts, CorePath, []),
+    '$absf_trace'('  after name/library unfolding: ~w', [Name]),
+    '$variable_expansion'(CorePath, Opts,ExpandedPath),
+    '$absf_trace'('   after environment variable expansion: ~s', [ExpandedPath]),
+    '$prefix'(ExpandedPath, Opts, Path , []),
+    '$absf_trace'('    after prefix expansion: ~s', [Path]),
+    atom_codes( APath, Path ),
+    (
+	   Expand = true
+     ->
+	    expand_file_name( APath, EPaths),
+	     '$absf_trace'('     after shell globbing: ~w', [EPaths]),
+	      lists:member(EPath, EPaths)
+     ;
+         EPath = APath
+    ),
+    real_path( EPath, File),
+    '$absf_trace'('      after canonical path name: ~a', [File]),
+    '$check_file'( File, Type, Access ),
+    '$absf_trace'('       after testing ~a for ~a and ~a', [File,Type,Access]).
+
+% allow paths in File Name
+'$core_file_name'(Name, Opts) -->
+    '$file_name'(Name, Opts, E),
+    '$suffix'(E, Opts),
+    '$glob'(Opts).
+
+%
+% handle library(lists) or foreign(jpl)
+%
+'$file_name'(Name, Opts, E) -->
+    { Name =.. [Lib, P0] },
+    !,
+    { user:file_search_path(Lib, IDirs) },
+    { '$paths'(IDirs, Dir ) },
+    '$absf_trace'('  ~w first', [Dir]),
+    '$file_name'(Dir, Opts, _),
+    '$dir',
+    { '$absf_trace'('  ~w next', [P0]) },
+    '$cat_file_name'(P0, E).
+'$file_name'(Name, Opts, E) -->
+    '$cat_file_name'(Name, E ).
+    /*
+    (
+     {
+	get_abs_file_parameter( file_type, Opts, Lib ),
+       nonvar(Lib)
+     }
+     ->
+     { user:file_search_path(Lib, IDirs) },
+    { '$paths'(IDirs, Dir ) },
+    '$absf_trace'('  ~w first', [Dir]),
+    '$file_name'(Dir, Opts, _),
+    '$dir',
+    { '$absf_trace'('  ~w next', [P0]) }
+    ;
+    []
+    ).
+   */
+
+
+'$cat_file_name'(A/B, E	) -->
+    '$cat_file_name'(A, _),
+    '$dir',
+    '$cat_file_name'(B, E).
+'$cat_file_name'(File, F) -->
+    { atom(File), atom_codes(File, F) },
+    !,
+    F.
+'$cat_file_name'(File, S) -->
+    {string(File), string_to_codes(File, S) },
+    !,
+    S.
+
+
+'$variable_expansion'( Path, Opts, APath ) :-
+    get_abs_file_parameter( expand, Opts, true ),
+    !,
+    '$expand_file_name'( Path, APath ).
+'$variable_expansion'( Path, _, Path ).
+
+
+'$var'(S) -->
+    "{", !, '$id'(S), "}".
+'$var'(S) -->
+    '$id'(S).
+
+'$drive'(C) -->
+    '$id'(C),
+    ":\\\\".
+
+'$id'([C|S]) --> [C],
+	     { C >= "a", C =< "z" ;  C >= "A", C =< "Z" ;
+	       C >= "0", C =< "9" ;  C =:= "_" },
+	     !,
+	     '$id'(S).
+'$id'([]) --> [].
+
+
+% always verify if a directory
+'$check_file'(F, directory, _) :-
+	!,
+	exists_directory(F).
+'$check_file'(_F, _Type, none) :- !.
+'$check_file'(F, _Type, exist) :-
+    '$access_file'(F, exist). % if it has a type cannot be a directory..
+'$check_file'(F, _Type, Access) :-
+    '$access_file'(F, Access),
+    \+ exists_directory(F). % if it has a type cannot be a directory..
+
+'$suffix'(Last, _Opts) -->
+    { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) },
+    '$absf_trace'(' suffix in ~s', [Last]),
+    !.
+'$suffix'(_, Opts) -->
+    {
+ 	(
+	    get_abs_file_parameter( extensions, Opts, Exts ),
+	    Exts \= []
+	 ->
+	     lists:member(Ext, Exts),
+	    '$absf_trace'(' trying suffix ~a from ~w', [Ext,Exts])
+	 ;
+	 get_abs_file_parameter( file_type, Opts, Type ),
+	 ( Type == source -> NType = prolog ; NType = Type ),
+	 user:prolog_file_type(Ext, NType)
+	),
+	'$absf_trace'(' trying suffix ~a from type ~a', [Ext, NType]),
+	atom_codes(Ext, Cs)
+    },
+    '$add_suffix'(Cs).
+'$suffix'(_,_Opts) -->
+    '$absf_trace'(' try no suffix', []).
+
+'$add_suffix'(Cs) -->
+    { Cs = [0'. |_Codes] }
+	->
+	    Cs
+	;
+	".", Cs.
+
+'$glob'(Opts) -->
+    {
+	get_abs_file_parameter( glob, Opts, G ),
+	G \= '',
+	atom_codes( G, Gs )
+    },
+    !,
+    '$dir',
+    Gs.
+'$glob'(_Opts) -->
+	[].
+
+'$enumerate_glob'(_File1, [ExpFile], ExpFile) :-
+    !.
+'$enumerate_glob'(_File1, ExpFiles, ExpFile) :-
+    lists:member(ExpFile, ExpFiles),
+    file_base_name( ExpFile, Base ),
+    Base \= '.',
+    Base \='..'.
+
+'$prefix'( CorePath, _Opts) -->
+    { is_absolute_file_name( CorePath ) },
+    !,
+    CorePath.
+'$prefix'( CorePath, Opts) -->
+    {  get_abs_file_parameter( relative_to, Opts, Prefix ),
+       Prefix \= '',
+       '$absf_trace'('    relative_to ~a', [Prefix]),
+       sub_atom(Prefix, _, 1, 0, Last),
+       atom_codes(Prefix, S)
+    },
+    !,
+    S,
+    '$dir'(Last),
+    CorePath.
+'$prefix'( CorePath,  _) -->
+    {
+	recorded('$path',Prefix,_),
+       '$absf_trace'('    try YAP path database ~a', [Prefix]),
+       sub_atom(Prefix, _, _, 1, Last),
+	atom_codes(Prefix, S)    },
+    S,
+    '$dir'(Last),
+    CorePath.
+'$prefix'(CorePath, _ ) -->
+    '$absf_trace'('    empty prefix', []),
+    CorePath.
+
+
+'$dir' --> { current_prolog_flag(windows, true) },
+	   "\\",
+	   !.
+'$dir' --> "/".
+
+'$dir'('/') --> !.
+'$dir'('\\') --> { current_prolog_flag(windows, true) },
+	   !.
+'$dir'(_) --> '$dir'.
+
+%
+%
+%
+'$system_library_directories'(library, Dir) :-
+	user:library_directory( Dir ).
+%	'$split_by_sep'(0, 0, Dirs, Dir).
+'$system_library_directories'(foreign, Dir) :-
+    user:foreign_directory( Dir ).
+% compatibility with old versions
+%
+% search the current directory  first.
+'$system_library_directories'(commons, Dir) :-
+	user:commons_directory( Dir ).
+
+
+% enumerate all paths separated by a path_separator.
+'$paths'(Cs, C) :-
+    
+    atom(Cs),
+    (	current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ),
+    sub_atom(Cs, N0, 1, N, Sep),
+    !,
+    (
+	     sub_atom(Cs,0,N0,_,C)
+     ;
+        sub_atom(Cs,_,N,0,RC),
+        '$paths'(RC, C)
+    ).
+'$paths'(S, S).
+
+'$absf_trace'(Msg, Args ) -->
+    { current_prolog_flag( verbose_file_search, true ) },
+    { print_message( informational, absolute_file_path( Msg, Args ) ) },
+    !.
+'$absf_trace'(_Msg, _Args ) --> [].
+
+'$absf_trace'(Msg, Args ) :-
+    current_prolog_flag( verbose_file_search, true ),
+    print_message( informational, absolute_file_path( Msg, Args ) ),
+    !.
+'$absf_trace'(_Msg, _Args ).
+
+'$absf_trace'( File ) :-
+	current_prolog_flag( verbose_file_search, true ),
+	print_message( informational, absolute_file_path( File ) ),
+	!.
+'$absf_trace'( _File ).
+
+'$absf_trace_options'(Args ) :-
+	current_prolog_flag( verbose_file_search, true ),
+	print_message( informational, arguments( Args ) ),
+	!.
+'$absf_trace_options'( _Args ).
+
+/** @pred prolog_file_name( +File, -PrologFileaNme)
+
+Unify _PrologFileName_ with the Prolog file associated to _File_.
+
+*/
+prolog_file_name(File, PrologFileName) :-
+	var(File), !,
+	'$do_error'(instantiation_error, prolog_file_name(File, PrologFileName)).
+prolog_file_name(user, Out) :- !, Out = user.
+prolog_file_name(File, PrologFileName) :-
+	atom(File), !,
+	system:true_file_name(File, PrologFileName).
+prolog_file_name(File, PrologFileName) :-
+	'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
+
+/**
+  @pred path(-Directories:list) is det,deprecated
+
+ YAP specific procedure that returns a list of user-defined directories
+ in the library search-path.We suggest using user:file_search_path/2 for
+ compatibility with other Prologs.
+*/
+path(Path) :-
+	findall(X,'$in_path'(X),Path).
+
+'$in_path'(X) :-
+	recorded('$path',Path,_),
+	atom_codes(Path,S),
+	( S = ""  -> X = '.' ;
+	  atom_codes(X,S) ).
+
+/**
+  @pred add_to_path(+Directory:atom) is det,deprecated
+
+  YAP-specific predicate to include directory in library search path.
+  We suggest using user:file_search_path/2 for
+  compatibility with other Prologs.
+*/
+add_to_path(New) :-
+	add_to_path(New,last).
+
+/**
+  @pred add_to_path(+Directory:atom, +Position:atom) is det,deprecated
+
+  YAP-specific predicate to include directory in front or back of
+  library search path. We suggest using user:file_search_path/2 for
+  compatibility with other Prologs and more extensive functionality.
+*/
+add_to_path(New,Pos) :-
+	atom(New), !,
+	'$check_path'(New,Str),
+	atom_codes(Path,Str),
+	'$add_to_path'(Path,Pos).
+
+'$add_to_path'(New,_) :-
+	recorded('$path',New,R),
+	erase(R),
+	fail.
+'$add_to_path'(New,last) :-
+	!,
+	recordz('$path',New,_).
+'$add_to_path'(New,first) :-
+	recorda('$path',New,_).
+
+/**  @pred   remove_from_path(+Directory:atom) is det,deprecated
+
+@}
+
+*/
+remove_from_path(New) :- '$check_path'(New,Path),
+			recorded('$path',Path,R), erase(R).
+
+'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt).
+'$check_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).
+

packages/python/swig/yap4py/prolog/pl/arith.yap

@@ -0,0 +1,364 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		arith.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	arithmetical optimization				 *
+*									 *
+*************************************************************************/
+
+                                % the default mode is on
+
+%% @file arith.yap
+
+:- system_module( '$_arith', [compile_expressions/0,
+        expand_exprs/2,
+        plus/3,
+        succ/2], ['$c_built_in'/3]).
+
+:- private( [do_c_built_in/3,
+	     do_c_built_metacall/3,
+	     expand_expr/3,
+	     expand_expr/5,
+	     expand_expr/6] ).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_modules', ['$clean_cuts'/2]).
+
+/** @defgroup CompilerAnalysis Internal Clause Rewriting
+    @ingroup YAPCompilerSettings
+
+  YAP supports several clause optimisation mechanisms, that
+  are designed to improve execution of arithmetic
+  and term construction built-ins. In other words, during the
+  compilation process a clause is rewritten twice:
+
+  1. first, perform user-defined goal_expansion as described
+  in the predicates goal_expansion/1 and goal_expansion/2.
+
+  2. Perform expansion of some built-ins like:
+
+     + pruning operators, like ->/2 and *->/2
+
+     + arithmetic, including early evaluation of constant expressions
+
+     + specialise versions for some built-ins, if we are aware of the
+      run-time execution mode
+
+  The user has some control over this process, through some
+  built-ins and through execution flsgs.
+
+*/
+
+%% @{
+
+/** @pred expand_exprs(- _O_,+ _N_)
+	Control term expansion during compilation.
+
+Enables low-level optimizations. It reports the current state by
+unifying _O_ with the previous state.  It then puts YAP in state _N_
+(`on` or `off`)/ _On_ is equivalent to compile_expressions/0 and `off`
+is equivalent to do_not_compile_expressions/0.
+
+This predicate is useful when debugging, to ensure execution close to the original source.
+
+*/
+expand_exprs(Old,New) :-
+	(get_value('$c_arith',true) ->
+			Old = on ;
+			Old = off ),
+	'$set_arith_expan'(New).
+
+'$set_arith_expan'(on) :- set_value('$c_arith',true).
+'$set_arith_expan'(off) :- set_value('$c_arith',[]).
+
+/**  @pred   compile_expressions
+
+After a call to this predicate, arithmetical expressions will be compiled.
+(see example below). This is the default behavior.
+*/
+
+compile_expressions :- set_value('$c_arith',true).
+
+/**  @pred do_not_compile_expressions
+
+
+After a call to this predicate, arithmetical expressions will not be compiled.
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+?- source, do_not_compile_expressions.
+yes
+?- [user].
+| p(X) :- X is 2 * (3 + 8).
+| :- end_of_file.
+?- compile_expressions.
+yes
+?- [user].
+| q(X) :- X is 2 * (3 + 8).
+| :- end_of_file.
+:- listing.
+
+p(A):-
+      A is 2 * (3 + 8).
+
+q(A):-
+      A is 22.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+*/
+do_not_compile_expressions :- set_value('$c_arith',[]).
+
+'$c_built_in'(IN, M, H, OUT) :-
+	get_value('$c_arith',true), !,
+	do_c_built_in(IN, M, H, OUT).
+'$c_built_in'(IN, _, _H, IN).
+
+
+do_c_built_in(G, M, H, OUT) :- var(G), !,
+	do_c_built_metacall(G, M, H, OUT).
+do_c_built_in(Mod:G, _, H, OUT) :-
+	'$yap_strip_module'(Mod:G, M1,  G1),
+	var(G1), !,
+	do_c_built_metacall(G1, M1, H, OUT).
+do_c_built_in('$do_error'( Error, Goal), M, Head,
+	      (clause_location(Call, Caller),
+	       strip_module(M:Goal,M1,NGoal),
+	       throw(error(Error,
+                       [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]]
+                      )
+                )
+	      )
+	     ) :- !.
+do_c_built_in(X is Y, M, H,  P) :-
+        primitive(X), !,
+	do_c_built_in(X =:= Y, M, H, P).
+do_c_built_in(X is Y, M, H, (P,A=X)) :-
+	nonvar(X), !,
+	do_c_built_in(A is Y, M, H, P).
+do_c_built_in(X is Y, _, _, P) :-
+	nonvar(Y),		% Don't rewrite variables
+	!,
+	(
+		number(Y) ->
+		P = ( X = Y); % This case reduces to an unification
+		expand_expr(Y, P0, X0),
+		'$drop_is'(X0, X, P0, P)
+	).
+do_c_built_in(phrase(NT,Xs),  Mod, H, NTXsNil) :-
+	'$_arith':do_c_built_in(phrase(NT,Xs,[]), Mod, H, NTXsNil).
+do_c_built_in(phrase(NT,Xs0,Xs), Mod, _,  NewGoal) :-
+    '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal ).
+
+do_c_built_in(Comp0, _, _, R) :-		% now, do it for comparisons
+	'$compop'(Comp0, Op, E, F),
+	!,
+	'$compop'(Comp,  Op, U, V),
+	expand_expr(E, P, U),
+	expand_expr(F, Q, V),
+	'$do_and'(P, Q, R0),
+	'$do_and'(R0, Comp, R).
+do_c_built_in(P, _M, _H, P).
+
+do_c_built_metacall(G1, Mod, _, '$execute_wo_mod'(G1,Mod)) :-
+    var(Mod), !.
+do_c_built_metacall(G1, Mod, _, '$execute_in_mod'(G1,Mod)) :-
+    atom(Mod), !.
+do_c_built_metacall(G1, Mod, _, call(Mod:G1)).
+
+'$do_and'(true, P, P) :- !.
+'$do_and'(P, true, P) :- !.
+'$do_and'(P, Q, (P,Q)).
+
+% V is the result of the simplification,
+% X the result of the initial expression
+% and the last argument is how we are writing this result
+'$drop_is'(V, V1, P0, G) :-
+    var(V),
+    !,		% usual case
+    V = V1,
+    P0 = G.
+'$drop_is'(V, X, P0, P) :-			% atoms
+    '$do_and'(P0, X is V, P).
+
+% Table of arithmetic comparisons
+'$compop'(X < Y, < , X, Y).
+'$compop'(X > Y, > , X, Y).
+'$compop'(X=< Y,=< , X, Y).
+'$compop'(X >=Y, >=, X, Y).
+'$compop'(X=:=Y,=:=, X, Y).
+'$compop'(X=\=Y,=\=, X, Y).
+
+'$composed_built_in'(V) :- var(V), !,
+	fail.
+'$composed_built_in'(('$current_choice_point'(_),NG,'$$cut_by'(_))) :- !,
+	'$composed_built_in'(NG).
+'$composed_built_in'((_,_)).
+'$composed_built_in'((_;_)).
+'$composed_built_in'((_|_)).
+'$composed_built_in'((_->_)).
+'$composed_built_in'(_:G) :-
+	'$composed_built_in'(G).
+'$composed_built_in'(\+G) :-
+	'$composed_built_in'(G).
+'$composed_built_in'(not(G)) :-
+	'$composed_built_in'(G).
+
+% expanding an expression:
+% first argument is the expression not expanded,
+% second argument the expanded expression
+% third argument unifies with the result from the expression
+expand_expr(V, true, V) :-
+	var(V), !.
+expand_expr([T], E, V) :- !,
+	expand_expr(T, E, V).
+expand_expr(String, _E, V) :-
+	string( String ), !,
+	string_codes(String, [V]).
+expand_expr(A, true, A) :-
+	atomic(A), !.
+expand_expr(T, E, V) :-
+	T =.. [O, A], !,
+	expand_expr(A, Q, X),
+	expand_expr(O, X, V, Q, E).
+expand_expr(T, E, V) :-
+	T =.. [O, A, B], !,
+	expand_expr(A, Q, X),
+	expand_expr(B, R, Y),
+	expand_expr(O, X, Y, V, Q, S),
+	'$do_and'(R, S, E).
+
+% expanding an expression of the form:
+%	O is Op(X),
+%	after having expanded into Q
+%	and giving as result P (the last argument)
+expand_expr(Op, X, O, Q, Q) :-
+	number(X),
+	catch(is( O, Op, X),_,fail), !. % do not do error handling at compile time
+expand_expr(Op, X, O, Q, P) :-
+	'$unary_op_as_integer'(Op,IOp),
+	'$do_and'(Q, is( O, IOp, X), P).
+
+% expanding an expression of the form:
+%	O is Op(X,Y),
+%	after having expanded into Q
+%	and giving as result P (the last argument)
+%	included is some optimization for:
+%		incrementing and decrementing,
+%		the elementar arithmetic operations [+,-,*,//]
+expand_expr(Op, X, Y, O, Q, Q) :-
+	number(X), number(Y),
+	catch(is( O, Op, X, Y),_,fail), !.
+expand_expr(+, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$plus'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(-, X, Y, O, Q, P) :-
+	var(X), number(Y),
+	Z is -Y, !,
+	expand_expr(+, Z, X, O, Q, P).
+expand_expr(-, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$minus'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(*, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$times'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(//, X, Y, O, Q, P) :-
+	nonvar(Y), Y == 0, !,
+	'$binary_op_as_integer'(//,IOp),
+	'$do_and'(Q, is(O,IOp,X,Y), P).
+expand_expr(//, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$div'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(/\, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$and'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(\/, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$or'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(<<, X, Y, O, Q, P) :-
+	var(X), number(Y), Y < 0,
+	Z is -Y, !,
+	expand_expr(>>, X, Z, O, Q, P).
+expand_expr(<<, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$sll'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(>>, X, Y, O, Q, P) :-
+	var(X), number(Y), Y < 0,
+	Z is -Y, !,
+	expand_expr(<<, X, Z, O, Q, P).
+expand_expr(>>, X, Y, O, Q, P) :- !,
+	'$preprocess_args_for_non_commutative'(X, Y, X1, Y1, E),
+	'$do_and'(E, '$slr'(X1,Y1,O), F),
+	'$do_and'(Q, F, P).
+expand_expr(Op, X, Y, O, Q, P) :-
+	'$binary_op_as_integer'(Op,IOp),
+	'$do_and'(Q, is(O,IOp,X,Y), P).
+
+'$preprocess_args_for_commutative'(X, Y, X, Y, true) :-
+	var(X), var(Y), !.
+'$preprocess_args_for_commutative'(X, Y, X, Y, true) :-
+	var(X), integer(Y), \+ '$bignum'(Y), !.
+'$preprocess_args_for_commutative'(X, Y, X, Z, Z = Y) :-
+	var(X), !.
+'$preprocess_args_for_commutative'(X, Y, Y, X, true) :-
+	integer(X), \+ '$bignum'(X), var(Y), !.
+'$preprocess_args_for_commutative'(X, Y, Z, X, Z = Y) :-
+	integer(X), \+ '$bignum'(X), !.
+'$preprocess_args_for_commutative'(X, Y, Z, W, E) :-
+	'$do_and'(Z = X, Y = W, E).
+
+'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
+	var(X), var(Y), !.
+'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
+	var(X), integer(Y), \+ '$bignum'(Y), !.
+'$preprocess_args_for_non_commutative'(X, Y, X, Z, Z = Y) :-
+	var(X), !.
+'$preprocess_args_for_non_commutative'(X, Y, X, Y, true) :-
+	integer(X), \+ '$bignum'(X), var(Y), !.
+'$preprocess_args_for_non_commutative'(X, Y, X, Z, Z = Y) :-
+	integer(X), \+ '$bignum'(X), !.
+'$preprocess_args_for_non_commutative'(X, Y, Z, W, E) :-
+	'$do_and'(Z = X, Y = W, E).
+
+
+'$goal_expansion_allowed'(phrase(NT,_Xs0,_Xs), Mod) :-
+    callable(NT),
+    atom(Mod).
+
+%%	contains_illegal_dcgnt(+Term) is semidet.
+%
+%	True if Term contains a non-terminal   we cannot deal with using
+%	goal-expansion. The test is too general approximation, but safe.
+
+'$contains_illegal_dcgnt'(NT) :-
+    functor(NT, _, A),
+    between(1, A, I),
+    arg(I, NT, AI),
+    nonvar(AI),
+    ( AI = ! ; AI = phrase(_,_,_) ), !.
+%	write(contains_illegal_nt(NT)),		% JW: we do not want to write
+%	nl.
+
+'$harmless_dcgexception'(instantiation_error).	% ex: phrase(([1],x:X,[3]),L)
+'$harmless_dcgexception'(type_error(callable,_)).	% ex: phrase(27,L)
+
+
+:- set_value('$c_arith',true).
+/**
+  @}
+*/

packages/python/swig/yap4py/prolog/pl/arithpreds.yap

@@ -0,0 +1,168 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+  * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		arithpreds.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	arithmetical predicates				 *
+*									 *
+*************************************************************************/
+
+%% @{
+
+/**
+  @file arithpreds.yap
+
+  @addtogroup arithmetic_preds
+
+
+*/
+
+:- system_module(arithmetic_predicates, [
+        plus/3,
+        succ/2], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+/** @pred succ(? _Int1_:int, ? _Int2_:int) is det
+  *
+
+  True if  _Int2_ =  _Int1_ + 1 and  _Int1_ \>= 0. At least
+  one of the arguments must be instantiated to a natural number. This
+  predicate raises the domain-error not_less_than_zero if called with
+  a negative integer. E.g. `succ(X, 0)` fails silently and `succ(X, -1)`
+  raises a domain-error. The behaviour to deal with natural numbers
+  only was defined by Richard O'Keefe to support the common
+  count-down-to-zero in a natural way.
+
+  */
+
+% M and N nonnegative integers, N is the successor of M
+succ(M,N) :-
+	(
+	 var(M)
+	->
+	 (
+	  integer(N),
+	  N > 0
+	 ->
+	  '$plus'(N,-1,M)
+	 ;
+	  '$succ_error'(M,N)
+	 )
+	;
+	 integer(M),
+	 M >= 0
+	->
+	 (
+	  var(N)
+	 ->
+	 '$plus'(M,1,N)
+	 ;
+	  integer(N),
+	  N > 0
+	 ->
+	 '$plus'(M,1,N)
+	 ;
+	  '$succ_error'(M,N)
+	 )
+	;
+	 '$succ_error'(M,N)
+	).
+
+'$succ_error'(M,N) :-
+	var(M),
+	var(N), !,
+	'$do_error'(instantiation_error,succ(M,N)).
+'$succ_error'(M,N) :-
+	nonvar(M),
+	\+ integer(M),
+	'$do_error'(type_error(integer, M),succ(M,N)).
+'$succ_error'(M,N) :-
+	nonvar(M),
+	M < 0,
+	'$do_error'(domain_error(not_less_than_zero, M),succ(M,N)).
+'$succ_error'(M,N) :-
+	nonvar(N),
+	\+ integer(N),
+	'$do_error'(type_error(integer, N),succ(M,N)).
+'$succ_error'(M,N) :-
+	nonvar(N),
+	N < 0,
+	'$do_error'(domain_error(not_less_than_zero, N),succ(M,N)).
+
+/** @pred plus(? _Int1_:int, ? _Int2_:int, ? _Int3_:int) is det
+
+  True if  _Int3_ =  _Int1_ +  _Int2_. At least two of the
+  three arguments must be instantiated to integers.
+
+  @}
+
+  */
+
+plus(X, Y, Z) :-
+       (
+        var(X)
+       ->
+        (
+         integer(Y), integer(Z)
+        ->
+         '$minus'(Z,Y,X)
+        ;
+         '$plus_error'(X,Y,Z)
+        )
+       ;
+        integer(X)
+       ->
+        (
+         var(Y)
+        ->
+         (
+          integer(Z)
+         ->
+          '$minus'(Z,X,Y)
+         ;
+         '$plus_error'(X,Y,Z)
+         )
+        ;
+         integer(Y)
+        ->
+         (
+          integer(Z)
+         ->
+          '$minus'(Z,Y,X)
+         ;
+          var(Z)
+         ->
+          '$plus'(X,Y,Z)
+         ;
+          '$plus_error'(X,Y,Z)
+         )
+        ;
+         '$plus_error'(X,Y,Z)
+        )
+       ;
+        '$plus_error'(X,Y,Z)
+       ).
+
+'$plus_error'(X,Y,Z) :-
+       nonvar(X),
+       \+ integer(X),
+       '$do_error'(type_error(integer, X),plus(X,Y,Z)).
+'$plus_error'(X,Y,Z) :-
+       nonvar(Y),
+       \+ integer(Y),
+       '$do_error'(type_error(integer, Y),plus(X,Y,Z)).
+'$plus_error'(X,Y,Z) :-
+       nonvar(Z),
+       \+ integer(Z),
+       '$do_error'(type_error(integer, Z),plus(X,Y,Z)).
+'$plus_error'(X,Y,Z) :-
+       '$do_error'(instantiation_error,plus(X,Y,Z)).

packages/python/swig/yap4py/prolog/pl/arrays.yap

@@ -0,0 +1,107 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		arrays.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	Array Manipulation					 *
+*									 *
+*************************************************************************/
+
+%% @{
+
+/**
+@addtogroup YAPArrays
+*/
+%
+% These are the array built-in predicates. They will only work if
+% YAP_ARRAYS is defined in Yap.h
+%
+
+/** @pred  array(+ _Name_, + _Size_)
+
+
+Creates a new dynamic array. The  _Size_ must evaluate to an
+integer. The  _Name_ may be either an atom (named array) or an
+unbound variable (anonymous array).
+
+Dynamic arrays work as standard compound terms, hence space for the
+array is recovered automatically on backtracking.
+
+
+*/
+array(Obj, Size) :-
+	'$create_array'(Obj, Size).
+
+
+% arithmetical optimization
+'$c_arrays'((P:-Q),(NP:-QF)) :- !,
+	'$c_arrays_body'(Q, QI),
+	'$c_arrays_head'(P, NP, QI, QF).
+'$c_arrays'(P, NP) :-
+	'$c_arrays_fact'(P, NP).
+
+'$c_arrays_body'(P, P) :-
+	var(P), !.
+'$c_arrays_body'((P0,Q0), (P,Q)) :- !,
+	'$c_arrays_body'(P0, P),
+	'$c_arrays_body'(Q0, Q).
+'$c_arrays_body'((P0;Q0), (P;Q)) :- !,
+	'$c_arrays_body'(P0, P),
+	'$c_arrays_body'(Q0, Q).
+'$c_arrays_body'((P0->Q0), (P->Q)) :- !,
+	'$c_arrays_body'(P0, P),
+	'$c_arrays_body'(Q0, Q).
+'$c_arrays_body'(P, NP) :- '$c_arrays_lit'(P, NP).
+
+%
+% replace references to arrays to references to built-ins.
+%
+'$c_arrays_lit'(G, GL) :-
+	'$array_references'(G, NG, VL),
+	'$add_array_entries'(VL, NG, GL).
+
+'$c_arrays_head'(G, NG, B, NB) :-
+	'$array_references'(G, NG, VL),
+	'$add_array_entries'(VL, B, NB).
+
+'$c_arrays_fact'(G, NG) :-
+	'$array_references'(G, IG, VL),
+	(VL = [] -> NG = G;
+	    NG = (IG :- NB), '$add_array_entries'(VL, true, NB)).
+
+'$add_array_entries'([], NG, NG).
+'$add_array_entries'([Head|Tail], G, (Head, NG)) :-
+	'$add_array_entries'(Tail, G, NG).
+
+
+/** @pred  static_array_properties(? _Name_, ? _Size_, ? _Type_)
+
+
+Show the properties size and type of a static array with name
+ _Name_. Can also be used to enumerate all current
+static arrays.
+
+This built-in will silently fail if the there is no static array with
+that name.
+
+
+*/
+static_array_properties(Name, Size, Type) :-
+	atom(Name), !,
+	'$static_array_properties'(Name, Size, Type).
+static_array_properties(Name, Size, Type) :-
+	var(Name), !,
+	current_atom(Name),
+	'$static_array_properties'(Name, Size, Type).
+static_array_properties(Name, Size, Type) :-
+	'$do_error'(type_error(atom,Name),static_array_properties(Name,Size,Type)).
+
+%% @}

packages/python/swig/yap4py/prolog/pl/atoms.yap

@@ -0,0 +1,211 @@
+ /*************************************************************************
+ *									 *
+ *	 YAP Prolog 							 *
+ *									 *
+ *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+ *									 *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2014	 *
+ *									 *
+ *************************************************************************/
+
+/**
+ * @file atoms.yap
+ *
+ */
+
+:- system_module( '$_atoms', [
+			      atom_concat/2,
+			      string_concat/2,
+        atomic_list_concat/2,
+        atomic_list_concat/3,
+        current_atom/1], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+
+/**
+ * @addtogroup Predicates_on_Atoms
+ *
+*/
+
+/** @pred  atom_concat(+ As, ? A)
+
+
+The predicate holds when the first argument is a list of atoms, and the
+second unifies with the atom obtained by concatenating all the atoms in
+the first list.
+
+
+*/
+atom_concat(Xs,At) :-
+	( var(At) ->
+	   '$atom_concat'(Xs, At )
+        ;
+	 '$atom_concat_constraints'(Xs, 0, At, Unbound),
+	 '$process_atom_holes'(Unbound)
+        ).
+
+% the constraints are of the form hole: HoleAtom, Begin, Atom, End
+'$atom_concat_constraints'([At], 0, At, []) :- !.
+'$atom_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :-  !.
+% just slice first atom
+'$atom_concat_constraints'([At0|Xs], 0, At, Unbound) :-
+	atom(At0), !,
+	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
+'$atom_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
+	 '$atom_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
+% end of a run
+'$atom_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
+	atom(At0), !,
+	sub_atom(At, Next, _Sz, L, At0),
+	sub_atom(At, 0, Next, Next, At1),
+	sub_atom(At, _, L, 0, Atr), %remainder
+	'$atom_concat_constraints'(Xs, 0, Atr, Unbound).
+'$atom_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
+	 '$atom_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
+
+'$process_atom_holes'([]).
+'$process_atom_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
+	sub_atom(At1, Next, _, 0, At0),
+	 '$process_atom_holes'(Unbound).
+'$process_atom_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
+	sub_atom(At1, Next, Sz, _Left, At0),
+	Follow is Next+Sz,
+	 '$process_atom_holes'(Unbound).
+
+
+/** @pred  atomic_list_concat(+ _As_,? _A_)
+
+
+The predicate holds when the first argument is a list of atomic terms, and
+the second unifies with the atom obtained by concatenating all the
+atomic terms in the first list. The first argument thus may contain
+atoms or numbers.
+
+
+*/
+atomic_list_concat(L,At) :-
+	atomic_concat(L, At).
+
+/** @pred  atomic_list_concat(? _As_,+ _Separator_,? _A_)
+
+Creates an atom just like atomic_list_concat/2, but inserts
+ _Separator_ between each pair of atoms. For example:
+
+~~~~~{.prolog}
+?- atomic_list_concat([gnu, gnat], `, `, A).
+
+A = `gnu, gnat`
+~~~~~
+
+YAP emulates the SWI-Prolog version of this predicate that can also be
+used to split atoms by instantiating  _Separator_ and  _Atom_ as
+shown below.
+
+~~~~~{.prolog}
+?- atomic_list_concat(L, -, 'gnu-gnat').
+
+L = [gnu, gnat]
+~~~~~
+
+
+*/
+atomic_list_concat(L, El, At) :-
+	var(El), !,
+	'$do_error'(instantiation_error,atomic_list_concat(L,El,At)).
+atomic_list_concat(L, El, At) :-
+	ground(L), !,
+	'$add_els'(L,El,LEl),
+	atomic_concat(LEl, At).
+atomic_list_concat(L, El, At) :-
+	nonvar(At), !,
+	'$atomic_list_concat_all'( At, El, L).
+
+'$atomic_list_concat_all'( At, El, [A|L]) :-
+	sub_atom(At, Pos, 1, Left, El), !,
+        sub_atom(At, 0, Pos, _, A),
+        sub_atom(At, _, Left, 0, At1),
+	'$atomic_list_concat_all'( At1, El, L).
+'$atomic_list_concat_all'( At, _El, [At]).
+
+'$add_els'([A,B|L],El,[A,El|NL]) :- !,
+	'$add_els'([B|L],El,NL).
+'$add_els'(L,_,L).
+
+
+%
+% small compatibility hack
+
+'$singletons_in_term'(T,VL) :-
+	'$variables_in_term'(T,[],V10),
+	'$sort'(V10, V1),
+	'$non_singletons_in_term'(T,[],V20),
+	'$sort'(V20, V2),
+	'$subtract_lists_of_variables'(V2,V1,VL).
+
+'$subtract_lists_of_variables'([],VL,VL).
+'$subtract_lists_of_variables'([_|_],[],[]) :- !.
+'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],VL) :-
+	V1 == V2, !,
+	'$subtract_lists_of_variables'(VL1,VL2,VL).
+'$subtract_lists_of_variables'([V1|VL1],[V2|VL2],[V2|VL]) :-
+	'$subtract_lists_of_variables'([V1|VL1],VL2,VL).
+
+/** @pred  current_atom( _A_)
+
+
+Checks whether  _A_ is a currently defined atom. It is used to find all
+currently defined atoms by backtracking.
+
+
+*/
+current_atom(A) :-				% check
+	atom(A), !.
+current_atom(A) :-				% generate
+	'$current_atom'(A).
+
+string_concat(Xs,At) :-
+	( var(At) ->
+	   '$string_concat'(Xs, At )
+        ;
+	 '$string_concat_constraints'(Xs, 0, At, Unbound),
+	 '$process_string_holes'(Unbound)
+        ).
+
+% the constraints are of the form hole: HoleString, Begin, String, End
+'$string_concat_constraints'([At], 0, At, []) :- !.
+'$string_concat_constraints'([At0], mid(Next, At), At, [hole(At0, Next, At, end)]) :-  !.
+% just slice first string
+'$string_concat_constraints'([At0|Xs], 0, At, Unbound) :-
+	string(At0), !,
+	sub_string(At, 0, _Sz, L, At0 ),
+	sub_string(At, _, L, 0, Atr ), %remainder
+	'$string_concat_constraints'(Xs, 0, Atr, Unbound).
+% first hole: Follow says whether we have two holes in a row, At1 will be our string
+'$string_concat_constraints'([At0|Xs], 0, At, [hole(At0, 0, At, Next)|Unbound]) :-
+	 '$string_concat_constraints'(Xs, mid(Next,_At1), At, Unbound).
+% end of a run
+'$string_concat_constraints'([At0|Xs], mid(end, At1), At, Unbound) :-
+	string(At0), !,
+	sub_string(At, Next, _Sz, L, At0),
+	sub_string(At, 0, Next, Next, At1),
+	sub_string(At, _, L, 0, Atr), %remainder
+	'$string_concat_constraints'(Xs, 0, Atr, Unbound).
+'$string_concat_constraints'([At0|Xs], mid(Next,At1), At, Next, [hole(At0, Next, At, Follow)|Unbound]) :-
+	 '$string_concat_constraints'(Xs, mid(Follow, At1), At, Unbound).
+
+'$process_string_holes'([]).
+'$process_string_holes'([hole(At0, Next, At1, End)|Unbound]) :- End == end, !,
+	sub_string(At1, Next, _, 0, At0),
+	 '$process_string_holes'(Unbound).
+'$process_string_holes'([hole(At0, Next, At1, Follow)|Unbound]) :-
+	sub_string(At1, Next, Sz, _Left, At0),
+	Follow is Next+Sz,
+	 '$process_string_holes'(Unbound).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/attributes.yap

@@ -0,0 +1,515 @@
+pattr/*************************************************************************
+*									 *
+  *	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		atts.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	attribute support for Prolog				 *
+*									 *
+*************************************************************************/
+
+/**
+  @file attributes.yap
+
+@defgroup New_Style_Attribute_Declarations SWI Compatible attributes
+@{
+@ingroup attributes
+
+*/
+
+:- module('attributes', [delayed_goals/4]).
+
+:- use_system_module( '$_boot', ['$undefp'/1]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$coroutining', [attr_unify_hook/2]).
+
+:- use_system_module( attributes, [all_attvars/1,
+        bind_attvar/1,
+        del_all_atts/1,
+        del_all_module_atts/2,
+        get_all_swi_atts/2,
+        get_module_atts/2,
+        modules_with_attributes/1,
+        put_att_term/2,
+        put_module_atts/2,
+        unbind_attvar/1,
+        woken_att_do/4]).
+
+:- dynamic attributes:existing_attribute/4.
+:- dynamic attributes:modules_with_attributes/1.
+:- dynamic attributes:attributed_module/3.
+
+    :- multifile
+        attributes:attributed_module/3.
+
+:- dynamic existing_attribute/4.
+:- dynamic modules_with_attributes/1.
+:- dynamic attributed_module/3.
+
+
+/** @pred get_attr(+ _Var_,+ _Module_,- _Value_)
+
+Request the current  _value_ for the attribute named  _Module_.  If
+ _Var_ is not an attributed variable or the named attribute is not
+associated to  _Var_ this predicate fails silently.  If  _Module_
+is not an atom, a type error is raised.
+
+
+*/
+prolog:get_attr(Var, Mod, Att) :-
+	functor(AttTerm, Mod, 2),
+	arg(2, AttTerm, Att),
+	attributes:get_module_atts(Var, AttTerm).
+
+/**
+ @pred put_attr(+ _Var_,+ _Module_,+ _Value_)
+
+If  _Var_ is a variable or attributed variable, set the value for the
+attribute named  _Module_ to  _Value_. If an attribute with this
+name is already associated with  _Var_, the old value is replaced.
+Backtracking will restore the old value (i.e., an attribute is a mutable
+term. See also `setarg/3`). This predicate raises a representation error if
+ _Var_ is not a variable and a type error if  _Module_ is not an atom.
+
+
+*/
+prolog:put_attr(Var, Mod, Att) :-
+	functor(AttTerm, Mod, 2),
+	arg(2, AttTerm, Att),
+	attributes:put_module_atts(Var, AttTerm).
+
+/** @pred del_attr(+ _Var_,+ _Module_)
+
+
+Delete the named attribute.  If  _Var_ loses its last attribute it
+is transformed back into a traditional Prolog variable.  If  _Module_
+is not an atom, a type error is raised. In all other cases this
+predicate succeeds regardless whether or not the named attribute is
+present.
+
+
+*/
+prolog:del_attr(Var, Mod) :-
+	functor(AttTerm, Mod, 2),
+	attributes:del_all_module_atts(Var, AttTerm).
+
+/** @pred del_attrs(+ _Var_)
+
+
+If  _Var_ is an attributed variable, delete <em>all</em> its
+attributes.  In all other cases, this predicate succeeds without
+side-effects.
+
+
+*/
+prolog:del_attrs(Var) :-
+	attributes:del_all_atts(Var).
+
+/**
+ @pred get_attrs(+ _Var_,- _Attributes_)
+
+Get all attributes of  _Var_.  _Attributes_ is a term of the form
+`att( _Module_,  _Value_,  _MoreAttributes_)`, where  _MoreAttributes_ is
+`[]` for the last attribute.
+
+*/
+prolog:get_attrs(AttVar, SWIAtts) :-
+	attributes:get_all_swi_atts(AttVar,SWIAtts).
+
+/** @pred put_attrs(+ _Var_,+ _Attributes_)
+
+
+Set all attributes of  _Var_.  See get_attrs/2 for a description of
+ _Attributes_.
+
+
+*/
+prolog:put_attrs(_, []).
+prolog:put_attrs(V, Atts) :-
+	cvt_to_swi_atts(Atts, YapAtts),
+	attributes:put_att_term(V, YapAtts).
+
+cvt_to_swi_atts([], _).
+cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
+	ModAttribute =.. [Mod, YapAtts, Attribute],
+	cvt_to_swi_atts(Atts, YapAtts).
+
+/** @pred copy_term(? _TI_,- _TF_,- _Goals_)
+
+Term  _TF_ is a variant of the original term  _TI_, such that for
+each variable  _V_ in the term  _TI_ there is a new variable  _V'_
+in term  _TF_ without any attributes attached.  Attributed
+variables are thus converted to standard variables.   _Goals_ is
+unified with a list that represents the attributes.  The goal
+`maplist(call, _Goals_)` can be called to recreate the
+attributes.
+
+Before the actual copying, `copy_term/3` calls
+`attribute_goals/1` in the module where the attribute is
+defined.
+
+
+*/
+prolog:copy_term(Term, Copy, Gs) :-
+	term_attvars(Term, Vs),
+	(   Vs == []
+	->  Gs = [],
+	    copy_term(Term, Copy)
+	;   findall(Term-Gs,
+	            '$attributes':residuals_and_delete_attributes(Vs, Gs, Term),
+		    [Copy-Gs])
+	).
+
+residuals_and_delete_attributes(Vs, Gs, Term) :-
+	attvars_residuals(Vs, Gs, []),
+	delete_attributes(Term).
+
+attvars_residuals([]) --> [].
+attvars_residuals([V|Vs]) -->
+	{ nonvar(V) }, !,
+	attvars_residuals(Vs).
+attvars_residuals([V|Vs]) -->
+	(   { get_attrs(V, As) }
+	->  attvar_residuals(As, V)
+	;   []
+	),
+	attvars_residuals(Vs).
+
+%
+% wake_up_goal is called by the system whenever a suspended goal
+% resumes.
+%
+
+/* The first case may happen if this variable was used for dif.
+   In this case, we need a way to keep the original
+   suspended goal around
+*/
+%'$wake_up_goal'([Module1|Continuation],G) :-
+%	'$write'(4,vsc_woke:G+[Module1|Continuation]:'
+%'), fail.
+prolog:'$wake_up_goal'([Module1|Continuation], LG) :-
+%	writeln( [Module1|Continuation]:LG),
+	execute_woken_system_goals(LG),
+	do_continuation(Continuation, Module1).
+
+
+%
+% in the first two cases restore register  immediately and proceed
+% to continuation. In the last case take care with modules, but do
+% not act as if a meta-call.
+%
+%
+do_continuation('$cut_by'(X), _) :- !,
+	'$$cut_by'(X).
+do_continuation('$restore_regs'(X), _) :- !,
+%	yap_flag(gc_trace,verbose),
+%	garbage_collect,
+	'$restore_regs'(X).
+do_continuation('$restore_regs'(X,Y), _) :- !,
+%	yap_flag(gc_trace,verbose),
+%	garbage_collect,
+	'$restore_regs'(X,Y).
+do_continuation(Continuation, Module1) :-
+	execute_continuation(Continuation,Module1).
+
+execute_continuation(Continuation, Module1) :-
+	'$undefined'(Continuation, Module1), !,
+	'$current_module'( M ),
+	current_prolog_flag( M:unknown, Default ),
+        '$undefp'([Module1|Continuation] , Default ).
+execute_continuation(Continuation, Mod) :-
+         % do not do meta-expansion nor any fancy stuff.
+	'$execute0'(Continuation, Mod).
+
+
+execute_woken_system_goals([]).
+execute_woken_system_goals(['$att_do'(V,New)|LG]) :-
+	execute_woken_system_goals(LG),
+	call_atts(V,New).
+
+%
+% what to do when an attribute gets bound
+%
+call_atts(V,_) :-
+	nonvar(V), !.
+call_atts(V,_) :-
+	'$att_bound'(V), !.
+call_atts(V,New) :-
+	attributes:get_all_swi_atts(V,SWIAtts),
+	(
+	 '$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes)
+	->
+	 LGoals = [],
+	 DoNotBind = false
+	;
+	 attributes:woken_att_do(V, New, LGoals, DoNotBind)
+	),
+	( DoNotBind == true
+	->
+	  attributes:unbind_attvar(V)
+	;
+	  attributes:bind_attvar(V)
+	),
+	do_hook_attributes(SWIAtts, New),
+	lcall(LGoals).
+
+do_hook_attributes([], _).
+do_hook_attributes(att(Mod,Att,Atts), Binding) :-
+	('$undefined'(attr_unify_hook(Att,Binding), Mod)
+	->
+	 true
+	;
+	 Mod:attr_unify_hook(Att, Binding)
+	),
+	do_hook_attributes(Atts, Binding).
+
+
+lcall([]).
+lcall([Mod:Gls|Goals]) :-
+	lcall2(Gls,Mod),
+	lcall(Goals).
+
+lcall2([], _).
+lcall2([Goal|Goals], Mod) :-
+	call(Mod:Goal),
+	lcall2(Goals, Mod).
+
+
+
+/** @pred call_residue_vars(: _G_, _L_)
+
+
+
+Call goal  _G_ and unify  _L_ with a list of all constrained variables created <em>during</em> execution of  _G_:
+
+~~~~~
+  ?- dif(X,Z), call_residue_vars(dif(X,Y),L).
+dif(X,Z), call_residue_vars(dif(X,Y),L).
+L = [Y],
+dif(X,Z),
+dif(X,Y) ? ;
+
+no
+~~~~~
+ */
+prolog:call_residue_vars(Goal,Residue) :-
+	attributes:all_attvars(Vs0),
+	call(Goal),
+	attributes:all_attvars(Vs),
+	% this should not be actually strictly necessary right now.
+	% but it makes it a safe bet.
+	sort(Vs, Vss),
+	sort(Vs0, Vs0s),
+	'$ord_remove'(Vss, Vs0s, Residue).
+
+'$ord_remove'([], _, []).
+'$ord_remove'([V|Vs], [], [V|Vs]).
+'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
+	( V1 == V2 ->
+	  '$ord_remove'(Vss, Vs0s, Residue)
+	;
+	  V1 @< V2 ->
+	  Residue = [V1|ResidueF],
+	  '$ord_remove'(Vss, [V2|Vs0s], ResidueF)
+	;
+	  '$ord_remove'([V1|Vss], Vs0s, Residue)
+	).
+
+/** @pred attribute_goals(+ _Var_,- _Gs_,+ _GsRest_)
+
+
+
+This nonterminal, if it is defined in a module, is used by  _copy_term/3_
+to project attributes of that module to residual goals. It is also
+used by the toplevel to obtain residual goals after executing a query.
+
+
+Normal user code should deal with put_attr/3, get_attr/3 and del_attr/2.
+The routines in this section fetch or set the entire attribute list of a
+variables. Use of these predicates is anticipated to be restricted to
+printing and other special purpose operations.
+
+*/
+
+/** @pred _Module_:attribute_goal( _-Var_,  _-Goal_)
+
+User-defined procedure, called to convert the attributes in  _Var_ to
+a  _Goal_. Should fail when no interpretation is available.
+ */
+attvar_residuals(att(Module,Value,As), V) -->
+	(   { nonvar(V) }
+	->  % a previous projection predicate could have instantiated
+	    % this variable, for example, to avoid redundant goals
+	    []
+	;     generate_goals(  V, As, Value,  Module)
+    ).
+
+    generate_goals( V, _, Value, Module) -->
+        { attributes:module_has_attributes(Module)  },
+    	    %  like run, put attributes back first
+    	    { Value =.. [Name,_|Vs],
+    	      NValue =.. [Name,_|Vs],
+    	      attributes:put_module_atts(V,NValue)
+    	    },
+        { current_predicate(Module:attribute_goal/2) },
+		 { call(Module:attribute_goal(V, Goal)) },
+	      dot_list(Goal),
+          [put_attr(V, Module, Value)].
+    generate_goals( V, _, _Value   , Module) -->
+        { '$pred_exists'(attribute_goals(_,_,_), Module) },
+	    call(Module:attribute_goals(V) ).
+
+
+    attributes:module_has_attributes(Mod) :-
+        attributes:attributed_module(Mod, _, _), !.
+
+
+list([])     --> [].
+list([L|Ls]) --> [L], list(Ls).
+
+dot_list((A,B)) --> !, dot_list(A), dot_list(B).
+dot_list(A)	--> [A].
+
+delete_attributes(Term) :-
+	term_attvars(Term, Vs),
+	delete_attributes_(Vs).
+
+delete_attributes_([]).
+delete_attributes_([V|Vs]) :-
+	del_attrs(V),
+	delete_attributes_(Vs).
+
+
+
+/** @pred call_residue(: _G_, _L_)
+
+
+
+Call goal  _G_. If subgoals of  _G_ are still blocked, return
+a list containing these goals and the variables they are blocked in. The
+goals are then considered as unblocked. The next example shows a case
+where dif/2 suspends twice, once outside call_residue/2,
+and the other inside:
+
+~~~~~
+?- dif(X,Y),
+       call_residue((dif(X,Y),(X = f(Z) ; Y = f(Z))), L).
+
+X = f(Z),
+L = [[Y]-dif(f(Z),Y)],
+dif(f(Z),Y) ? ;
+
+Y = f(Z),
+L = [[X]-dif(X,f(Z))],
+dif(X,f(Z)) ? ;
+
+no
+~~~~~
+The system only reports one invocation of dif/2 as having
+suspended.
+
+
+*/
+prolog:call_residue(Goal,Residue) :-
+	var(Goal), !,
+	'$do_error'(instantiation_error,call_residue(Goal,Residue)).
+prolog:call_residue(Module:Goal,Residue) :-
+	atom(Module), !,
+	call_residue(Goal,Module,Residue).
+prolog:call_residue(Goal,Residue) :-
+	'$current_module'(Module),
+	call_residue(Goal,Module,Residue).
+
+call_residue(Goal,Module,Residue) :-
+	prolog:call_residue_vars(Module:Goal,NewAttVars),
+	(
+	 attributes:modules_with_attributes([_|_])
+	->
+	 project_attributes(NewAttVars, Module:Goal)
+	;
+	 true
+	),
+	copy_term(Goal, Goal, Residue).
+
+attributes:delayed_goals(G, Vs, NVs, Gs) :-
+	project_delayed_goals(G),
+%	term_factorized([G|Vs], [_|NVs], Gs).
+	copy_term([G|Vs], [_|NVs], Gs).
+
+project_delayed_goals(G) :-
+% SICStus compatible step,
+% just try to simplify store  by projecting constraints
+% over query variables.
+% called by top_level to find out about delayed goals
+	attributes:modules_with_attributes([_|_]), !,
+	attributes:all_attvars(LAV),
+	LAV = [_|_],
+	project_attributes(LAV, G), !.
+project_delayed_goals(_).
+
+
+attributed(G, Vs) :-
+	term_variables(G, LAV),
+	att_vars(LAV, Vs).
+
+att_vars([], []).
+att_vars([V|LGs], [V|AttVars]) :- attvar(V), !,
+	att_vars(LGs, AttVars).
+att_vars([_|LGs], AttVars) :-
+	att_vars(LGs, AttVars).
+
+% make sure we set the suspended goal list to its previous state!
+% make sure we have installed a SICStus like constraint solver.
+
+/** @pred _Module_:project_attributes(+AttrVars, +Goal)
+
+
+
+Given a goal _Goa]l_ with variables  _QueryVars_ and list of attributed
+variables  _AttrVars_, project all attributes in  _AttrVars_ to
+ _QueryVars_. Although projection is constraint system dependent,
+typically this will involve expressing all constraints in terms of
+ _QueryVars_ and considering all remaining variables as existentially
+quantified.
+
+Projection interacts with attribute_goal/2 at the Prolog top
+level. When the query succeeds, the system first calls
+project_attributes/2. The system then calls
+attribute_goal/2 to get a user-level representation of the
+constraints. Typically, project_attributes/2 will convert from the
+original constraints into a set of new constraints on the projection,
+and these constraints are the ones that will have an
+attribute_goal/2 handler.
+ */
+project_attributes(AllVs, G) :-
+	attributes:modules_with_attributes(LMods),
+	LMods = [_|_],
+	term_variables(G, InputVs),
+	pick_att_vars(InputVs, AttIVs),
+	project_module(LMods, AttIVs, AllVs).
+
+pick_att_vars([],[]).
+pick_att_vars([V|L],[V|NL]) :- attvar(V), !,
+	pick_att_vars(L,NL).
+pick_att_vars([_|L],NL) :-
+	pick_att_vars(L,NL).
+
+project_module([], _, _).
+project_module([Mod|LMods], LIV, LAV) :-
+	'$pred_exists'(project_attributes(LIV, LAV),Mod),
+	call(Mod:project_attributes(LIV, LAV)), !,
+	attributes:all_attvars(NLAV),
+	project_module(LMods,LIV,NLAV).
+project_module([_|LMods], LIV, LAV) :-
+	project_module(LMods,LIV,LAV).
+
+%% @}

packages/python/swig/yap4py/prolog/pl/bootlists.yap

@@ -0,0 +1,140 @@
+/**
+ * @file   bootlists.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Thu Nov 19 09:54:00 2015
+ *
+ * @addtogroup lists
+ * @{
+*/
+
+:- system_module( '$_lists', [], []).
+
+:- set_prolog_flag(source, true). % source.
+
+%   memberchk(+Element, +Set)
+%   means the same thing, but may only be used to test whether a known
+%   Element occurs in a known Set.  In return for this limited use, it
+%   is more efficient when it is applicable.
+/** @pred memberchk(+ _Element_, + _Set_)
+
+
+As member/2, but may only be used to test whether a known
+ _Element_ occurs in a known Set.  In return for this limited use, it
+is more efficient when it is applicable.
+
+
+*/
+lists:memberchk(X,[X|_]) :- !.
+lists:memberchk(X,[_|L]) :-
+       lists:memberchk(X,L).
+
+%%  member(?Element, ?Set)
+%   is true when Set is a list, and Element occurs in it.  It may be used
+%   to test for an element or to enumerate all the elements by backtracking.
+%   Indeed, it may be used to generate the Set!
+
+/** @pred member(? _Element_, ? _Set_)
+
+
+True when  _Set_ is a list, and  _Element_ occurs in it.  It may be used
+to test for an element or to enumerate all the elements by backtracking.
+
+
+*/
+lists:member(X,[X|_]).
+lists:member(X,[_|L]) :-
+       lists:member(X,L).
+
+%% @pred  identical_member(?Element, ?Set) is nondet
+%
+% identical_member holds true when Set is a list, and Element is
+% exactly identical to one of the elements that occurs in it.
+
+lists:identical_member(X,[Y|M]) :-
+       (
+        X == Y
+       ;
+        M \= [], lists:identical_member(X,M)
+       ).
+
+/**  @pred append(? _List1_,? _List2_,? _List3_)
+
+
+Succeeds when  _List3_ unifies with the concatenation of  _List1_
+and  _List2_. The predicate can be used with any instantiation
+pattern (even three variables).
+
+
+*/
+lists:append([], L, L).
+lists:append([H|T], L, [H|R]) :-
+       lists:append(T, L, R).
+
+
+:- 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
+%   Residue is a copy of List with all elements identical to Elem lists:deleted.
+
+/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
+
+eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
+True when  _List_ is a list, in which  _Element_ may or may not
+occur, and  _Residue_ is a copy of  _List_ with all elements
+identical to  _Element_ deleted.
+
+eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
+*/
+lists:delete([], _, []).
+lists:delete([Head|List], Elem, Residue) :-
+       Head = Elem,
+       lists:delete(List, Elem, Residue).
+lists:delete([Head|List], Elem, [Head|Residue]) :-
+       lists:delete(List, Elem, Residue).
+
+:- set_prolog_flag(source, false). % disable source.
+
+
+
+%   length of a list.
+
+/** @pred  length(? _L_,? _S_)
+
+
+Unify the well-defined list  _L_ with its length. The procedure can
+be used to find the length of a pre-defined list, or to build a list
+of length  _S_.
+
+*/
+
+prolog:length(L, M) :-
+    '$skip_list'(L, M, M0, R),
+         ( var(R) -> '$$_length'(R, M, M0) ;
+           R == []
+         ).
+
+%
+% in case A1 is unbound or a difference list, things get tricky
+%
+'$$_length'(R, M, M0) :-
+       ( var(M) -> '$$_length1'(R,M,M0)
+       ; M >= M0 -> '$$_length2'(R,M,M0) ).
+
+%
+% Size is unbound, generate lists
+%
+'$$_length1'([], M, M).
+'$$_length1'([_|L], O, N) :-
+       M is N + 1,
+       '$$_length1'(L, O, M).
+
+%
+% Size is bound, generate single list
+%
+'$$_length2'(NL, O, N) :-
+       ( N =:= O -> NL = [];
+          M is N + 1, NL  = [_|L], '$$_length2'(L, O, M) ).
+
+%% @}
+

packages/python/swig/yap4py/prolog/pl/callcount.yap

@@ -0,0 +1,152 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		callcount.yap						 *
+* Last rev:	8/2/02							 *
+* mods:									 *
+* comments:	Some profiling predicates available in yap		 *
+*									 *
+*************************************************************************/
+
+%% @{
+
+/** @defgroup Profiling Profiling Prolog Programs
+@ingroup extensions
+  
+YAP includes two profilers. The count profiler keeps information on the
+number of times a predicate was called. This information can be used to
+detect what are the most commonly called predicates in the program.  The
+count profiler can be compiled by setting YAP's flag profiling
+to `on`. The time-profiler is a `gprof` profiler, and counts
+how many ticks are being spent on specific predicates, or on other
+system functions such as internal data-base accesses or garbage collects.
+
+The YAP profiling sub-system is currently under
+development. Functionality for this sub-system will increase with newer
+implementation.
+
+
+ */
+
+%% @{  
+
+/** @defgroup Call_Counting Counting Calls
+@ingroup Profiling
+  
+Predicates compiled with YAP's flag call_counting set to
+`on` update counters on the numbers of calls and of
+retries. Counters are actually decreasing counters, so that they can be
+used as timers.  Three counters are available:
+
++ `calls`: number of predicate calls since execution started or since
+system was reset; 
++ `retries`: number of retries for predicates called since
+execution started or since counters were reset;
++ `calls_and_retries`: count both on predicate calls and
+retries.
+
+These counters can be used to find out how many calls a certain
+goal takes to execute. They can also be used as timers.
+
+The code for the call counters piggybacks on the profiling
+code. Therefore, activating the call counters also activates the profiling
+counters.
+
+These are  the predicates that access and manipulate the call counters. 
+*/
+
+:- system_module( '$_callcount', [call_count/3,
+        call_count_data/3,
+        call_count_reset/0], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+
+/** @pred  call_count_data(- _Calls_, - _Retries_, - _CallsAndRetries_) 
+
+
+Give current call count data. The first argument gives the current value
+for the  _Calls_ counter, next the  _Retries_ counter, and last
+the  _CallsAndRetries_ counter.
+ 
+*/
+call_count_data(Calls, Retries, Both) :-
+	'$call_count_info'(Calls, Retries, Both).
+
+/** @pred  call_count_reset 
+
+
+Reset call count counters. All timers are also reset.
+
+*/
+call_count_reset :-
+	'$call_count_reset'.
+
+/** @pred  call_count(? _CallsMax_, ? _RetriesMax_, ? _CallsAndRetriesMax_) 
+
+
+Set call counters as timers. YAP will generate an exception
+if one of the instantiated call counters decreases to 0:
+
++ _CallsMax_
+
+    throw the exception `call_counter` when the
+counter `calls` reaches 0;
+
++ _RetriesMax_
+
+    throw the exception `retry_counter` when the
+counter `retries` reaches 0;
+
++ _CallsAndRetriesMax_
+
+    throw the exception
+`call_and_retry_counter` when the counter `calls_and_retries`
+reaches 0.
+
+ YAP will ignore counters that are called with unbound arguments.
+
+Next, we show a simple example of how to use call counters:
+
+~~~~~{.prolog}
+   ?- yap_flag(call_counting,on), [-user]. l :- l. end_of_file. yap_flag(call_counting,off).
+
+yes
+
+yes
+   ?- catch((call_count(10000,_,_),l),call_counter,format("limit_exceeded.~n",[])).
+
+limit_exceeded.
+
+yes
+~~~~~
+Notice that we first compile the looping predicate `l/0` with
+call_counting `on`. Next, we catch/3 to handle an
+exception when `l/0` performs more than 10000 reductions.
+
+
+ */
+call_count(Calls, Retries, Both) :-
+	'$check_if_call_count_on'(Calls, CallsOn),
+	'$check_if_call_count_on'(Retries, RetriesOn),
+	'$check_if_call_count_on'(Both, BothOn),
+	'$call_count_set'(Calls, CallsOn, Retries, RetriesOn, Both, BothOn).
+
+'$check_if_call_count_on'(Calls, 1) :- integer(Calls), !.
+'$check_if_call_count_on'(Calls, 0) :- var(Calls), !.
+'$check_if_call_count_on'(Calls, A) :-
+	'$do_error'(type_error(integer,Calls),call_count(A)).
+
+%% @}
+
+/**
+@}
+*/
+

packages/python/swig/yap4py/prolog/pl/checker.yap

@@ -0,0 +1,173 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		checker.yap						 *
+* comments:	style checker for Prolog				 *
+*									 *
+* Last rev:     $Date: 2008-03-31 22:56:22 $,$Author: vsc $		 *
+*									 *
+*************************************************************************/
+
+:- system_module( style_checker, [no_style_check/1,
+        style_check/1], ['$check_term'/5,
+        '$sv_warning'/2,
+        '$syntax_check_discontiguous'/2,
+        '$syntax_check_multiple'/2,
+        '$syntax_check_single_var'/2]).
+
+%% @{
+
+/**
+
+@defgroup   YAPStyle Checker
+    @ingroup  YAPCompilerSettings
+
+YAP implements a style-checker thay currently verifies whether:
+
+1 named variables occur once in a clause.
+
+2 clauses from dofferent predicates are mixed together.
+
+3 clauses for the same predicate occur in different files.
+
+One can declare a predicate to be discontiguous (see the
+discontiguous/1 declaration) and/or multifile/1.
+
+*/
+
+/*
+@pred style_check(+ _X_)
+
+Turns on style checking according to the attribute specified by  _X_,
+which must be one of the following:
+
+    + single_var
+      Checks single occurrences of named variables in a clause.
+
+    + discontiguous
+      Checks non-contiguous clauses for the same predicate in a file.
+
+    + multiple
+      Checks the presence of clauses for the same predicate in more than one
+      file when the predicate has not been declared as `multifile`
+
+    + all
+      Performs style checking for all the cases mentioned above.
+
+
+By default, style checking is disabled in YAP unless we are in
+`sicstus` or `iso` language mode.
+
+The style_check/1 built-in is now deprecated. Please use
+`set_prolog_flag/1` instead.
+
+  **/
+%
+% A Small style checker for YAP
+
+:- op(1150, fx, [multifile,discontiguous]).
+
+style_check(V) :- var(V), !, fail.
+style_check(V) :-
+	\+atom(V),
+	\+ is_list(V),
+	V \= + _,
+	V \= - _, !,
+	'$do_error'( type_error('+|-|?(Flag)', V), style_check(V) ).
+style_check(V) :-
+	\+atom(V),
+	\+ is_list(V),
+	V \= + _,
+	V \= + _, !,
+	'$do_error'( domain_error(style_name, V), style_check(V) ).
+
+
+style_check(all) :-
+	style_check( [ singleton, discontiguous, multiple ] ).
+style_check(+X) :-
+	style_check(X).
+style_check(single_var) :-
+	style_check( singleton ).
+style_check(singleton) :-
+	yap_flag( single_var_warnings, true ).
+style_check(-single_var) :-
+	yap_flag( single_var_warnings, false ).
+style_check(-singleton) :-
+	yap_flag( single_var_warnings, false ).
+style_check(discontiguous) :-
+	yap_flag( discontiguous_warnings, true ).
+style_check(-discontiguous) :-
+	yap_flag( discontiguous_warnings, false ).
+style_check(multiple) :-
+	yap_flag( redefine_warnings, true ).
+style_check(-multiple) :-
+	yap_flag( redefine_warnings, false ).
+style_check(no_effect).
+style_check(+no_effect) .
+style_check(-no_effect).
+style_check(var_branches).
+style_check(+var_branches) :-
+	'$style_checker'( [  var_branches ] ).
+style_check(-var_branches) :-
+	'$style_checker'( [  -var_branches ] ).
+style_check(atom).
+style_check(+atom) :-
+	'$style_checker'( [  atom ] ).
+style_check(-atom) :-
+	'$style_checker'( [  -atom ] ).
+style_check(charset) :-
+	'$style_checker'( [  charset ] ).
+style_check(+charset) :-
+	'$style_checker'( [  charset ] ).
+style_check(-charset) :-
+	'$style_checker'( [  -charset ] ).
+style_check('?'(Info) ) :-
+	L =  [ singleton, discontiguous, multiple ],
+	( lists:member(Style, L ) -> Info = +Style ; Info = -Style ).
+style_check([]).
+style_check([H|T]) :- style_check(H), style_check(T).
+
+/** @pred no_style_check(+ _X_)
+
+Turns off style checking according to the attribute specified by
+ _X_, which have the same meaning as in style_check/1.
+
+The no_style_check/1 built-in is now deprecated. Please use
+`set_prolog_flag/1` instead.
+
+**/
+no_style_check(V) :- var(V), !, fail.
+no_style_check(all) :-
+	'$style_checker'( [ -singleton, -discontiguous, -multiple ] ).
+no_style_check(-single_var) :-
+	'$style_checker'( [ -singleton ] ).
+no_style_check(-singleton) :-
+	'$style_checker'( [ -singleton ] ).
+no_style_check(-discontiguous) :-
+	'$style_checker'( [ -discontiguous ] ).
+no_style_check(-multiple) :-
+	'$style_checker'( [  -multiple ] ).
+no_style_check([]).
+no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
+
+/** @pred discontiguous(+ _G_) is iso
+    Avoid warnings from the sytax checker.
+
+Declare that the predicate _G_ or list of predicates are discontiguous
+procedures, that is, clauses for discontigous procedures may be
+separated by clauses from other procedures.
+
+*/
+
+discontiguous(P) :- '$discontiguous'(P).
+
+/*
+@}
+*/

packages/python/swig/yap4py/prolog/pl/control.yap

@@ -0,0 +1,648 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		control.yap						 *
+* Last rev:     20/08/09						 *
+* mods:									 *
+* comments:	control predicates available in yap			 *
+*									 *
+*************************************************************************/
+
+/**
+ * @file   control.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Thu Nov 19 10:26:35 2015
+ *
+ * @brief  Control Predicates
+ *
+ *
+*/
+
+:- system_module( '$_control', [at_halt/1,
+        b_getval/2,
+        break/0,
+        call/2,
+        call/3,
+        call/4,
+        call/5,
+        call/6,
+        call/7,
+        call/8,
+        call/9,
+        call/10,
+        call/11,
+        call/12,
+        call_cleanup/2,
+        call_cleanup/3,
+        forall/2,
+        garbage_collect/0,
+        garbage_collect_atoms/0,
+        gc/0,
+        grow_heap/1,
+        grow_stack/1,
+        halt/0,
+        halt/1,
+        if/3,
+        ignore/1,
+        nb_getval/2,
+        nogc/0,
+        notrace/1,
+        once/1,
+        prolog_current_frame/1,
+        prolog_initialization/1,
+        setup_call_catcher_cleanup/4,
+        setup_call_cleanup/3,
+        version/0,
+        version/1], ['$run_atom_goal'/1,
+        '$set_toplevel_hook'/1]).
+
+:- use_system_module( '$_boot', ['$call'/4,
+        '$disable_debugging'/0,
+        '$do_live'/0,
+        '$enable_debugging'/0,
+        '$system_catch'/4,
+        '$version'/0]).
+
+:- use_system_module( '$_debug', ['$init_debugger'/0]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_utils', ['$getval_exception'/3]).
+
+:- use_system_module( '$coroutining', [freeze_goal/2]).
+
+/**
+
+
+@addtogroup YAPControl
+
+%% @{
+
+*/
+
+
+/** @pred  once(: _G_) is iso
+
+
+Execute the goal  _G_ only once. The predicate is defined by:
+
+~~~~~{.prolog}
+ once(G) :- call(G), !.
+~~~~~
+
+Note that cuts inside once/1 can only cut the other goals inside
+once/1.
+
+
+*/
+once(G) :-
+	strip_module(G, M, C),
+	'$meta_call'(C, M),
+	!.
+
+/** @pred  forall(: _Cond_,: _Action_)
+
+
+For all alternative bindings of  _Cond_  _Action_ can be
+proven. The example verifies that all arithmetic statements in the list
+ _L_ are correct. It does not say which is wrong if one proves wrong.
+
+~~~~~{.prolog}
+?- forall(member(Result = Formula, [2 = 1 + 1, 4 = 2 * 2]),
+                 Result =:= Formula).
+~~~~~
+
+
+*/
+/** @pred forall(+ _Cond_,+ _Action_)
+
+
+
+
+For all alternative bindings of  _Cond_  _Action_ can be proven.
+The next example verifies that all arithmetic statements in the list
+ _L_ are correct. It does not say which is wrong if one proves wrong.
+
+~~~~~
+?- forall(member(Result = Formula, [2 = 1 + 1, 4 = 2 * 2]),
+                 Result =:= Formula).
+~~~~~
+
+
+
+*/
+forall(Cond, Action) :- \+((Cond, \+(Action))).
+
+/** @pred  ignore(: _Goal_)
+
+
+Calls  _Goal_ as once/1, but succeeds, regardless of whether
+`Goal` succeeded or not. Defined as:
+
+~~~~~{.prolog}
+ignore(Goal) :-
+        Goal, !.
+ignore(_).
+~~~~~
+
+
+*/
+ignore(Goal) :- (Goal->true;true).
+
+notrace(G) :-
+	 strip_module(G, M, G1),
+	 ( '$$save_by'(CP),
+	   '$debug_stop'( State ),
+	   '$call'(G1, CP, G, M),
+	   '$$save_by'(CP2),
+	   (CP == CP2 -> ! ; '$debug_state'( NState ), ( true ; '$debug_restart'(NState), fail ) ),
+	   '$debug_restart'( State )
+     ;
+	'$debug_restart'( State ),
+	fail
+    ).
+
+/** @pred  if(? _G_,? _H_,? _I_)
+
+Call goal  _H_ once per each solution of goal  _H_. If goal
+ _H_ has no solutions, call goal  _I_.
+
+The built-in `if/3` is similar to `->/3`, with the difference
+that it will backtrack over the test goal. Consider the following
+small data-base:
+
+~~~~~{.prolog}
+a(1).        b(a).          c(x).
+a(2).        b(b).          c(y).
+~~~~~
+
+Execution of an `if/3` query will proceed as follows:
+
+~~~~~{.prolog}
+   ?- if(a(X),b(Y),c(Z)).
+
+X = 1,
+Y = a ? ;
+
+X = 1,
+Y = b ? ;
+
+X = 2,
+Y = a ? ;
+
+X = 2,
+Y = b ? ;
+
+no
+~~~~~
+
+The system will backtrack over the two solutions for `a/1` and the
+two solutions for `b/1`, generating four solutions.
+
+Cuts are allowed inside the first goal  _G_, but they will only prune
+over  _G_.
+
+If you want  _G_ to be deterministic you should use if-then-else, as
+it is both more efficient and more portable.
+
+*/
+if(X,Y,Z) :-
+	(
+	 CP is '$last_choice_pt',
+	 '$call'(X,CP,if(X,Y,Z),M),
+	 '$execute'(X),
+	 '$clean_ifcp'(CP),
+	 '$call'(Y,CP,if(X,Y,Z),M)
+	;
+	 '$call'(Z,CP,if(X,Y,Z),M)
+	).
+
+call(X,A) :- '$execute'(X,A).
+
+call(X,A1,A2) :- '$execute'(X,A1,A2).
+
+/** @pred  call(+ _Closure_,...,? _Ai_,...) is iso
+
+
+Meta-call where  _Closure_ is a closure that is converted into a goal by
+appending the  _Ai_ additional arguments. The number of arguments varies
+between 0 and 10.
+
+
+*/
+call(X,A1,A2,A3) :- '$execute'(X,A1,A2,A3).
+
+call(X,A1,A2,A3,A4) :- '$execute'(X,A1,A2,A3,A4).
+
+call(X,A1,A2,A3,A4,A5) :- '$execute'(X,A1,A2,A3,A4,A5).
+
+call(X,A1,A2,A3,A4,A5,A6) :- '$execute'(X,A1,A2,A3,A4,A5,A6).
+
+call(X,A1,A2,A3,A4,A5,A6,A7) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7).
+
+call(X,A1,A2,A3,A4,A5,A6,A7,A8) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8).
+
+call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9).
+
+call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10).
+
+call(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11) :- '$execute'(X,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11).
+
+/** @pred call_cleanup(: _Goal_, : _CleanUpGoal_)
+
+This is similar to call_cleanup/1 but with an additional
+ _CleanUpGoal_ which gets called after  _Goal_ is finished.
+
+*/
+call_cleanup(Goal, Cleanup) :-
+	setup_call_catcher_cleanup(true, Goal, _Catcher, Cleanup).
+
+call_cleanup(Goal, Catcher, Cleanup) :-
+	setup_call_catcher_cleanup(true, Goal, Catcher, Cleanup).
+
+/** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
+
+
+Calls `(Setup, Goal)`. For each sucessful execution of _Setup_,
+calling _Goal_, the cleanup handler _Cleanup_ is guaranteed to be
+called exactly once.  This will happen after _Goal_ completes, either
+through failure, deterministic success, commit, or an exception.
+_Setup_ will contain the goals that need to be protected from
+asynchronous interrupts such as the ones received from
+`call_with_time_limit/2` or thread_signal/2.  In most uses, _Setup_
+will perform temporary side-effects required by _Goal_ that are
+finally undone by _Cleanup_.
+
+*/
+
+setup_call_cleanup(Setup,Goal, Cleanup) :-
+	setup_call_catcher_cleanup(Setup, Goal, _Catcher, Cleanup).
+
+/** @pred  call_with_args(+ _Name_,...,? _Ai_,...)
+
+
+Meta-call where  _Name_ is the name of the procedure to be called and
+the  _Ai_ are the arguments. The number of arguments varies between 0
+and 10. New code should use `call/N` for better portability.
+
+If  _Name_ is a complex term, then call_with_args/n behaves as
+call/n:
+
+~~~~~{.prolog}
+call(p(X1,...,Xm), Y1,...,Yn) :- p(X1,...,Xm,Y1,...,Yn).
+~~~~~
+
+
+*/
+
+%%% Some "dirty" predicates
+
+% Only efective if yap compiled with -DDEBUG
+% this predicate shows the code produced by the compiler
+'$show_code' :- '$debug'(0'f). %' just make emacs happy
+
+/** @pred  grow_heap(+ _Size_)
+Increase heap size  _Size_ kilobytes.
+
+
+*/
+grow_heap(X) :- '$grow_heap'(X).
+/** @pred  grow_stack(+ _Size_)
+
+
+Increase stack size  _Size_ kilobytes
+
+
+ */
+grow_stack(X) :- '$grow_stack'(X).
+
+%
+% gc() expects to be called from "call". Make sure it has an
+% environment to return to.
+%
+%garbage_collect :- save(dump), '$gc',  save(dump2).
+/** @pred  garbage_collect
+
+
+The goal `garbage_collect` forces a garbage collection.
+
+
+*/
+garbage_collect :-
+	'$gc'.
+
+
+
+/** @pred  gc
+
+
+The goal `gc` enables garbage collection. The same as
+`yap_flag(gc,on)`.
+
+
+*/
+gc :-
+	yap_flag(gc,on).
+/** @pred  nogc
+
+
+The goal `nogc` disables garbage collection. The same as
+`yap_flag(gc,off)`.
+
+
+*/
+nogc :-
+	yap_flag(gc,off).
+
+
+/** @pred  garbage_collect_atoms
+
+
+The goal `garbage_collect` forces a garbage collection of the atoms
+in the data-base. Currently, only atoms are recovered.
+
+
+*/
+garbage_collect_atoms :-
+	'$atom_gc'.
+
+'$force_environment_for_gc'.
+
+'$good_list_of_character_codes'(V) :- var(V), !.
+'$good_list_of_character_codes'([]).
+'$good_list_of_character_codes'([X|L]) :-
+	'$good_character_code'(X),
+	'$good_list_of_character_codes'(L).
+
+'$good_character_code'(X) :- var(X), !.
+'$good_character_code'(X) :- integer(X), X > -2, X < 256.
+
+/** @pred prolog_initialization( _G_)
+
+
+Add a goal to be executed on system initialization. This is compatible
+with SICStus Prolog's initialization/1.
+
+
+*/
+prolog_initialization(G) :- var(G), !,
+	'$do_error'(instantiation_error,initialization(G)).
+prolog_initialization(T) :- callable(T), !,
+	'$assert_init'(T).
+prolog_initialization(T) :-
+	'$do_error'(type_error(callable,T),initialization(T)).
+
+'$assert_init'(T) :- recordz('$startup_goal',T,_), fail.
+'$assert_init'(_).
+
+/** @pred version
+
+Write YAP's boot message.
+
+
+*/
+version :- '$version'.
+
+/** @pred version(- _Message_)
+
+Add a message to be written when yap boots or after aborting. It is not
+possible to remove messages.
+
+
+*/
+version(V) :- var(V),  !,
+	'$do_error'(instantiation_error,version(V)).
+version(T) :- atom(T), !, '$assert_version'(T).
+version(T) :-
+	'$do_error'(type_error(atom,T),version(T)).
+
+'$assert_version'(T) :- recordz('$version',T,_), fail.
+'$assert_version'(_).
+
+'$set_toplevel_hook'(_) :-
+	recorded('$toplevel_hooks',_,R),
+	erase(R),
+	fail.
+'$set_toplevel_hook'(H) :-
+	recorda('$toplevel_hooks',H,_),
+	fail.
+'$set_toplevel_hook'(_).
+
+%% @}
+
+%% @{
+
+%% @addtogroup Global_Variables
+
+/** @pred  nb_getval(+ _Name_, - _Value_)
+
+
+The nb_getval/2 predicate is a synonym for b_getval/2,
+introduced for compatibility and symmetry. As most scenarios will use
+a particular global variable either using non-backtrackable or
+backtrackable assignment, using nb_getval/2 can be used to
+document that the variable is used non-backtrackable.
+
+
+*/
+/** @pred nb_getval(+ _Name_,- _Value_)
+
+
+The nb_getval/2 predicate is a synonym for b_getval/2, introduced for
+compatibility and symmetry.  As most scenarios will use a particular
+global variable either using non-backtrackable or backtrackable
+assignment, using nb_getval/2 can be used to document that the
+variable is used non-backtrackable.
+
+
+*/
+nb_getval(GlobalVariable, Val) :-
+	'$nb_getval'(GlobalVariable, Val, Error),
+	(var(Error)
+	->
+	 true
+	;
+	 '$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) ->
+	 nb_getval(GlobalVariable, Val)
+	;
+	 '$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val))
+	).
+
+
+/** @pred  b_getval(+ _Name_, - _Value_)
+
+
+Get the value associated with the global variable  _Name_ and unify
+it with  _Value_. Note that this unification may further
+instantiate the value of the global variable. If this is undesirable
+the normal precautions (double negation or copy_term/2) must be
+taken. The b_getval/2 predicate generates errors if  _Name_ is not
+an atom or the requested variable does not exist.
+
+Notice that for compatibility with other systems  _Name_ <em>must</em> be already associated with a term: otherwise the system will generate an error.
+
+
+*/
+/** @pred b_getval(+ _Name_,- _Value_)
+
+
+Get the value associated with the global variable  _Name_ and unify
+it with  _Value_. Note that this unification may further instantiate
+the value of the global variable. If this is undesirable the normal
+precautions (double negation or copy_term/2) must be taken. The
+b_getval/2 predicate generates errors if  _Name_ is not an atom or
+the requested variable does not exist.
+
+
+*/
+b_getval(GlobalVariable, Val) :-
+	'$nb_getval'(GlobalVariable, Val, Error),
+	(var(Error)
+	->
+	 true
+	;
+	 '$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) ->
+	 true
+	;
+	 '$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val))
+	).
+
+
+%% @}
+
+%% @{
+
+%% @addtogroup YAPControl
+
+/* This is the break predicate,
+	it saves the importante data about current streams and
+	debugger state */
+
+'$debug_state'(state(Trace, Debug, Jump, Run, SPY_GN, GList)) :-
+	'$init_debugger',
+	nb_getval('$trace',Trace),
+	nb_getval('$debug_jump',Jump),
+	nb_getval('$debug_run',Run),
+	current_prolog_flag(debug, Debug),
+	nb_getval('$spy_gn',SPY_GN),
+	b_getval('$spy_glist',GList).
+
+
+'$debug_stop'( State ) :-
+        '$debug_state'( State ),
+	b_setval('$trace',off),
+%	set_prolog_flag(debug, false),
+	b_setval('$spy_glist',[]),
+	'$disable_debugging'.
+
+'$debug_restart'(state(Trace, Debug, Jump, Run, SPY_GN, GList)) :-
+	b_setval('$spy_glist',GList),
+	b_setval('$spy_gn',SPY_GN),
+	set_prolog_flag(debug, Debug),
+	b_setval('$debug_jump',Jump),
+	b_setval('$debug_run',Run),
+	b_setval('$trace',Trace),
+	'$enable_debugging'.
+
+/** @pred  break
+
+
+Suspends the execution of the current goal and creates a new execution
+level similar to the top level, displaying the following message:
+
+~~~~~{.prolog}
+ [ Break (level <number>) ]
+~~~~~
+telling the depth of the break level just entered. To return to the
+previous level just type the end-of-file character or call the
+end_of_file predicate.  This predicate is especially useful during
+debugging.
+
+
+*/
+break :-
+	'$init_debugger',
+	nb_getval('$trace',Trace),
+	nb_setval('$trace',off),
+	nb_getval('$debug_jump',Jump),
+	nb_getval('$debug_run',Run),
+	current_prolog_flag(debug, Debug),
+	set_prolog_flag(debug, false),
+	'$break'( true ),
+	nb_getval('$spy_gn',SPY_GN),
+	b_getval('$spy_glist',GList),
+	b_setval('$spy_glist',[]),
+	current_output(OutStream), current_input(InpStream),
+	current_prolog_flag(break_level, BL ),
+    NBL is BL+1,
+	set_prolog_flag(break_level, NBL ),
+	format(user_error, '% Break (level ~w)~n', [NBL]),
+	'$do_live',
+	!,
+	set_value('$live','$true'),
+	b_setval('$spy_glist',GList),
+	nb_setval('$spy_gn',SPY_GN),
+	set_input(InpStream),
+	set_output(OutStream),
+	set_prolog_flag(debug, Debug),
+	nb_setval('$debug_jump',Jump),
+	nb_setval('$debug_run',Run),
+	nb_setval('$trace',Trace),
+	set_prolog_flag(break_level, BL ),
+	'$break'( false ).
+
+
+at_halt(G) :-
+	recorda('$halt', G, _),
+	fail.
+at_halt(_).
+
+/** @pred  halt is iso
+
+Halts Prolog, and exits to the calling application. In YAP,
+halt/0 returns the exit code `0`.
+*/
+halt :-
+	print_message(informational, halt),
+	fail.
+halt :-
+    halt(0).
+
+/** @pred  halt(+  _I_) is iso
+
+Halts Prolog, and exits to 1the calling application returning the code
+given by the integer  _I_.
+
+*/
+halt(_) :-
+	recorded('$halt', G, _),
+	catch(once(G), Error, user:'$Error'(Error)),
+	fail.
+halt(X) :-
+	'$sync_mmapped_arrays',
+	set_value('$live','$false'),
+	'$halt'(X).
+
+prolog_current_frame(Env) :-
+	Env is '$env'.
+
+'$run_atom_goal'(GA) :-
+	'$current_module'(Module),
+	atom_to_term(GA, G, _),
+	catch(once(Module:G), Error,user:'$Error'(Error)).
+
+'$add_dot_to_atom_goal'([],[0'.]) :- !. %'
+'$add_dot_to_atom_goal'([0'.],[0'.]) :- !.
+'$add_dot_to_atom_goal'([C|Gs0],[C|Gs]) :-
+	'$add_dot_to_atom_goal'(Gs0,Gs).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/corout.yap

@@ -0,0 +1,581 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		corout.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	Coroutines implementation				 *
+*									 *
+*************************************************************************/
+
+
+/**
+ * @file   corout.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Mon Nov 16 22:47:27 2015
+ * *
+ */
+
+
+:- module('$coroutining',[
+			  op(1150, fx, block)
+				%dif/2,
+				%when/2,
+				%block/1,
+				%wait/1,
+				%frozen/2
+			 ]).
+
+:- use_system_module( '$_boot', ['$$compile'/4]).
+
+
+:- use_system_module( attributes, [get_module_atts/2,
+        put_module_atts/2]).
+
+
+/**
+ *  @defgroup corout Implementing Attributed Variables and Co-Routining
+ *
+ *  @ingroup attributes
+ *  @{
+ *  @brief  Support for co-routining
+	*
+	*
+””	*/
+
+
+/** @pred attr_unify_hook(+ _AttValue_,+ _VarValue_)
+
+
+
+Hook that must be defined in the module an attributed variable refers
+to. Is is called <em>after</em> the attributed variable has been
+unified with a non-var term, possibly another attributed variable.
+ _AttValue_ is the attribute that was associated to the variable
+in this module and  _VarValue_ is the new value of the variable.
+Normally this predicate fails to veto binding the variable to
+ _VarValue_, forcing backtracking to undo the binding.  If
+ _VarValue_ is another attributed variable the hook often combines
+the two attribute and associates the combined attribute with
+ _VarValue_ using put_attr/3.
+
+
+*/
+attr_unify_hook(DelayList, _) :-
+	wake_delays(DelayList).
+
+wake_delays([]).
+wake_delays([Delay|List]) :-
+	wake_delay(Delay),
+	wake_delays(List).
+
+%
+% Interface to attributed variables.
+%
+wake_delay(redo_dif(Done, X, Y)) :-
+	redo_dif(Done, X, Y).
+wake_delay(redo_freeze(Done, V, Goal)) :-
+	redo_freeze(Done, V, Goal).
+wake_delay(redo_eq(Done, X, Y, Goal)) :-
+	redo_eq(Done, X, Y, Goal, _G).
+wake_delay(redo_ground(Done, X, Goal)) :-
+	redo_ground(Done, X, Goal).
+
+
+attribute_goals(Var) -->
+	{ get_attr(Var, '$coroutining', Delays) },
+	attgoal_for_delays(Delays, Var).
+
+attgoal_for_delays([], _V) --> [].
+attgoal_for_delays([G|AllAtts], V) -->
+	attgoal_for_delay(G, V),
+	attgoal_for_delays(AllAtts, V).
+
+attgoal_for_delay(redo_dif(Done, X, Y), V) -->
+	{ var(Done), first_att(dif(X,Y), V) }, !,
+	[prolog:dif(X,Y)].
+attgoal_for_delay(redo_freeze(Done, V, Goal), V) -->
+	{ var(Done) },  !,
+	{ remove_when_declarations(Goal, NoWGoal) },
+	[ prolog:freeze(V,NoWGoal) ].
+attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) -->
+	{ var(Done), first_att(Goal, V) }, !,
+	[ prolog:when(X=Y,Goal) ].
+attgoal_for_delay(redo_ground(Done, X, Goal), _V) -->
+	{ var(Done) },  !,
+	[ prolog:when(ground(X),Goal) ].
+attgoal_for_delay(_, _V) --> [].
+
+remove_when_declarations(when(Cond,Goal,_), when(Cond,NoWGoal)) :- !,
+	remove_when_declarations(Goal, NoWGoal).
+remove_when_declarations(Goal, Goal).
+
+
+%
+% operators defined in this module:
+%
+/**
+  @pred freeze(? _X_,: _G_)
+
+Delay execution of goal  _G_ until the variable  _X_ is bound.
+
+
+*/
+prolog:freeze(V, G) :-
+	var(V), !,
+	freeze_goal(V,G).
+prolog:freeze(_, G) :-
+	'$execute'(G).
+
+freeze_goal(V,VG) :-
+	var(VG), !,
+	'$current_module'(M),
+	internal_freeze(V, redo_freeze(_Done,V,M:VG)).
+freeze_goal(V,M:G) :- !,
+	internal_freeze(V, redo_freeze(_Done,V,M:G)).
+freeze_goal(V,G) :-
+	'$current_module'(M),
+	internal_freeze(V, redo_freeze(_Done,V,M:G)).
+
+%
+%
+% Dif is tricky because we need to wake up on the two variables being
+% bound together, or on any variable of the term being bound to
+% another. Also, the day YAP fully supports infinite rational trees,
+% dif should work for them too. Hence, term comparison should not be
+% implemented in Prolog.
+%
+% This is the way dif works. The '$can_unify' predicate does not know
+% anything about dif semantics, it just compares two terms for
+% equaility and is based on compare. If it succeeds without generating
+% a list of variables, the terms are equal and dif fails. If it fails,
+% dif succeeds.
+%
+% If it succeeds but it creates a list of variables, dif creates
+% suspension records for all these variables on the '$redo_dif'(V,
+% X, Y) goal. V is a flag that says whether dif has completed or not,
+% X and Y are the original goals. Whenever one of these variables is
+% bound, it calls '$redo_dif' again. '$redo_dif' will then check whether V
+% was bound. If it was, dif has succeeded and redo_dif just
+% exits. Otherwise, '$redo_dif' will call dif again to see what happened.
+%
+% Dif needs two extensions from the suspension engine:
+%
+% First, it needs
+% for the engine to be careful when binding two suspended
+% variables. Basically, in this case the engine must be sure to wake
+% up one of the goals, as they may make dif fail. The way the engine
+% does so is by searching the list of suspended variables, and search
+% whether they share a common suspended goal. If they do, that
+% suspended goal is added to the WokenList.
+%
+% Second, thanks to dif we may try to suspend on the same variable
+% several times. dif calls a special version of freeze that checks
+% whether that is in fact the case.
+%
+/** @pred dif( _X_, _Y_)
+
+
+Succeed if the two arguments do not unify. A call to dif/2 will
+suspend if unification may still succeed or fail, and will fail if they
+always unify.
+
+
+*/
+prolog:dif(X, Y) :-
+	'$can_unify'(X, Y, LVars), !,
+	LVars = [_|_],
+	dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)).
+prolog:dif(_, _).
+
+
+dif_suspend_on_lvars([], _).
+dif_suspend_on_lvars([H|T], G) :-
+	internal_freeze(H, G),
+	dif_suspend_on_lvars(T, G).
+
+%
+% This predicate is called whenever a variable dif was suspended on is
+% bound. Note that dif may have already executed successfully.
+%
+% Three possible cases: dif has executed and Done is bound; we redo
+% dif and the two terms either unify, hence we fail, or may unify, and
+% we try to increase the number of suspensions; last, the two terms
+% did not unify, we are done, so we succeed and bind the Done variable.
+%
+redo_dif(Done, _, _) :- nonvar(Done), !.
+redo_dif(Done, X, Y) :-
+	'$can_unify'(X, Y, LVars), !,
+	LVars = [_|_],
+	dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)).
+redo_dif('$done', _, _).
+
+redo_freeze(Done, V, G0) :-
+% If you called nonvar as condition for when, then you may find yourself
+% here.
+%
+% someone else (that is Cond had ;) did the work, do nothing
+%
+	(nonvar(Done) -> true ;
+%
+% We still have some more conditions: continue the analysis.
+%
+	 G0 = when(C, G, Done) -> when(C, G, Done) ;
+%
+% check if the variable was really bound
+%
+	var(V) -> internal_freeze(V, redo_freeze(Done,V,G0)) ;
+%
+% I can't believe it: we're done and can actually execute our
+% goal. Notice we have to say we are done, otherwise someone else in
+% the disjunction might decide to wake up the goal themselves.
+%
+	Done = '$done', '$execute'(G0) ).
+
+%
+% eq is a combination of dif and freeze
+redo_eq(Done, _, _, _, _) :- nonvar(Done), !.
+redo_eq(_, X, Y, _, G) :-
+	'$can_unify'(X, Y, LVars),
+	LVars = [_|_], !,
+	dif_suspend_on_lvars(LVars, G).
+redo_eq(Done, _, _, when(C, G, Done), _) :- !,
+	when(C, G, Done).
+redo_eq('$done', _ ,_ , Goal, _) :-
+	'$execute'(Goal).
+
+%
+% ground is similar to freeze
+redo_ground(Done, _, _) :- nonvar(Done), !.
+redo_ground(Done, X, Goal) :-
+	'$non_ground'(X, Var), !,
+	internal_freeze(Var, redo_ground(Done, X, Goal)).
+redo_ground(Done, _, when(C, G, Done)) :- !,
+	when(C, G, Done).
+redo_ground('$done', _, Goal) :-
+	'$execute'(Goal).
+
+
+%
+% support for when/2 built-in
+%
+/** @pred when(+ _C_,: _G_)
+
+
+Delay execution of goal  _G_ until the conditions  _C_ are
+satisfied. The conditions are of the following form:
+
++ _C1_, _C2_
+Delay until both conditions  _C1_ and  _C2_ are satisfied.
++ _C1_; _C2_
+Delay until either condition  _C1_ or condition  _C2_ is satisfied.
++ ?=( _V1_, _C2_)
+Delay until terms  _V1_ and  _V1_ have been unified.
++ nonvar( _V_)
+Delay until variable  _V_ is bound.
++ ground( _V_)
+Delay until variable  _V_ is ground.
+
+
+Note that when/2 will fail if the conditions fail.
+
+
+*/
+prolog:when(Conds,Goal) :-
+	'$current_module'(Mod),
+	prepare_goal_for_when(Goal, Mod, ModG),
+	when(Conds, ModG, Done, [], LG), !,
+%write(vsc:freezing(LG,Done)),nl,
+	suspend_when_goals(LG, Done).
+prolog:when(_,Goal) :-
+	'$execute'(Goal).
+
+%
+% support for when/2 like declaration.
+%
+%
+% when will block on a conjunction or disjunction of nonvar, ground,
+% ?=, where ?= is both terms being bound together
+%
+%
+'$declare_when'(Cond, G) :-
+	generate_code_for_when(Cond, G, Code),
+	'$current_module'(Module),
+	'$$compile'(Code, Code, 5, Module), fail.
+'$declare_when'(_,_).
+
+%
+% use a meta interpreter for now
+%
+generate_code_for_when(Conds, G,
+	( G :- when(Conds, ModG, Done, [], LG), !,
+	suspend_when_goals(LG, Done)) ) :-
+	'$current_module'(Mod),
+	prepare_goal_for_when(G, Mod, ModG).
+
+
+%
+% make sure we have module info for G!
+%
+prepare_goal_for_when(G, Mod, Mod:call(G)) :- var(G), !.
+prepare_goal_for_when(M:G, _,  M:G) :- !.
+prepare_goal_for_when(G, Mod, Mod:G).
+
+
+%
+% now for the important bit
+%
+
+% Done is used to synchronise: when it is bound someone else did the
+% goal and we can give up.
+%
+% when/5 and when_suspend succeds when there is need to suspend a goal
+%
+%
+when(V, G, _Done, LG, LG) :- var(V), !,
+	'$do_error'(instantiation_error,when(V,G)).
+when(nonvar(V), G, Done, LG0, LGF) :-
+	when_suspend(nonvar(V), G, Done, LG0, LGF).
+when(?=(X,Y), G, Done, LG0, LGF) :-
+	when_suspend(?=(X,Y), G, Done, LG0, LGF).
+when(ground(T), G, Done, LG0, LGF) :-
+	when_suspend(ground(T), G, Done, LG0, LGF).
+when((C1, C2), G, Done, LG0, LGF) :-
+	% leave it open to continue with when.
+	(
+	    when(C1, when(C2, G, Done), Done, LG0, LGI)
+        ->
+	    LGI = LGF
+        ;
+	    % we solved C1, great, now we just have to solve C2!
+	    when(C2, G, Done, LG0, LGF)
+        ).
+when((G1 ; G2), G, Done, LG0, LGF) :-
+	when(G1, G, Done, LG0, LGI),
+	when(G2, G, Done, LGI, LGF).
+
+%
+% Auxiliary predicate called from within a conjunction.
+% Repeat basic code for when,  as inserted in first clause for predicate.
+%
+when(_, _, Done) :-
+	nonvar(Done), !.
+when(Cond, G, Done) :-
+	when(Cond, G, Done, [], LG),
+	!,
+	suspend_when_goals(LG, Done).
+when(_, G, '$done') :-
+	'$execute'(G).
+
+%
+% Do something depending on the condition!
+%
+% some one else did the work.
+%
+when_suspend(_, _, Done, _, []) :- nonvar(Done), !.
+%
+% now for the serious stuff.
+%
+when_suspend(nonvar(V), G, Done, LG0, LGF) :-
+	try_freeze(V, G, Done, LG0, LGF).
+when_suspend(?=(X,Y), G, Done, LG0, LGF) :-
+	try_eq(X, Y, G, Done, LG0, LGF).
+when_suspend(ground(X), G, Done, LG0, LGF) :-
+	try_ground(X, G, Done, LG0, LGF).
+
+
+try_freeze(V, G, Done, LG0, LGF) :-
+	var(V),
+	LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0].
+
+try_eq(X, Y, G, Done, LG0, LGF) :-
+	'$can_unify'(X, Y, LVars), LVars = [_|_],
+	LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0].
+
+try_ground(X, G, Done, LG0, LGF) :-
+	'$non_ground'(X, Var),    % the C predicate that succeds if
+				  % finding out the term is nonground
+				  % and gives the first variable it
+				  % finds. Notice that this predicate
+				  % must know about svars.
+	LGF = ['$coroutining':internal_freeze(Var, redo_ground(Done, X, G))| LG0].
+
+%
+% When executing a when, if nobody succeeded, we need to create suspensions.
+%
+suspend_when_goals([], _).
+suspend_when_goals(['$coroutining':internal_freeze(V, G)|Ls], Done) :-
+	var(Done), !,
+	internal_freeze(V, G),
+	suspend_when_goals(Ls, Done).
+suspend_when_goals([dif_suspend_on_lvars(LVars, G)|LG], Done) :-
+	var(Done), !,
+	dif_suspend_on_lvars(LVars, G),
+	suspend_when_goals(LG, Done).
+suspend_when_goals([_|_], _).
+
+%
+% Support for wait declarations on goals.
+% Or we also use the more powerful, SICStus like, "block" declarations.
+%
+% block or wait declarations must precede the first clause.
+%
+
+%
+% I am using the simplest solution now: I'll add an extra clause at
+% the beginning of the procedure to do this work. This creates a
+% choicepoint and make things a bit slower, but it's probably not as
+% significant as the remaining overheads.
+%
+prolog:'$block'(Conds) :-
+	generate_blocking_code(Conds, _, Code),
+	'$current_module'(Module),
+	'$$compile'(Code, Code, 5, Module), fail.
+prolog:'$block'(_).
+
+generate_blocking_code(Conds, G, Code) :-
+	extract_head_for_block(Conds, G),
+	recorded('$blocking_code','$code'(G,OldConds),R), !,
+	erase(R),
+	functor(G, Na, Ar),
+	'$current_module'(M),
+	abolish(M:Na, Ar),
+	generate_blocking_code((Conds,OldConds), G, Code).
+generate_blocking_code(Conds, G, (G :- (If, !, when(When, G)))) :-
+	extract_head_for_block(Conds, G),
+	recorda('$blocking_code','$code'(G,Conds),_),
+	generate_body_for_block(Conds, G, If, When).
+
+%
+% find out what we are blocking on.
+%
+extract_head_for_block((C1, _), G) :- !,
+	extract_head_for_block(C1, G).
+extract_head_for_block(C, G) :-
+	functor(C, Na, Ar),
+	functor(G, Na, Ar).
+
+%
+% If we suspend on the conditions, we should continue
+% execution. If we don't suspend we should fail so that we can take
+% the next clause. To
+% know what we have to do we just test how many variables we suspended
+% on ;-).
+%
+
+%
+% We generate code as follows:
+%
+% block a(-,-,?)
+%
+% (var(A1), var(A2) -> true ; fail), !, when((nonvar(A1);nonvar(A2)),G).
+%
+% block a(-,-,?), a(?,-, -)
+%
+% (var(A1), var(A2) -> true ; (var(A2), var(A3) -> true ; fail)), !,
+%                   when(((nonvar(A1);nonvar(A2)),(nonvar(A2);nonvar(A3))),G).
+
+generate_body_for_block((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !,
+       generate_for_cond_in_block(C1, G, Code1, WhenConds),
+       generate_body_for_block(C2, G, Code2, OtherWhenConds).
+generate_body_for_block(C, G, (Code -> true ; fail), WhenConds) :-
+       generate_for_cond_in_block(C, G, Code, WhenConds).
+
+generate_for_cond_in_block(C, G, Code, Whens) :-
+	C =.. [_|Args],
+	G =.. [_|GArgs],
+	fetch_out_variables_for_block(Args,GArgs,L0Vars),
+	add_blocking_vars(L0Vars, LVars),
+	generate_for_each_arg_in_block(LVars, Code, Whens).
+
+add_blocking_vars([], [_]) :- !.
+add_blocking_vars(LV, LV).
+
+fetch_out_variables_for_block([], [], []).
+fetch_out_variables_for_block(['?'|Args], [_|GArgs], LV) :-
+	fetch_out_variables_for_block(Args, GArgs, LV).
+fetch_out_variables_for_block(['-'|Args], [GArg|GArgs],
+	       [GArg|LV]) :-
+	fetch_out_variables_for_block(Args, GArgs, LV).
+
+generate_for_each_arg_in_block([], false, true).
+generate_for_each_arg_in_block([V], var(V), nonvar(V)) :- !.
+generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :-
+	generate_for_each_arg_in_block(L, If, Whens).
+
+
+%
+% The wait declaration is a simpler and more efficient version of block.
+%
+prolog:'$wait'(Na/Ar) :-
+	functor(S, Na, Ar),
+	arg(1, S, A),
+	'$current_module'(M),
+	'$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail.
+prolog:'$wait'(_).
+
+/** @pred frozen( _X_, _G_)
+
+
+Unify  _G_ with a conjunction of goals suspended on variable  _X_,
+or `true` if no goal has suspended.
+
+
+*/
+prolog:frozen(V, LG) :-
+    var(V), !,
+    '$attributes':attvars_residuals([V], Gs, []),
+    simplify_frozen( Gs, SGs ),
+    list_to_conj( SGs, LG ).
+prolog:frozen(V, G) :-
+    '$do_error'(uninstantiation_error(V),frozen(V,G)).
+
+simplify_frozen( [prolog:freeze(_, G)|Gs], [G|NGs] ) :-
+    simplify_frozen( Gs,NGs ).
+simplify_frozen( [prolog:when(_, G)|Gs], [G|NGs] ) :-
+    simplify_frozen( Gs,NGs ).
+simplify_frozen( [prolog:dif(_, _)|Gs], NGs ) :-
+    simplify_frozen( Gs,NGs ).
+simplify_frozen( [], [] ).
+
+list_to_conj([], true).
+list_to_conj([El], El).
+list_to_conj([E,E1|Els], (E,C) ) :-
+    list_to_conj([E1|Els], C).
+
+%internal_freeze(V,G) :-
+%	attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail.
+internal_freeze(V,G) :-
+	update_att(V, G).
+
+update_att(V, G) :-
+	attributes:get_module_atts(V, '$coroutining'(_,Gs)),
+	not_vmember(G, Gs), !,
+	attributes:put_module_atts(V, '$coroutining'(_,[G|Gs])).
+update_att(V, G) :-
+	attributes:put_module_atts(V, '$coroutining'(_,[G])).
+
+
+not_vmember(_, []).
+not_vmember(V, [V1|DonesSoFar]) :-
+	V \== V1,
+	not_vmember(V, DonesSoFar).
+
+first_att(T, V) :-
+	term_variables(T, Vs),
+	check_first_attvar(Vs, V).
+
+check_first_attvar([V|_Vs], V0) :- attvar(V), !, V == V0.
+check_first_attvar([_|Vs], V0) :-
+	check_first_attvar(Vs, V0).
+
+/**
+  @}
+*/

packages/python/swig/yap4py/prolog/pl/dbload.yap

@@ -0,0 +1,189 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		dbload.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Compact Loading of Facts in YAP				 *
+*									 *
+*************************************************************************/
+
+:- module('$db_load',
+	  []).
+
+:- use_system_module( '$_boot', ['$$compile'/4]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( attributes, [get_module_atts/2,
+        put_module_atts/2]).
+
+%%% @file dbload.yap
+
+%%% @defgroup YAPBigLoad
+%%% @brief Fast and  Exo Loading
+
+/*!
+ * @pred load_mega_clause( +Stream ) is detail
+ * Load a single predicare composed of facts with the same size.
+ */
+load_mega_clause( Stream ) :-
+%    	line_spec( Stream, Line),
+			repeat,
+			( fact( Stream ), fail ;
+			  stream_property(Stream, at_end_of_file( on )) ).
+
+'$input_lines'(R, csv, Lines ) :-
+    '$process_lines'(R, Lines, _Type ),
+	close(R).
+
+/*!
+ * @pred load_db( +Files ) is det
+ * Load files each one containing as single predicare composed of facts with the same size.
+ */
+prolog:load_db(Fs) :-
+        '$current_module'(M0),
+	prolog_flag(agc_margin,Old,0),
+	dbload(Fs,M0,load_db(Fs)),
+	load_facts,
+	prolog_flag(agc_margin,_,Old),
+	clean_up.
+
+dbload(Fs, _, G) :-
+	var(Fs),
+	'$do_error'(instantiation_error,G).
+dbload([], _, _) :- !.
+dbload([F|Fs], M0, G) :- !,
+	dbload(F, M0, G),
+	dbload(Fs, M0, G).
+dbload(M:F, _M0, G) :- !,
+	dbload(F, M, G).
+dbload(F, M0, G) :-
+	atom(F), !,
+	do_dbload(F, M0, G).
+dbload(F, _, G) :-
+	'$do_error'(type_error(atom,F),G).
+
+do_dbload(F0, M0, G) :-
+	'$full_filename'(F0, F, G),
+	assert(dbprocess(F, M0)),
+	open(F, read, R),
+	check_dbload_stream(R, M0),
+	close(R).
+
+
+check_dbload_stream(R, M0) :-
+	repeat,
+	catch(read(R,T), _, fail),
+	( T = end_of_file -> !;
+	    dbload_count(T, M0),
+	    fail
+	).
+
+dbload_count(T0, M0) :-
+	get_module(T0,M0,T,M),
+	functor(T,Na,Arity),
+%	dbload_check_term(T),
+	(
+	    dbloading(Na,Arity,M,_,NaAr,_) ->
+	    nb_getval(NaAr,I0),
+	    I is I0+1,
+	    nb_setval(NaAr,I)
+	;
+	    atomic_concat([Na,'__',Arity,'__',M],NaAr),
+	    assert(dbloading(Na,Arity,M,T,NaAr,0)),
+	    nb_setval(NaAr,1)
+	).
+
+get_module(M1:T0,_,T,M) :- !,
+	get_module(T0, M1, T , M).
+get_module(T,M,T,M).
+
+
+load_facts :-
+	!, % yap_flag(exo_compilation, on), !.
+	load_exofacts.
+load_facts :-
+	retract(dbloading(Na,Arity,M,T,NaAr,_)),
+	nb_getval(NaAr,Size),
+	dbload_get_space(T, M, Size, Handle),
+	assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
+	nb_setval(NaAr,0),
+	fail.
+load_facts :-
+	dbprocess(F, M),
+	open(F, read, R),
+	dbload_add_facts(R, M),
+	close(R),
+	fail.
+load_facts.
+
+dbload_add_facts(R, M) :-
+	repeat,
+	catch(read(R,T), _, fail),
+	( T = end_of_file -> !;
+	    dbload_add_fact(T, M),
+	    fail
+	).
+
+dbload_add_fact(T0, M0) :-
+	get_module(T0,M0,T,M),
+	functor(T,Na,Arity),
+	dbloading(Na,Arity,M,_,NaAr,Handle),
+	nb_getval(NaAr,I0),
+	I is I0+1,
+	nb_setval(NaAr,I),
+	dbassert(T,Handle,I0).
+
+load_exofacts :-
+	retract(dbloading(Na,Arity,M,T,NaAr,_)),
+	nb_getval(NaAr,Size),
+	exo_db_get_space(T, M, Size, Handle),
+	assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
+	nb_setval(NaAr,0),
+	fail.
+load_exofacts :-
+	dbprocess(F, M),
+	open(F, read, R),
+	exodb_add_facts(R, M),
+	close(R),
+	fail.
+load_exofacts.
+
+exodb_add_facts(R, M) :-
+	repeat,
+	catch(protected_exodb_add_fact(R, M), _, fail),
+	!.
+
+protected_exodb_add_fact(R, M) :-
+	repeat,
+	read(R,T),
+	( T == end_of_file -> !;
+	    exodb_add_fact(T, M),
+	    fail
+	).
+
+exodb_add_fact(T0, M0) :-
+	get_module(T0,M0,T,M),
+	functor(T,Na,Arity),
+	dbloading(Na,Arity,M,_,NaAr,Handle),
+	nb_getval(NaAr,I0),
+	I is I0+1,
+	nb_setval(NaAr,I),
+	exoassert(T,Handle,I0).
+
+clean_up :-
+	retractall(dbloading(_,_,_,_,_,_)),
+	retractall(dbprocess(_,_)),
+	fail.
+
+clean_up.
+
+%% @}

packages/python/swig/yap4py/prolog/pl/depth_bound.yap

@@ -0,0 +1,35 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		corout.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	Coroutines implementation				 *
+*									 *
+*************************************************************************/
+
+/**
+
+@defgroup DepthLimited Depth Limited Search
+@ingroup extensions
+
+YAP implements various extensions to the default Prolog search. One of
+the most iseful s restricting the maximum search depth.
+
+*/
+ :-
+system_module( '$_depth_bound', [depth_bound_call/2], []).
+
+%depth_bound_call(A,D) :-
+%write(depth_bound_call(A,D)), nl, fail.
+depth_bound_call(A,D) :-
+	'$execute_under_depth_limit'(A,D).
+
+

packages/python/swig/yap4py/prolog/pl/dialect.yap

@@ -0,0 +1,93 @@
+:- module(dialect,
+	  [
+	   exists_source/1,
+	   source_exports/2
+	  ]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+%	@pred expects_dialect(+Dialect)
+%
+%	True if YAP can enable support for a different Prolog dialect.
+%   Currently there is support for bprolog, hprolog and swi-prolog.
+%   Notice that this support may be incomplete.
+%
+%   The
+prolog:expects_dialect(yap) :- !,
+	eraseall('$dialect'),
+	recorda('$dialect',yap,_).
+prolog:expects_dialect(Dialect) :-
+	check_dialect(Dialect),
+	eraseall('$dialect'),
+	load_files(library(dialect/Dialect),[silent(true),if(not_loaded)]),
+	(   current_predicate(Dialect:setup_dialect/0)
+	->  Dialect:setup_dialect
+	;   true
+	),
+	recorda('$dialect',Dialect,_).
+
+check_dialect(Dialect) :-
+	var(Dialect),!,
+	'$do_error'(instantiation_error,(:- expects_dialect(Dialect))).
+check_dialect(Dialect) :-
+	\+ atom(Dialect),!,
+	'$do_error'(type_error(Dialect),(:- expects_dialect(Dialect))).
+check_dialect(Dialect) :-
+	exists_source(library(dialect/Dialect)), !.
+check_dialect(Dialect) :-
+	'$do_error'(domain_error(dialect,Dialect),(:- expects_dialect(Dialect))).
+
+%%	exists_source(+Source) is semidet.
+%
+%	True if Source (a term  valid   for  load_files/2) exists. Fails
+%	without error if this is not the case. The predicate is intended
+%	to be used with  :-  if,  as   in  the  example  below. See also
+%	source_exports/2.
+%
+%	==
+%	:- if(exists_source(library(error))).
+%	:- use_module_library(error).
+%	:- endif.
+%	==
+
+%exists_source(Source) :-
+%	exists_source(Source, _Path).
+
+exists_source(Source, Path) :-
+	absolute_file_name(Source, Path,
+			   [ file_type(prolog),
+			     access(read),
+			     file_errors(fail)
+			   ]).
+
+%%	source_exports(+Source, +Export) is semidet.
+%%	source_exports(+Source, -Export) is nondet.
+%
+%	True if Source exports Export. Fails   without  error if this is
+%	not the case.  See also exists_source/1.
+%
+%	@tbd	Should we also allow for source_exports(-Source, +Export)?
+
+source_exports(Source, Export) :-
+	open_source(Source, In),
+	catch(call_cleanup(exports(In, Exports), close(In)), _, fail),
+	(   ground(Export)
+	->  lists:memberchk(Export, Exports)
+	;   lists:member(Export, Exports)
+	).
+
+%%	open_source(+Source, -In:stream) is semidet.
+%
+%	Open a source location.
+
+open_source(File, In) :-
+	exists_source(File, Path),
+	open(Path, read, In),
+	(   peek_char(In, #)
+	->  skip(In, 10)
+	;   true
+	).
+
+exports(In, Exports) :-
+	read(In, Term),
+	Term = (:- module(_Name, Exports)).

packages/python/swig/yap4py/prolog/pl/directives.yap

@@ -0,0 +1,263 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		directives.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	directing system execution				 *
+*									 *
+*************************************************************************/
+
+
+:- system_module( '$_directives', [user_defined_directive/2], ['$all_directives'/1,
+        '$exec_directives'/5]).
+
+:- use_system_module( '$_boot', ['$command'/4,
+        '$system_catch'/4]).
+
+:- use_system_module( '$_consult', ['$elif'/2,
+        '$else'/1,
+        '$endif'/1,
+        '$if'/2,
+        '$include'/2,
+        '$initialization'/1,
+        '$initialization'/2,
+        '$load_files'/3,
+        '$require'/2,
+        '$set_encoding'/1,
+        '$use_module'/3]).
+
+:- use_system_module( '$_modules', ['$meta_predicate'/2,
+        '$module'/3,
+        '$module'/4,
+        '$module_transparent'/2]).
+
+:- use_system_module( '$_preddecls', ['$discontiguous'/2,
+        '$dynamic'/2]).
+
+:- use_system_module( '$_preds', ['$noprofile'/2,
+        '$public'/2]).
+
+:- use_system_module( '$_threads', ['$thread_local'/2]).
+
+'$all_directives'(_:G1) :- !,
+	'$all_directives'(G1).
+'$all_directives'((G1,G2)) :- !,
+	'$all_directives'(G1),
+	'$all_directives'(G2).
+'$all_directives'(G) :- !,
+	'$directive'(G).
+
+%:- '$multifile'( '$directive'/1, prolog ).
+:- multifile prolog:'$exec_directive'/5, prolog:'$directive'/1.
+
+
+
+'$directive'(block(_)).
+'$directive'(char_conversion(_,_)).
+'$directive'(compile(_)).
+'$directive'(consult(_)).
+'$directive'(discontiguous(_)).
+'$directive'(dynamic(_)).
+'$directive'(elif(_)).
+'$directive'(else).
+'$directive'(encoding(_)).
+'$directive'(endif).
+'$directive'(ensure_loaded(_)).
+'$directive'(expects_dialect(_)).
+'$directive'(if(_)).
+'$directive'(include(_)).
+'$directive'(initialization(_)).
+'$directive'(initialization(_,_)).
+'$directive'(license(_)).
+'$directive'(meta_predicate(_)).
+'$directive'(module(_,_)).
+'$directive'(module(_,_,_)).
+'$directive'(module_transparent(_)).
+'$directive'(multifile(_)).
+'$directive'(noprofile(_)).
+'$directive'(public(_)).
+'$directive'(op(_,_,_)).
+'$directive'(require(_)).
+'$directive'(set_prolog_flag(_,_)).
+'$directive'(reconsult(_)).
+'$directive'(reexport(_)).
+'$directive'(reexport(_,_)).
+'$directive'(predicate_options(_,_,_)).
+'$directive'(thread_initialization(_)).
+'$directive'(thread_local(_)).
+'$directive'(uncutable(_)).
+'$directive'(use_module(_)).
+'$directive'(use_module(_,_)).
+'$directive'(use_module(_,_,_)).
+'$directive'(wait(_)).
+
+'$exec_directives'((G1,G2), Mode, M, VL, Pos) :-
+    !,
+    '$exec_directives'(G1, Mode, M, VL, Pos),
+    '$exec_directives'(G2, Mode, M, VL, Pos).
+'$exec_directives'(G, Mode, M, VL, Pos) :-
+    '$exec_directive'(G, Mode, M, VL, Pos).
+
+
+'$exec_directive'(multifile(D), _, M, _, _) :-
+	'$system_catch'('$multifile'(D, M), M,
+	      Error,
+	      user:'$LoopError'(Error, top)).
+'$exec_directive'(discontiguous(D), _, M, _, _) :-
+	'$discontiguous'(D,M).
+/** @pred initialization
+
+Execute the goals defined by initialization/1. Only the first answer is
+considered.
+
+
+*/
+'$exec_directive'(initialization(D), _, M, _, _) :-
+	'$initialization'(M:D).
+'$exec_directive'(initialization(D,OPT), _, M, _, _) :-
+	'$initialization'(M:D, OPT).
+'$exec_directive'(thread_initialization(D), _, M, _, _) :-
+	'$thread_initialization'(M:D).
+'$exec_directive'(expects_dialect(D), _, _, _, _) :-
+    expects_dialect(D).
+'$exec_directive'(encoding(Enc), _, _, _, _) :-
+        '$set_encoding'(Enc).
+'$exec_directive'(include(F), Status, _, _, _) :-
+	'$include'(F, Status).
+% don't declare modules into Prolog Module
+'$exec_directive'(module(N,P), Status, _, _, _) :-
+	'$module'(Status,N,P).
+'$exec_directive'(module(N,P,Op), Status, _, _, _) :-
+	'$module'(Status,N,P,Op).
+'$exec_directive'(meta_predicate(P), _, M, _, _) :-
+    strip_module(M:P,M0,P0),
+	'$meta_predicate'(M0:P0).
+'$exec_directive'(module_transparent(P), _, M, _, _) :-
+	'$module_transparent'(P, M).
+'$exec_directive'(noprofile(P), _, M, _, _) :-
+	'$noprofile'(P, M).
+'$exec_directive'(require(Ps), _, M, _, _) :-
+	'$require'(Ps, M).
+'$exec_directive'(dynamic(P), _, M, _, _) :-
+	'$dynamic'(P, M).
+'$exec_directive'(thread_local(P), _, M, _, _) :-
+	'$thread_local'(P, M).
+'$exec_directive'(op(P,OPSEC,OP), _, _, _, _) :-
+	'$current_module'(M),
+	op(P,OPSEC,M:OP).
+'$exec_directive'(set_prolog_flag(F,V), _, _, _, _) :-
+	set_prolog_flag(F,V).
+'$exec_directive'(ensure_loaded(Fs), _, M, _, _) :-
+	'$load_files'(M:Fs, [if(changed)], ensure_loaded(Fs)).
+'$exec_directive'(char_conversion(IN,OUT), _, _, _, _) :-
+	char_conversion(IN,OUT).
+'$exec_directive'(public(P), _, M, _, _) :-
+	'$public'(P, M).
+'$exec_directive'(compile(Fs), _, M, _, _) :-
+	'$load_files'(M:Fs, [], compile(Fs)).
+'$exec_directive'(reconsult(Fs), _, M, _, _) :-
+	'$load_files'(M:Fs, [], reconsult(Fs)).
+'$exec_directive'(consult(Fs), _, M, _, _) :-
+	'$load_files'(M:Fs, [consult(consult)], consult(Fs)).
+'$exec_directive'(use_module(F), _, M, _, _) :-
+	use_module(M:F).
+'$exec_directive'(reexport(F), _, M, _, _) :-
+	'$load_files'(M:F, [if(not_loaded), silent(true), reexport(true),must_be_module(true)], reexport(F)).
+'$exec_directive'(reexport(F,Spec), _, M, _, _) :-
+	'$load_files'(M:F, [if(changed), silent(true), imports(Spec), reexport(true),must_be_module(true)], reexport(F, Spec)).
+'$exec_directive'(use_module(F, Is), _, M, _, _) :-
+	use_module(M:F, Is).
+'$exec_directive'(use_module(Mod,F,Is), _, _, _, _) :-
+	'$use_module'(Mod,F,Is).
+'$exec_directive'(block(BlockSpec), _, _, _, _) :-
+	'$block'(BlockSpec).
+'$exec_directive'(wait(BlockSpec), _, _, _, _) :-
+	'$wait'(BlockSpec).
+'$exec_directive'(table(PredSpec), _, M, _, _) :-
+	'$table'(PredSpec, M).
+'$exec_directive'(uncutable(PredSpec), _, M, _, _) :-
+	'$uncutable'(PredSpec, M).
+'$exec_directive'(if(Goal), Context, M, _, _) :-
+	'$if'(M:Goal, Context).
+'$exec_directive'(else, Context, _, _, _) :-
+	'$else'(Context).
+'$exec_directive'(elif(Goal), Context, M, _, _) :-
+	'$elif'(M:Goal, Context).
+'$exec_directive'(endif, Context, _, _, _) :-
+	'$endif'(Context).
+'$exec_directive'(license(_), Context, _, _, _) :-
+	Context \= top.
+'$exec_directive'(predicate_options(PI, Arg, Options), Context, Module, VL, Pos) :-
+	Context \= top,
+	predopts:expand_predicate_options(PI, Arg, Options, Clauses),
+	'$assert_list'(Clauses, Context, Module, VL, Pos).
+
+'$assert_list'([], _Context, _Module, _VL, _Pos).
+'$assert_list'([Clause|Clauses], Context, Module, VL, Pos) :-
+	'$command'(Clause, VL, Pos, Context),
+	'$assert_list'(Clauses, Context, Module, VL, Pos).
+
+
+%
+% allow users to define their own directives.
+%
+user_defined_directive(Dir,_) :-
+        '$directive'(Dir), !.
+user_defined_directive(Dir,Action) :-
+        functor(Dir,Na,Ar),
+        functor(NDir,Na,Ar),
+        '$current_module'(M, prolog),
+	assert_static(prolog:'$directive'(NDir)),
+	assert_static(prolog:('$exec_directive'(Dir, _, _, _, _) :- Action)),
+        '$current_module'(_, M).
+
+'$thread_initialization'(M:D) :-
+	eraseall('$thread_initialization'),
+	recorda('$thread_initialization',M:D,_),
+	fail.
+'$thread_initialization'(M:D) :-
+	'$initialization'(M:D).
+
+%
+ % This command is very different depending on the language mode we are in.
+ %
+ % ISO only wants directives in files
+ % SICStus accepts everything in files
+ % YAP accepts everything everywhere
+ %
+ '$process_directive'(G, top, M, VL, Pos) :-
+	 current_prolog_flag(language_mode, yap), !,      /* strict_iso on */
+	 '$process_directive'(G, consult, M, VL, Pos).
+ '$process_directive'(G, top, M, _, _) :-
+     !,
+	 '$do_error'(context_error((:-M:G),clause),query).
+  %
+ % default case
+ %
+ '$process_directive'(Gs, Mode, M, VL, Pos) :-
+	 '$all_directives'(Gs), !,
+	 '$exec_directives'(Gs, Mode, M, VL, Pos).
+
+ %
+ % ISO does not allow goals (use initialization).
+ %
+'$process_directive'(D, _, M, _VL, _Pos) :-
+	current_prolog_flag(language_mode, iso),
+    !, % ISO Prolog mode, go in and do it,
+	'$do_error'(context_error((:- M:D),query),directive).
+ %
+ % but YAP and SICStus do.
+ %
+ '$process_directive'(G, _Mode, M, _VL, _Pos) :-
+      '$execute'(M:G),
+      !.
+  '$process_directive'(G, _Mode, M, _VL, _Pos) :-
+      format(user_error,':- ~w:~w failed.~n',[M,G]).

packages/python/swig/yap4py/prolog/pl/eam.yap

@@ -0,0 +1,44 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*       BEAM extends the YAP Prolog system to support the EAM            *
+*									 *
+*    Copyright Ricardo Lopes and Universidade do Porto 2000-2006	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		eam.yap						         *
+* Last rev:	6/4/2006						 *
+* mods:									 *
+* comments:	Some utility predicates needed by BEAM		         *
+*									 *
+*************************************************************************/
+
+:- system_module( '$_eam', [eamconsult/1,
+        eamtrans/2], []).
+
+eamtrans(A,A):- var(A),!.
+eamtrans((A,B),(C,D)):- !, eamtrans(A,C),eamtrans(B,D).
+eamtrans((X is Y) ,(skip_while_var(Vars), X is Y  )):- !, '$variables_in_term'(Y,[],Vars).
+eamtrans((X =\= Y),(skip_while_var(Vars), X =\= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X =:= Y),(skip_while_var(Vars), X =:= Y )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X >= Y) ,(skip_while_var(Vars), X >= Y  )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X > Y)  ,(skip_while_var(Vars), X > Y   )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X < Y)  ,(skip_while_var(Vars), X < Y   )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X =< Y) ,(skip_while_var(Vars), X =< Y  )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X @>= Y) ,(skip_while_var(Vars), X @>= Y  )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X @> Y)  ,(skip_while_var(Vars), X @> Y   )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X @< Y)  ,(skip_while_var(Vars), X @< Y   )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X @=< Y) ,(skip_while_var(Vars), X @=< Y  )):- !, '$variables_in_term'(X + Y,[],Vars).
+
+eamtrans((X \= Y) ,(skip_while_var(Vars), X \= Y  )):- !, '$variables_in_term'(X + Y,[],Vars).
+eamtrans((X \== Y),(skip_while_var(Vars), X \== Y )):- !, '$variables_in_term'(X + Y,[],Vars).
+
+eamtrans(B,B).
+
+eamconsult(File):- eam, eam,                    %fails if eam is disable
+                assert((user:term_expansion((A :- B),(A :- C)):- eamtrans(B,C))),
+                eam, ( consult(File) ; true), eam,
+		abolish(user:term_expansion,2).

packages/python/swig/yap4py/prolog/pl/error.yap

@@ -0,0 +1,339 @@
+/**
+  @file pl/error.yap
+
+ @author Jan Wielemaker
+ @author Richard O'Keefe
+@author adapted to YAP by Vitor Santos Costa
+*/
+
+:- module(system(error,
+	  [ must_be_of_type/2,		% +Type, +Term
+	    must_be_of_type/3,		% +Type, +Term, +Comment
+		must_be/2,		% +Type, +Term
+  	    must_be/3,		% +Type, +Term, +Comment
+  	    type_error/2,		% +Type, +Term
+%	    must_be_in_domain/2,	% +Domain, +Term
+%	    must_be_in_domain/3,	% +Domain, +Term, +Comment
+	    domain_error/3,		% +Domain, +Values, +Term
+	    existence_error/2,		% +Type, +Term
+	    permission_error/3,		% +Action, +Type, +Term
+            must_be_instantiated/1,        % +Term
+            must_bind_to_type/2,        % +Type, ?Term
+	    instantiation_error/1,	% +Term
+	    representation_error/1, 	% +Reason
+	    is_of_type/2		% +Type, +Term
+	  ]), [])  .
+
+/**
+ @defgroup error Error generating support
+@ingroup YAPError
+
+This  SWI module  provides  predicates  to  simplify  error  generation  and
+checking. Adapted to use YAP built-ins.
+
+Its implementation is based on a discussion on the SWI-Prolog
+mailinglist on best practices in error   handling. The utility predicate
+must_be/2  provides  simple  run-time  type    validation.  The  *_error
+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
+	has_type/2.
+
+%%	@pred type_error(+Type, +Term).
+%%	@pred domain_error(+Type, +Value, +Term).
+%%	@pred existence_error(+Type, +Term).
+%%	@pred permission_error(+Action, +Type, +Term).
+%%	@pred instantiation_error(+Term).
+%%	@pred representation_error(+Reason).
+%
+%	Throw ISO compliant error messages.
+
+type_error(Type, Term) :-
+	throw(error(type_error(Type, Term), _)).
+domain_error(Type, Term) :-
+	throw(error(domain_error(Type, Term), _)).
+existence_error(Type, Term) :-
+	throw(error(existence_error(Type, Term), _)).
+permission_error(Action, Type, Term) :-
+	throw(error(permission_error(Action, Type, Term), _)).
+instantiation_error(_Term) :-
+	throw(error(instantiation_error, _)).
+representation_error(Reason) :-
+	throw(error(representation_error(Reason), _)).
+
+%%	must_be_of_type(+Type, @Term) is det.
+%
+%	True if Term satisfies the type constraints for Type. Defined
+%	types are =atom=, =atomic=, =between=, =boolean=, =callable=,
+%	=chars=, =codes=, =text=, =compound=, =constant=, =float=,
+%	=integer=, =nonneg=, =positive_integer=, =negative_integer=,
+%	=nonvar=, =number=, =oneof=, =list=, =list_or_partial_list=,
+%	=symbol=, =var=, =rational= and =string=.
+%
+%	Most of these types are defined by an arity-1 built-in predicate
+%	of the same name. Below  is  a   brief  definition  of the other
+%	types.
+%
+%	| boolean | one of =true= or =false= |
+%	| chars | Proper list of 1-character atoms |
+%	| codes | Proper list of Unicode character codes |
+%	| text | One of =atom=, =string=, =chars= or =codes= |
+%	| between(L,U) | Number between L and U (including L and U) |
+%	| nonneg | Integer >= 0 |
+%	| positive_integer | Integer > 0 |
+%	| negative_integer | Integer < 0 |
+%	| oneof(L) | Ground term that is member of L |
+%	| list(Type) | Proper list with elements of Type |
+%	| list_or_partial_list | A list or an open list (ending in a variable) |
+%	| predicate_indicator | a predicate indicator of the form M:N/A or M:N//A |
+%
+%	@throws instantiation_error if Term is insufficiently
+%	instantiated and type_error(Type, Term) if Term is not of Type.
+
+must_be(Type, X) :-
+	must_be_of_type(Type, X).
+
+must_be(Type, X, Comment) :-
+	must_be_of_type(Type, X, Comment).
+
+must_be_of_type(callable, X) :-
+	!,
+	is_callable(X, _).
+must_be_of_type(atom, X) :-
+	!,
+	is_atom(X, _).
+must_be_of_type(module, X) :-
+	!,
+	is_atom(X, _).
+must_be_of_type(predicate_indicator, X) :-
+	!,
+	is_predicate_indicator(X, _).
+must_be_of_type(Type, X) :-
+	(   has_type(Type, X)
+	->  true
+	;   is_not(Type, X)
+	).
+
+inline(must_be_of_type( atom, X ), is_atom(X, _) ).
+inline(must_be_of_type( module, X ), is_module(X, _) ).
+inline(must_be_of_type( callable, X ), is_callable(X, _) ).
+inline(must_be_of_type( callable, X ), is_callable(X, _) ).
+inline(must_be_atom( X ), is_callable(X, _) ).
+inline(must_be_module( X ), is_atom(X, _) ).
+
+must_be_of_type(predicate_indicator, X, Comment) :-
+	!,
+	is_predicate_indicator(X, Comment).
+must_be_of_type(callable, X, Comment) :-
+	!,
+	is_callable(X, Comment).
+must_be_of_type(Type, X, _Comment) :-
+	(   has_type(Type, X)
+	->  true
+	;   is_not(Type, X)
+	).
+
+must_bind_to_type(Type, X) :-
+	(   may_bind_to_type(Type, X)
+	->  true
+	;   is_not(Type, X)
+	).
+
+%%	@predicate is_not(+Type, @Term)
+%
+%	Throws appropriate error. It is _known_ that Term is not of type
+%	Type.
+%
+%	@throws type_error(Type, Term)
+%	@throws instantiation_error
+
+is_not(list, X) :- !,
+	not_a_list(list, X).
+is_not(list(_), X) :- !,
+	not_a_list(list, X).
+is_not(list_or_partial_list, X) :- !,
+	type_error(list, X).
+is_not(chars, X) :- !,
+	not_a_list(chars, X).
+is_not(codes, X) :- !,
+	not_a_list(codes, X).
+is_not(var,_X) :- !,
+	representation_error(variable).
+is_not(rational, X) :- !,
+	not_a_rational(X).
+is_not(Type, X) :-
+	(   var(X)
+	->  instantiation_error(X)
+	;   ground_type(Type), \+ ground(X)
+	->  instantiation_error(X)
+	;   type_error(Type, X)
+	).
+
+ground_type(ground).
+ground_type(oneof(_)).
+ground_type(stream).
+ground_type(text).
+ground_type(string).
+
+not_a_list(Type, X) :-
+	'$skip_list'(_, X, Rest),
+	(   var(Rest)
+	->  instantiation_error(X)
+	;   type_error(Type, X)
+	).
+
+not_a_rational(X) :-
+	(   var(X)
+	->  instantiation_error(X)
+	;   X = rdiv(N,D)
+	->  must_be(integer, N), must_be(integer, D),
+	    type_error(rational,X)
+	;   type_error(rational,X)
+	).
+
+%%	is_of_type(+Type, @Term) is semidet.
+%
+%	True if Term satisfies Type.
+
+is_of_type(Type, Term) :-
+	has_type(Type, Term).
+
+
+%%	has_type(+Type, @Term) is semidet.
+%
+%	True if Term satisfies Type.
+
+has_type(impossible, _) :-	instantiation_error(_).
+has_type(any, _).
+has_type(atom, X)	  :- atom(X).
+has_type(atomic, X)	  :- atomic(X).
+has_type(between(L,U), X) :- (   integer(L)
+			     ->  integer(X), between(L,U,X)
+			     ;   number(X), X >= L, X =< U
+			     ).
+has_type(boolean, X) 	  :- (X==true;X==false), !.
+has_type(callable, X)	  :- callable(X).
+has_type(chars,	X)	  :- chars(X).
+has_type(codes,	X)	  :- codes(X).
+has_type(text, X)	  :- text(X).
+has_type(compound, X)	  :- compound(X).
+has_type(constant, X)	  :- atomic(X).
+has_type(float, X)	  :- float(X).
+has_type(ground, X)	  :- ground(X).
+has_type(integer, X)	  :- integer(X).
+has_type(nonneg, X)	  :- integer(X), X >= 0.
+has_type(positive_integer, X)	  :- integer(X), X > 0.
+has_type(negative_integer, X)	  :- integer(X), X < 0.
+has_type(nonvar, X)	  :- nonvar(X).
+has_type(number, X)	  :- number(X).
+has_type(oneof(L), X)	  :- ground(X), lists:memberchk(X, L).
+has_type(proper_list, X)  :- is_list(X).
+has_type(list, X)  	  :- is_list(X).
+has_type(list_or_partial_list, X)  :- is_list_or_partial_list(X).
+has_type(symbol, X)	  :- atom(X).
+has_type(var, X)	  :- var(X).
+has_type(rational, X)	  :- rational(X).
+has_type(string, X)	  :- string(X).
+has_type(stream, X)	  :- is_stream(X).
+has_type(list(Type), X)	  :- is_list(X), element_types(X, Type).
+
+%%	may_bind_to_type(+Type, @Term) is semidet.
+%
+%	True if _Term_ or term _Term\theta_ satisfies _Type_.
+
+may_bind_to_type(_, X ) :- var(X), !.
+may_bind_to_type(impossible, _) :-	instantiation_error(_).
+may_bind_to_type(any, _).
+may_bind_to_type(atom, X)	  :- atom(X).
+may_bind_to_type(atomic, X)	  :- atomic(X).
+may_bind_to_type(between(L,U), X) :- (   integer(L)
+			     ->  integer(X), between(L,U,X)
+			     ;   number(X), X >= L, X =< U
+			     ).
+may_bind_to_type(boolean, X) 	  :- (X==true;X==false), !.
+may_bind_to_type(callable, X)	  :- callable(X).
+may_bind_to_type(chars,	X)	  :- chars(X).
+may_bind_to_type(codes,	X)	  :- codes(X).
+may_bind_to_type(text, X)	  :- text(X).
+may_bind_to_type(compound, X)	  :- compound(X).
+may_bind_to_type(constant, X)	  :- atomic(X).
+may_bind_to_type(float, X)	  :- float(X).
+may_bind_to_type(ground, X)	  :- ground(X).
+may_bind_to_type(integer, X)	  :- integer(X).
+may_bind_to_type(nonneg, X)	  :- integer(X), X >= 0.
+may_bind_to_type(positive_integer, X)	  :- integer(X), X > 0.
+may_bind_to_type(negative_integer, X)	  :- integer(X), X < 0.
+may_bind_to_type(predicate_indicator, X)  :-
+	(
+	 X = M:PI
+	->
+	 may_bind_to_type( atom, M),
+	 may_bind_to_type(predicate_indicator, PI)
+	;
+	 X = N/A
+	->
+	 may_bind_to_type( atom, N),
+	 may_bind_to_type(integer, A)
+	;
+	 X = N//A
+	->
+	 may_bind_to_type( atom, N),
+	 may_bind_to_type(integer, A)
+	).
+
+
+may_bind_to_type(nonvar, _X).
+may_bind_to_type(number, X)	  :- number(X).
+may_bind_to_type(oneof(L), X)	  :- ground(X), lists:memberchk(X, L).
+may_bind_to_type(proper_list, X)  :- is_list(X).
+may_bind_to_type(list, X)  	  :- is_list(X).
+may_bind_to_type(list_or_partial_list, X)  :- is_list_or_partial_list(X).
+may_bind_to_type(symbol, X)	  :- atom(X).
+may_bind_to_type(var, X)	  :- var(X).
+may_bind_to_type(rational, X)	  :- rational(X).
+may_bind_to_type(string, X)	  :- string(X).
+may_bind_to_type(stream, X)	  :- is_stream(X).
+may_bind_to_type(list(Type), X)	  :- is_list(X), element_types(X, Type).
+
+chars(0) :- !, fail.
+chars([]).
+chars([H|T]) :-
+	atom(H), atom_length(H, 1),
+	chars(T).
+
+codes(x) :- !, fail.
+codes([]).
+codes([H|T]) :-
+	integer(H), between(1, 0x10ffff, H),
+	codes(T).
+
+text(X) :-
+	(   atom(X)
+	;   string(X)
+	;   chars(X)
+	;   codes(X)
+	), !.
+
+element_types([], _).
+element_types([H|T], Type) :-
+	must_be(Type, H),
+	element_types(T, Type).
+
+is_list_or_partial_list(L0) :-
+	'$skip_list'(_, L0,L),
+	( var(L) -> true ; L == [] ).
+
+must_be_instantiated(X) :-
+  ( var(X) -> instantiation_error(X) ; true).
+
+must_be_instantiated(X, Comment) :-
+  ( var(X) -> instantiation_error(X, Comment) ; true).
+
+%% @}

packages/python/swig/yap4py/prolog/pl/errors.yap

@@ -0,0 +1,149 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		errors.yap						 *
+  * comments:	error messages for YAP					 *
+*									 *
+*									 *
+*									 *
+*************************************************************************/
+
+
+/** @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', [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/4]).
+
+
+/**
+ * @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_pi_error'(type_error(callable,Name/0),Message) :- !,
+	'$do_error'(type_error(callable,Name),Message).
+'$do_pi_error'(Error,Message) :- !,
+	'$do_error'(Error,Message).
+
+'$Error'(E) :-
+	'$LoopError'(E,top).
+
+'$LoopError'(_, _) :-
+	flush_output(user_output),
+	flush_output(user_error),
+	fail.
+'$LoopError'(Error, Level) :- !,
+	'$process_error'(Error, Level),
+	fail.
+'$LoopError'(_, _) :-
+	flush_output,
+	'$close_error',
+	fail.
+
+'$process_error'('$forward'(Msg), _) :-
+	!,
+	throw( '$forward'(Msg) ).
+'$process_error'(abort, Level) :-
+	!,
+	(
+	 Level \== top
+	->
+	 throw( abort )
+	;
+	 current_prolog_flag(break_level, 0)
+	->
+	 print_message(informational,abort(user)),
+	 fail
+	;
+	 current_prolog_flag(break_level, I0),
+	 I is I0-1,
+	 current_prolog_flag(break_level, I),
+	 throw(abort)
+	).
+'$process_error'(error(thread_cancel(_Id), _G),top) :-
+	!.
+'$process_error'(error(thread_cancel(Id), G), _) :-
+	!,
+        throw(error(thread_cancel(Id), G)).
+'$process_error'(error(permission_error(module,redefined,A),B), Level) :-
+        Level \= top, !,
+        throw(error(permission_error(module,redefined,A),B)).
+'$process_error'(Error, _Level) :-
+	functor(Error, Severity, _),
+	print_message(Severity, Error), !.
+%'$process_error'(error(Msg, Where), _) :-
+%    print_message(error,error(Msg, [g|Where])), !.
+'$process_error'(Throw, _) :-
+	print_message(error,error(unhandled_exception,Throw)).
+
+%% @}

packages/python/swig/yap4py/prolog/pl/eval.yap

@@ -0,0 +1,128 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		eval.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	optimise disjunction handling				 *
+*									 *
+*************************************************************************/
+
+:- system_module( '$_eval', [], ['$full_clause_optimisation'/4]).
+
+:- use_system_module( terms, [new_variables_in_term/3,
+        variables_within_term/3]).
+
+:- multifile '$full_clause_optimisation'/4.
+
+
+'$add_extra_safe'('$plus'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$minus'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$times'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$div'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$and'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$or'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$sll'(_,_,V)) --> !, [V].
+'$add_extra_safe'('$slr'(_,_,V)) --> !, [V].
+'$add_extra_safe'(C=D,A,B) :-
+   !,
+   ( compound(C) ->
+     '$variables_in_term'(C,E,A)
+   ;
+     E=A
+   ),
+   ( compound(D) ->
+     '$variables_in_term'(D,B,E)
+   ;
+     B=E
+   ).
+'$add_extra_safe'(_) --> [].
+
+
+'$gen_equals'([], [], _, O, O).
+'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, NO) :- V == NV, !,
+	'$gen_equals'(Commons,NCommons, LV0, O, NO).
+'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
+	'$vmember'(V,LV0),
+         OO = (V=NV,'$safe'(NV),NO),
+	'$gen_equals'(Commons,NCommons, LV0, O, NO).
+'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
+         OO = (V=NV,NO),
+	'$gen_equals'(Commons,NCommons, LV0, O, NO).
+
+'$safe_guard'((A,B), M) :- !,
+	    '$safe_guard'(A, M),
+	    '$safe_guard'(B, M).
+'$safe_guard'((A;B), M) :- !,
+	    '$safe_guard'(A, M),
+	    '$safe_guard'(B, M).
+'$safe_guard'(A, M) :- !,
+	    '$safe_builtin'(A, M).
+
+'$safe_builtin'(G, Mod) :-
+	'$predicate_flags'(G, Mod, Fl, Fl),
+	Fl /\ 0x00008880 =\= 0.
+
+'$vmember'(V,[V1|_]) :- V == V1, !.
+'$vmember'(V,[_|LV0]) :-
+	'$vmember'(V,LV0).
+
+
+'$localise_disj_vars'((B;B2), M, (NB ; NB2), LV, LV0, LEqs) :- !,
+	'$localise_vars'(B, M, NB, LV, LV0, LEqs),
+	'$localise_disj_vars'(B2, M, NB2, LV, LV0, LEqs).
+'$localise_disj_vars'(B2, M, NB, LV, LV0, LEqs) :-
+	'$localise_vars'(B2, M, NB, LV, LV0, LEqs).
+
+'$localise_vars'((A->B), M, (A->NB), LV, LV0, LEqs) :-
+	'$safe_guard'(A, M), !,
+	'$variables_in_term'(A, LV, LV1),
+	'$localise_vars'(B, M,  NB, LV1, LV0, LEqs).
+'$localise_vars'((A;B), M, (NA;NB), LV1, LV0, LEqs) :- !,
+	'$localise_vars'(A, M,  NA, LV1, LV0, LEqs),
+	'$localise_disj_vars'(B, M,  NB, LV1, LV0, LEqs).
+'$localise_vars'(((A,B),C), M, NG, LV, LV0, LEqs) :- !,
+	'$flatten_bd'((A,B),C,NB),
+	'$localise_vars'(NB, M, NG, LV, LV0, LEqs).
+'$localise_vars'((!,B), M, (!,NB), LV, LV0, LEqs) :- !,
+	'$localise_vars'(B, M,  NB, LV, LV0, LEqs).
+'$localise_vars'((X=Y,B), M, (X=Y,NB1), LV, LV0, LEqs) :-
+	var(X), var(Y), !,
+	'$localise_vars'(B, M,  NB1, LV, LV0, [X,Y|LEqs]).
+'$localise_vars'((G,B), M, (G,NB1), LV, LV0, LEqs) :-
+	'$safe_builtin'(G, M), !,
+	'$variables_in_term'(G, LV, LV1),
+	'$add_extra_safe'(G, NLV0, LV0),
+	'$localise_vars'(B, M,  NB1, LV1, NLV0, LEqs).
+'$localise_vars'((G1,B1), _, O, LV, LV0, LEqs) :- !,
+	terms:variables_within_term(LV, B1, Commons),
+	terms:new_variables_in_term(LV, B1, New),
+	copy_term(Commons+New+LEqs+B1, NCommons+NNew+NLEqs+NB1),
+	NNew = New,
+	NLEqs = LEqs,
+	'$gen_equals'(Commons, NCommons, LV0, (G1,NB1), O).
+'$localise_vars'(G, _, G, _, _, _).
+
+'$flatten_bd'((A,B),R,NB) :- !,
+	'$flatten_bd'(B,R,R1),
+	'$flatten_bd'(A,R1,NB).
+'$flatten_bd'(A,R,(A,R)).
+
+% the idea here is to make global variables in disjunctions
+% local.
+'$localise_vars_opt'(H, M, (B1;B2), (NB1;NB2)) :-
+	'$variables_in_term'(H, [], LV),
+	'$localise_vars'(B1, M, NB1, LV, LV, []),
+	'$localise_disj_vars'(B2, M, NB2, LV, LV, []).
+
+
+%, portray_clause((H:-BF))
+'$full_clause_optimisation'(H, M, B0, BF) :-
+	'$localise_vars_opt'(H, M, B0, BF), !.

packages/python/swig/yap4py/prolog/pl/flags.yap

@@ -0,0 +1,106 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		flags.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	controlling YAP						 *
+*									 *
+*************************************************************************/
+/**
+ * @file flagd.ysp
+ *
+ * @defgroup Flags Yap Flags
+ *n@{}
+ * @ingroup builtins
+ * @}@[                                                                                                                                                                                 ]
+ */
+
+
+
+:- system_module( '$_flags', [create_prolog_flag/3,
+        current_prolog_flag/2,
+        no_source/0,
+        prolog_flag/2,
+        prolog_flag/3,
+        set_prolog_flag/2,
+        source/0,
+        source_mode/2,
+        yap_flag/2,
+        yap_flag/3], []).
+
+
+'$adjust_language'(cprolog) :-
+%	'$switch_log_upd'(0),
+	'$syntax_check_mode'(_,off),
+	'$syntax_check_single_var'(_,off),
+	'$syntax_check_discontiguous'(_,off),
+	'$syntax_check_multiple'(_,off),
+	'$swi_set_prolog_flag'(character_escapes, false), % disable character escapes.
+	'$set_yap_flags'(14,1),
+	'$set_fpu_exceptions'(true),
+	unknown(_,fail).
+'$adjust_language'(sicstus) :-
+	'$switch_log_upd'(1),
+	leash(full),
+	'$syntax_check_mode'(_,on),
+	'$syntax_check_single_var'(_,on),
+	'$syntax_check_discontiguous'(_,on),
+	'$syntax_check_multiple'(_,on),
+	'$transl_to_on_off'(X1,on),
+	'$set_yap_flags'(5,X1),
+	'$force_char_conversion',
+	'$set_yap_flags'(14,0),
+	% CHARACTER_ESCAPE
+	'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
+	'$set_fpu_exceptions'(true),
+	'$swi_set_prolog_flag'(fileerrors, true),
+	unknown(_,error).
+'$adjust_language'(iso) :-
+	'$switch_log_upd'(1),
+	style_check(all),
+	fileerrors,
+	'$transl_to_on_off'(X1,on),
+	% CHAR_CONVERSION
+	'$set_yap_flags'(5,X1),
+	'$force_char_conversion',
+	% ALLOW_ASSERTING_STATIC
+	'$set_yap_flags'(14,0),
+	% CHARACTER_ESCAPE
+	'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
+	'$set_fpu_exceptions'(true),
+	unknown(_,error).
+
+
+/** @pred create_prolog_flag(+ _Flag_,+ _Value_,+ _Options_)
+
+Create a new YAP Prolog flag.  _Options_ include
+
+   * `type(+_Type_)` with _Type_ one of `boolean`, `integer`, `float`, `atom`
+and `term` (that is, any ground term)
+
+   * `access(+_Access_)` with  _Access_ one of `read_only` or `read_write`
+
+   * `keeep(+_Keep_) protect existing flag.
+*/
+create_prolog_flag(Name, Value, Options) :-
+	'$flag_domain_from_value'( Value, Type ),
+	'$create_prolog_flag'(Name, Value, [type(Type)|Options]).
+
+'$flag_domain_from_value'(true, boolean) :- !.
+'$flag_domain_from_value'(false, boolean) :- !.
+'$flag_domain_from_value'(Value, integer) :- integer(Value), !.
+'$flag_domain_from_value'(Value, float) :- float(Value), !.
+'$flag_domain_from_value'(Value, atom) :- atom(Value), !.
+'$flag_domain_from_value'(_, term).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/grammar.yap

@@ -0,0 +1,325 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		grammar.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	BNF grammar for Prolog					 *
+*									 *
+*************************************************************************/
+
+/**
+ * @file   grammar.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Thu Nov 19 10:20:55 2015
+ *
+ * @brief  Grammar Rules
+ *
+ *
+*/
+
+/**
+@defgroup Grammars Grammar Rules
+@ingroup builtins
+@{
+
+Grammar rules in Prolog are both a convenient way to express definite
+clause grammars and  an extension of the well known context-free grammars.
+
+A grammar rule is of the form:
+
+~~~~~
+head --> body
+~~~~~
+where both \a head and \a body are sequences of one or more items
+linked by the standard conjunction operator `,`.
+
+<em>Items can be:</em>
+
++
+a <em>non-terminal</em> symbol may be either a complex term or an atom.
++
+a <em>terminal</em> symbol may be any Prolog symbol. Terminals are
+written as Prolog lists.
++
+an <em>empty body</em> is written as the empty list `[ ]`.
++
+<em>extra conditions</em> may be inserted as Prolog procedure calls, by being
+written inside curly brackets `{` and `}`.
++
+the left side of a rule consists of a nonterminal and an optional list
+of terminals.
++
+alternatives may be stated in the right-hand side of the rule by using
+the disjunction operator `;`.
++
+the <em>cut</em> and <em>conditional</em> symbol (`->`) may be inserted in the
+right hand side of a grammar rule
+
+
+Grammar related built-in predicates:
+
+*/
+
+:- system_module( '$_grammar', [!/2,
+         (',')/4,
+         (->)/4,
+         ('.')/4,
+         (;)/4,
+        'C'/3,
+        []/2,
+        []/4,
+        (\+)/3,
+        phrase/2,
+        phrase/3,
+        {}/3,
+        ('|')/4], ['$do_error'/2]).
+
+% :- meta_predicate ^(?,0,?).
+% ^(Xs, Goal, Xs) :- call(Goal).
+
+% :- meta_predicate ^(?,1,?,?).
+% ^(Xs0, Goal, Xs0, Xs) :- call(Goal, Xs).
+
+/*
+    Variables X in grammar rule bodies are translated as
+    if phrase(X) had been written, where phrase/3 is obvious.
+    Also, phrase/2-3 check their first argument.
+*/
+
+prolog:'$translate_rule'(Rule, (NH :- B) ) :-
+    source_module( SM ),
+    '$yap_strip_module'( SM:Rule,  M0, (LP-->RP) ),
+    t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)),
+    '$yap_strip_module'( M0:NH0,  M, NH1 ),
+    ( M == SM -> NH = NH1 ; NH = M:NH1 ),
+    (var(NGs) ->
+	 t_body(RP, _, last, S, SR, B1)
+     ;
+     t_body((RP,{NGs}), _, last, S, SR, B1)
+    ),
+    t_tidy(B1, B).
+
+t_head(V, _, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+t_head((H,List), NH, NGs, S, S1, G0) :- !,
+	t_hgoal(H, NH, S, SR, G0),
+	t_hlist(List, S1, SR, NGs, G0).
+t_head(H, NH, _, S, SR, G0) :-
+	t_hgoal(H, NH, S, SR, G0).
+
+t_hgoal(V, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+t_hgoal(M:H, M:NH, S, SR, G0) :- !,
+	t_hgoal(H, NH, S, SR, G0).
+t_hgoal(H, NH, S, SR, _) :-
+	extend([S,SR],H,NH).
+
+t_hlist(V, _, _, _, G0) :- var(V), !,
+	'$do_error'(instantiation_error,G0).
+t_hlist([], _, _, true, _).
+t_hlist(String, S0, SR, SF, G0) :- string(String), !,
+	string_codes( String, X ),
+	t_hlist( X, S0, SR, SF, G0).
+t_hlist([H], S0, SR, ('C'(SR,H,S0)), _) :- !.
+t_hlist([H|List], S0, SR, ('C'(SR,H,S1),G0), Goal) :- !,
+	t_hlist(List, S0, S1, G0, Goal).
+t_hlist(T, _, _, _, Goal) :-
+	'$do_error'(type_error(list,T),Goal).
+
+
+%
+% Two extra variables:
+% ToFill tells whether we need to explictly close the chain of
+% variables.
+% Last tells whether we are the ones who should close that chain.
+%
+t_body(Var, filled_in, _, S, S1, phrase(Var,S,S1)) :-
+	var(Var),
+	!.
+t_body(!, to_fill, last, S, S1, (!, S1 = S)) :- !.
+t_body(!, _, _, S, S, !) :- !.
+t_body([], to_fill, last, S, S1, S1=S) :- !.
+t_body([], _, _, S, S, true) :- !.
+t_body(X, FilledIn, Last, S, SR, OS) :- string(X), !,
+	string_codes( X, Codes),
+	t_body(Codes, FilledIn, Last, S, SR, OS).
+t_body([X], filled_in, _, S, SR, 'C'(S,X,SR)) :- !.
+t_body([X|R], filled_in, Last, S, SR, ('C'(S,X,SR1),RB)) :- !,
+	t_body(R, filled_in, Last, SR1, SR, RB).
+t_body({T}, to_fill, last, S, S1, (T, S1=S)) :- !.
+t_body({T}, _, _, S, S, T) :- !.
+t_body((T,R), ToFill, Last, S, SR, (Tt,Rt)) :- !,
+	t_body(T, ToFill, not_last, S, SR1, Tt),
+	t_body(R, ToFill, Last, SR1, SR, Rt).
+t_body((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
+	t_body(T, ToFill, not_last, S, SR1, Tt),
+	t_body(R, ToFill, Last, SR1, SR, Rt).
+t_body(\+T, ToFill, _, S, SR, (Tt->fail ; S=SR)) :- !,
+	t_body(T, ToFill, not_last, S, _, Tt).
+t_body((T;R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
+	t_body(T, _, last, S, SR, Tt),
+	t_body(R, _, last, S, SR, Rt).
+t_body((T|R), _ToFill, _, S, SR, (Tt;Rt)) :- !,
+       t_body(T, _, last, S, SR, Tt),
+       t_body(R, _, last, S, SR, Rt).
+t_body(M:G, ToFill, Last, S, SR, M:NG) :- !,
+	t_body(G, ToFill, Last, S, SR, NG).
+t_body(T, filled_in, _, S, SR, Tt) :-
+	extend([S,SR], T, Tt).
+
+
+extend(More, OldT, NewT) :-
+	OldT =.. OldL,
+	lists:append(OldL, More, NewL),
+	NewT =.. NewL.
+
+t_tidy(P,P) :- var(P), !.
+t_tidy((P1;P2), (Q1;Q2)) :- !,
+	t_tidy(P1, Q1),
+	t_tidy(P2, Q2).
+t_tidy((P1->P2), (Q1->Q2)) :- !,
+	t_tidy(P1, Q1),
+	t_tidy(P2, Q2).
+t_tidy(((P1,P2),P3), Q) :-
+	t_tidy((P1,(P2,P3)), Q).
+t_tidy((true,P1), Q1) :- !,
+	t_tidy(P1, Q1).
+t_tidy((P1,true), Q1) :- !,
+	t_tidy(P1, Q1).
+t_tidy((P1,P2), (Q1,Q2)) :- !,
+	t_tidy(P1, Q1),
+	t_tidy(P2, Q2).
+t_tidy(A, A).
+
+/** @pred  `C`( _S1_, _T_, _S2_)
+
+
+This predicate is used by the grammar rules compiler and is defined as
+`C`([H|T],H,T)`.
+ */
+prolog:'C'([X|S],X,S).
+
+
+/** @pred  phrase(+ _P_, _L_)
+
+This predicate succeeds when  _L_ is a phrase of type  _P_. The
+same as `phrase(P,L,[])`.
+
+Both this predicate and the previous are used as a convenient way to
+start execution of grammar rules.
+*/
+prolog:phrase(PhraseDef, WordList) :-
+	prolog:phrase(PhraseDef, WordList, []).
+
+/** @pred  phrase(+ _P_, _L_, _R_)
+
+
+This predicate succeeds when the difference list ` _L_- _R_`
+is a phrase of type  _P_.
+*/
+prolog:phrase(V, S0, S) :-
+    var(V),
+    !,
+    '$do_error'(instantiation_error,phrase(V,S0,S)).
+prolog:phrase([H|T], S0, S) :-
+    !,
+    S0 = [H|S1],	      
+    '$phrase_list'(T, S1, S).
+prolog:phrase([], S0, S) :-
+    !,
+    S0 = S.
+prolog:phrase(P, S0, S) :-
+	call(P, S0, S).
+
+'$phrase_list'([], S, S).
+'$phrase_list'([H|T], [H|S1], S0) :-
+    '$phrase_list'(T, S1, S0).
+
+prolog:!(S, S).
+
+prolog:[](S, S).
+
+prolog:[](H, T, S0, S) :- lists:append([H|T], S, S0).
+
+prolog:'.'(H,T, S0, S) :-
+	lists:append([H|T], S, S0).
+
+prolog:{}(Goal, S0, S) :-
+	Goal,
+	S0 = S.
+
+prolog:','(A,B, S0, S) :-
+	 t_body((A,B), _, last, S0, S, Goal),
+	 '$execute'(Goal).
+
+prolog:';'(A,B, S0, S) :-
+	 t_body((A;B), _, last, S0, S, Goal),
+	 '$execute'(Goal).
+
+prolog:('|'(A,B, S0, S)) :-
+	 t_body((A|B), _, last, S0, S, Goal),
+	 '$execute'(Goal).
+
+prolog:'->'(A,B, S0, S) :-
+	 t_body((A->B), _, last, S0, S, Goal),
+	 '$execute'(Goal).
+
+prolog:'\\+'(A, S0, S) :-
+	 t_body(\+ A, _, last, S0, S, Goal),
+	 '$execute'(Goal).
+
+:- multifile system:goal_expansion/2.
+
+:- dynamic system:goal_expansion/2.
+
+'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
+    catch(prolog:'$translate_rule'(
+          (pseudo_nt --> Mod:NT), Rule),
+     	  error(Pat,ImplDep),
+     	  ( \+ '$harmless_dcgexception'(Pat),
+     	    throw(error(Pat,ImplDep))
+     	  )
+     	 ),
+         Rule = (pseudo_nt(Xs0c,Xsc) :- NewGoal0),
+         Mod:NT \== NewGoal0,
+         % apply translation only if we are safe
+         \+ '$contains_illegal_dcgnt'(NT),
+         !,
+         (   var(Xsc), Xsc \== Xs0c
+     	->  Xs = Xsc, NewGoal1 = NewGoal0
+     	;   NewGoal1 = (NewGoal0, Xsc = Xs)
+         ),
+         (   var(Xs0c)
+     	-> Xs0 = Xs0c,
+     	   NewGoal2 = NewGoal1
+     	;  ( Xs0 = Xs0c, NewGoal1 ) = NewGoal2
+         ),
+         '$yap_strip_module'(Mod:NewGoal2, M, NewGoal3),
+         (nonvar(NewGoal3) -> NewGoal = M:NewGoal3
+         ;
+          var(M) -> NewGoal = '$execute_wo_mod'(NewGoal3,M)
+         ;
+          NewGoal = '$execute_in_mod'(NewGoal3,M)
+         ).
+
+do_c_built_in('C'(A,B,C), _, _, (A=[B|C])) :- !.
+
+do_c_built_in(phrase(NT,Xs0, Xs),Mod, _, NewGoal) :- 
+    nonvar(NT), nonvar(Mod), !,
+    '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal).
+    
+do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :-
+    nonvar(NT), nonvar(Mod),
+    '$c_built_in_phrase'(NT, Xs, [], Mod, NewGoal).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/ground.yap

@@ -0,0 +1,63 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		ground.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	Variables and ground					 *
+*									 *
+*************************************************************************/
+
+/*
+% grounds all free variables
+% as terms of the form '$VAR'(N)
+
+numbervars('$VAR'(M), M, N) :- !,
+	succ(M, N).
+numbervars(Atomic, M, M) :-
+	atomic(Atomic), !.
+numbervars(Term, M, N) :-
+	functor(Term, _, Arity),
+	'$numbervars'(0,Arity, Term, M, N).
+
+'$numbervars'(A, A, _, N, N) :- !.
+'$numbervars'(A,Arity, Term, M, N) :-
+	'$succ'(A,An),
+	arg(An, Term, Arg),
+	numbervars(Arg, M, K), !,
+	'$numbervars'(An, Arity, Term, K, N).
+
+
+ground(Term) :-
+	nonvar(Term),		%  This term is not a variable,
+	functor(Term, _, Arity),
+	'$ground'(Arity, Term).	%  and none of its arguments are.
+
+'$ground'(0, _) :- !.
+'$ground'(N, Term) :-
+	'$predc'(N,M),
+	arg(N, Term, ArgN),
+	ground(ArgN),
+	'$ground'(M, Term).
+
+numbervars(Term, M, N) :-
+	'$variables_in_term'(Term, [], L),
+	'$numbermarked_vars'(L, M, N).
+
+'$numbermarked_vars'([], M, M).
+'$numbermarked_vars'([V|L], M, N) :- 
+	attvar(V), !,
+	'$numbermarked_vars'(L, M, N).
+'$numbermarked_vars'(['$VAR'(M)|L], M, N) :-
+	M1 is M+1,
+	'$numbermarked_vars'(L, M1, N).
+
+*/
+

packages/python/swig/yap4py/prolog/pl/hacks.yap

@@ -0,0 +1,255 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		utilities for messing around in YAP internals.		 *
+* comments:	error messages for YAP					 *
+*									 *
+* Last rev:     $Date: 2008-03-24 23:48:47 $,$Author: vsc $						 *
+*									 *
+*									 *
+*************************************************************************/
+
+
+%% @file pl/hacks.yap
+
+:- module('$hacks',
+	  [display_stack_info/4,
+	   display_stack_info/6,
+	   display_pc/4,
+       fully_strip_module/3,
+	   code_location/3]).
+
+/** hacks:context_variables(-NamedVariables)
+  Access variable names.
+
+  Unify NamedVariables with a list of terms _Name_=_V_
+  giving the names of the variables occurring in the last term read.
+  Notice that variable names option must have been on.
+*/
+
+hacks:context_variables(NamedVariables) :-
+	'$context_variables'(NamedVariables).
+
+
+prolog:'$stack_dump' :-
+	yap_hacks:current_choicepoints(CPs),
+	yap_hacks:current_continuations([Env|Envs]),
+	yap_hacks:continuation(Env,_,ContP,_),
+	length(CPs, LCPs),
+	length(Envs, LEnvs),
+	format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Clause          Goal~n',[LCPs,LEnvs]),
+	display_stack_info(CPs, Envs, 20, ContP, StackInfo, []),
+	run_formats(StackInfo, user_error).
+
+run_formats([], _).
+run_formats([Com-Args|StackInfo], Stream) :-
+	format(Stream, Com, Args),
+	run_formats(StackInfo, Stream).
+
+display_stack_info(CPs,Envs,Lim,PC) :-
+	display_stack_info(CPs,Envs,Lim,PC,Lines,[]),
+	flush_output(user_output),
+	flush_output(user_error),
+	print_message_lines(user_error, '', Lines).
+
+code_location(Info,Where,Location) :-
+	integer(Where) , !,
+	pred_for_code(Where,Name,Arity,Mod,Clause),
+	construct_code(Clause,Name,Arity,Mod,Info,Location).
+code_location(Info,_,Info).
+
+construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
+	number_codes(Arity,ArityCode),
+	atom_codes(ArityAtom,ArityCode),
+	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
+construct_code(0,_,_,_,Location,Location) :- !.
+construct_code(Cl,Name,Arity,Mod,Where,Location) :-
+	number_codes(Arity,ArityCode),
+	atom_codes(ArityAtom,ArityCode),
+	number_codes(Cl,ClCode),
+	atom_codes(ClAtom,ClCode),
+	atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
+
+'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
+	pred_for_code(Where,Name,Arity,Mod,Clause),
+	'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
+'$prepare_loc'(Info,_,Info).
+
+display_pc(PC, PP, Source) -->
+	{ integer(PC) },
+	{ pred_for_code(PC,Name,Arity,Mod,Clause) },
+	pc_code(Clause, PP, Name, Arity, Mod, Source).
+
+pc_code(0,_PP,_Name,_Arity,_Mod, 'top level or system code' - []) --> !.
+pc_code(-1,_PP,Name,Arity,Mod, '~a:~q/~d' - [Mod,Name,Arity]) --> !,
+	{ functor(S, Name,Arity),
+	nth_clause(Mod:S,1,Ref),
+	clause_property(Ref, file(File)),
+	clause_property(Ref, line_count(Line)) },
+	[ '~a:~d:0, ' - [File,Line] ].
+pc_code(Cl,Name,Arity,Mod, 'clause ~d for ~a:~q/~d'-[Cl,Mod,Name,Arity]) -->
+	{ Cl > 0 },
+	{ functor(S, Name,Arity),
+	nth_clause(Mod:S,Cl,Ref),
+	clause_property(Ref, file(File)),
+	clause_property(Ref, line_count(Line)) },
+	[ '~a:~d:0, ' - [File,Line] ].
+
+display_stack_info(_,_,0,_) --> !.
+display_stack_info([],[],_,_) --> [].
+display_stack_info([CP|CPs],[],I,_) -->
+	show_lone_cp(CP),
+	{ I1 is I-1 },
+	display_stack_info(CPs,[],I1,_).
+display_stack_info([],[Env|Envs],I,Cont) -->
+	show_env(Env, Cont, NCont),
+	{ I1 is I-1 },
+	display_stack_info([], Envs, I1, NCont).
+display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) -->
+	{
+	 yap_hacks:continuation(Env, _, NCont, CB),
+	 I1 is I-1
+	},
+	( { CP == Env, CB < CP } ->
+	    % if we follow choice-point and we cut to before choice-point
+	    % we are the same goal
+	   show_cp(CP, ''), %
+           display_stack_info(LCPs, LEnvs, I1, NCont)
+	;
+          { CP > Env } ->
+	   show_cp(CP, ' < '),
+	   display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
+	;
+	   show_env(Env,Cont,NCont),
+	   display_stack_info([CP|LCPs],LEnvs,I1,NCont)
+	).
+
+show_cp(CP, Continuation) -->
+	{ yap_hacks:choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo) },
+	( { Goal = (_;_) }
+          ->
+	  { scratch_goal(Name,Arity,Mod,Caller) },
+	  [ '0x~16r~t*~16+ ~d~16+ ~q ~n'-
+		[Addr, ClNo, Caller] ]
+
+	    ;
+	  [ '0x~16r~t *~16+~a ~d~16+ ~q:' -
+		[Addr, Continuation, ClNo, Mod]]
+	),
+	{ prolog_flag( debugger_print_options, Opts) },
+	{clean_goal(Goal,Mod,G)},
+	['~@.~n' -  write_term(G,Opts)].
+
+show_env(Env,Cont,NCont) -->
+	{
+	 yap_hacks:continuation(Env, Addr, NCont, _),
+	format('0x~16r 0x~16r~n',[Env,NCont]),
+	 yap_hacks:cp_to_predicate(Cont, Mod, Name, Arity, ClId)
+	},
+        [ '0x~16r~t  ~16+ ~d~16+ ~q:' -
+		[Addr, ClId, Mod] ],
+	{scratch_goal(Name, Arity, Mod, G)},
+	{ prolog_flag( debugger_print_options, Opts) },
+	['~@.~n' - write_term(G,Opts)].
+
+clean_goal(G,Mod,NG) :-
+	beautify_hidden_goal(G,Mod,[NG],[]), !.
+clean_goal(G,_,G).
+
+scratch_goal(N,0,Mod,Mod:N) :-
+	!.
+scratch_goal(N,A,Mod,NG) :-
+	list_of_qmarks(A,L),
+	G=..[N|L],
+	(
+	  beautify_hidden_goal(G,Mod,[NG],[])
+	;
+	  G = NG
+	),
+	!.
+
+list_of_qmarks(0,[]) :- !.
+list_of_qmarks(I,[?|L]) :-
+	I1 is I-1,
+	list_of_qmarks(I1,L).
+
+fully_strip_module( T, M, TF) :-
+    '$yap_strip_module'( T, M, TF).
+
+
+beautify_hidden_goal('$yes_no'(G,_Query), prolog) -->
+	!,
+	{ Call =.. [(?), G] },
+	[Call].
+beautify_hidden_goal('$do_yes_no'(G,Mod), prolog) -->
+	[Mod:G].
+beautify_hidden_goal('$query'(G,VarList), prolog) -->
+	[query(G,VarList)].
+beautify_hidden_goal('$enter_top_level', prolog) -->
+	['TopLevel'].
+% The user should never know these exist.
+beautify_hidden_goal('$csult'(Files,Mod),prolog) -->
+	[reconsult(Mod:Files)].
+beautify_hidden_goal('$use_module'(Files,Mod,Is),prolog) -->
+	[use_module(Mod,Files,Is)].
+beautify_hidden_goal('$continue_with_command'(reconsult,V,P,G,Source),prolog) -->
+	['Assert'(G,V,P,Source)].
+beautify_hidden_goal('$continue_with_command'(consult,V,P,G,Source),prolog) -->
+	['Assert'(G,V,P,Source)].
+beautify_hidden_goal('$continue_with_command'(top,V,P,G,_),prolog) -->
+	['Query'(G,V,P)].
+beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
+	['TopLevel'(Command,G,V,P,Source)].
+beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
+	['DebuggerCall'(M:G, InControl, Redo)].
+beautify_hidden_goal('$do_spy'(Goal, Mod, _CP, InControl),prolog) -->
+	['DebuggerCall'(Mod:Goal, InControl)].
+beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
+	[catch(Mod:G, Exc, Handler)].
+beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
+	[catch(G, Exc, Handler)].
+beautify_hidden_goal('$execute_command'(Query,V,P,Option,Source),prolog) -->
+	[toplevel_query(Query, V, P, Option, Source)].
+beautify_hidden_goal('$process_directive'(Gs,_Mode,_VL),prolog) -->
+	[(:- Gs)].
+beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
+	[execute_load_file(Stream, consult=Option)].
+beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
+	[load_files(Files,Opts)].
+beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
+	[Name].
+beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
+	[reconsult(Mod:Files)].
+beautify_hidden_goal('$undefp'([Mod|G]),prolog) -->
+	['CallUndefined'(Mod:G)].
+beautify_hidden_goal('$undefp'(?),prolog) -->
+	['CallUndefined'(?:?)].
+beautify_hidden_goal(repeat,prolog) -->
+	[repeat].
+beautify_hidden_goal('$recorded_with_key'(A,B,C),prolog) -->
+	[recorded(A,B,C)].
+beautify_hidden_goal('$findall_with_common_vars'(Templ,Gen,Answ),prolog) -->
+	[findall(Templ,Gen,Answ)].
+beautify_hidden_goal('$bagof'(Templ,Gen,Answ),prolog) -->
+	[bagof(Templ,Gen,Answ)].
+beautify_hidden_goal('$setof'(Templ,Gen,Answ),prolog) -->
+	[setof(Templ,Gen,Answ)].
+beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
+	[findall(T,G,S,A)].
+beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
+	[listing(M:G)].
+beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
+	[call(M:G)].
+beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
+	[call(M:G0)].
+beautify_hidden_goal('$current_predicate'(Na,M,S,_),prolog) -->
+	[current_predicate(Na,M:S)].
+beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
+	[listing(Stream,M:Pred)].

packages/python/swig/yap4py/prolog/pl/init.yap

@@ -0,0 +1,384 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+**	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		init.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	initializing the full prolog system			 *
+*									 *
+*************************************************************************/
+
+/**
+
+ @file init.yap
+
+@{
+ @defgroup library The Prolog library
+
+@}
+
+  @addtogroup YAPControl
+@ingroup builtins
+    @{
+*/
+:- system_module( '$_init', [!/0,
+        ':-'/1,
+        '?-'/1,
+        []/0,
+        extensions_to_present_answer/1,
+        fail/0,
+        false/0,
+        goal_expansion/2,
+        goal_expansion/3,
+        otherwise/0,
+        term_expansion/2,
+        version/2,
+	    '$do_log_upd_clause'/6,
+        '$do_log_upd_clause0'/6,
+        '$do_log_upd_clause_erase'/6,
+        '$do_static_clause'/5], [
+        '$system_module'/1]).
+
+:- use_system_module( '$_boot', ['$cut_by'/1]).
+
+%:- start_low_level_trace.
+
+% This is the YAP init file
+% should be consulted first step after booting
+
+% These are pseudo declarations
+% so that the user will get a redefining system predicate
+
+
+:- '$init_pred_flag_vals'('$flag_info'(a,0), prolog).
+
+/** @pred  fail is iso
+
+Always fails.
+*/
+fail :- fail.
+
+/** @pred  false is iso
+
+
+The same as fail.
+
+
+*/
+false :- fail.
+
+otherwise.
+
+!.
+
+(:- G) :- '$execute'(G), !.
+
+(?- G) :- '$execute'(G).
+
+'$$!'(CP) :- '$cut_by'(CP).
+
+[] :- true.
+
+:- set_value('$doindex',true).
+
+% just create a choice-point
+% the 6th argument marks the time-stamp.
+'$do_log_upd_clause'(_,_,_,_,_,_).
+'$do_log_upd_clause'(A,B,C,D,E,_) :-
+	'$continue_log_update_clause'(A,B,C,D,E).
+'$do_log_upd_clause'(_,_,_,_,_,_).
+
+
+'$do_log_upd_clause_erase'(_,_,_,_,_,_).
+'$do_log_upd_clause_erase'(A,B,C,D,E,_) :-
+	'$continue_log_update_clause_erase'(A,B,C,D,E).
+'$do_log_upd_clause_erase'(_,_,_,_,_,_).
+
+'$do_log_upd_clause0'(_,_,_,_,_,_).
+'$do_log_upd_clause0'(A,B,C,D,_,_) :-
+	'$continue_log_update_clause'(A,B,C,D).
+'$do_log_upd_clause0'(_,_,_,_,_,_).
+
+
+'$do_static_clause'(_,_,_,_,_).
+'$do_static_clause'(A,B,C,D,E) :-
+	'$continue_static_clause'(A,B,C,D,E).
+'$do_static_clause'(_,_,_,_,_).
+
+:- bootstrap('arith.yap').
+
+:- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
+
+:- compile_expressions.
+
+:- bootstrap('bootutils.yap').
+:- bootstrap('bootlists.yap').
+:- bootstrap('consult.yap').
+:- bootstrap('preddecls.yap').
+:- bootstrap('preddyns.yap').
+:- bootstrap('meta.yap').
+:- bootstrap('newmod.yap').
+
+:- bootstrap('atoms.yap').
+:- bootstrap('os.yap').
+:- bootstrap('grammar.yap').
+:- bootstrap('directives.yap').
+:- bootstrap('absf.yap').
+
+:- dynamic prolog:'$parent_module'/2.
+
+:- [
+	 'preds.yap',
+	 'modules.yap'
+   ].
+
+:- use_module('error.yap').
+
+
+:- [
+    'errors.yap',
+    'utils.yap',
+    'control.yap',
+    'flags.yap'
+].
+
+
+:- [
+    % lists is often used.
+   	 'yio.yap',
+	 'debug.yap',
+	 'checker.yap',
+	 'depth_bound.yap',
+	 'ground.yap',
+	 'listing.yap',
+    'arithpreds.yap',
+	 % modules must be after preds, otherwise we will have trouble
+	 % with meta-predicate expansion being invoked
+	 % must follow grammar
+	 'eval.yap',
+	 'signals.yap',
+	 'profile.yap',
+	 'callcount.yap',
+	 'load_foreign.yap',
+%	 'save.yap',
+	 'setof.yap',
+	 'sort.yap',
+	 'statistics.yap',
+	 'strict_iso.yap',
+	 'tabling.yap',
+ 	 'threads.yap',
+	 'eam.yap',
+	 'yapor.yap',
+     'qly.yap',
+     'spy.yap',
+     'udi.yap'].
+
+
+:- meta_predicate(log_event(+,:)).
+
+:- dynamic prolog:'$user_defined_flag'/4.
+
+:- multifile prolog:debug_action_hook/1.
+
+:- multifile prolog:'$system_predicate'/2.
+
+:-	 ['protect.yap'].
+
+version(yap,[6,3]).
+
+:- op(1150,fx,(mode)).
+
+:- dynamic 'extensions_to_present_answer'/1.
+
+:- 	['arrays.yap'].
+%:- start_low_level_trace.
+
+:- multifile user:portray_message/2.
+
+:- dynamic user:portray_message/2.
+
+/** @pred  _CurrentModule_:goal_expansion(+ _G_,+ _M_,- _NG_), user:goal_expansion(+ _G_,+ _M_,- _NG_)
+
+
+YAP now supports goal_expansion/3. This is an user-defined
+procedure that is called after term expansion when compiling or
+asserting goals for each sub-goal in a clause. The first argument is
+bound to the goal and the second to the module under which the goal
+ _G_ will execute. If goal_expansion/3 succeeds the new
+sub-goal  _NG_ will replace  _G_ and will be processed in the same
+ way. If goal_expansion/3 fails the system will use the defaultyap+flrules.
+
+
+*/
+:- multifile user:goal_expansion/3.
+
+:- dynamic user:goal_expansion/3.
+
+:- multifile user:goal_expansion/2.
+
+:- dynamic user:goal_expansion/2.
+
+:- multifile system:goal_expansion/2.
+
+:- dynamic system:goal_expansion/2.
+
+:- multifile goal_expansion/2.
+
+:- dynamic goal_expansion/2.
+
+:- use_module('messages.yap').
+
+:- 	['undefined.yap'].
+
+:- use_module('hacks.yap').
+
+
+:- use_module('attributes.yap').
+:- use_module('corout.yap').
+:- use_module('dialect.yap').
+:- use_module('dbload.yap').
+:- use_module('../library/ypp.yap').
+:- use_module('../os/chartypes.yap').
+:- ensure_loaded('../os/edio.yap').
+
+yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
+
+:- '$change_type_of_char'(36,7). % Make $ a symbol character
+
+:-	set_prolog_flag(generate_debug_info,true).
+
+%
+% cleanup ensure loaded and recover some data-base space.
+%
+:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
+:- ( recorded('$lf_loaded',_,R), erase(R), fail ; true ).
+:- ( recorded('$module',_,R), erase(R), fail ; true ).
+
+:- set_value('$user_module',user), '$protect'.
+
+:- style_check([+discontiguous,+multiple,+single_var]).
+
+%
+% moved this to init_gc in gc.c to separate the alpha
+%
+% :- yap_flag(gc,on).
+
+% :- yap_flag(gc_trace,verbose).
+
+:- multifile
+	prolog:comment_hook/3.
+
+:- source.
+
+:- module(user).
+
+
+/** @pred  _CurrentModule_:term_expansion( _T_,- _X_),  user:term_expansion( _T_,- _X_)
+
+
+This user-defined predicate is called by `expand_term/3` to
+preprocess all terms read when consulting a file. If it succeeds:
+
++
+If  _X_ is of the form `:- G` or `?- G`, it is processed as
+a directive.
++
+If  _X_ is of the form `$source_location`( _File_, _Line_): _Clause_` it is processed as if from `File` and line `Line`.
+
++
+If  _X_ is a list, all terms of the list are asserted or processed
+as directives.
++ The term  _X_ is asserted instead of  _T_.
+
+
+
+*/
+:- multifile term_expansion/2.
+
+:- dynamic term_expansion/2.
+
+:- multifile system:term_expansion/2.
+
+:- dynamic system:term_expansion/2.
+
+:- multifile swi:swi_predicate_table/4.
+
+/** @pred  user:message_hook(+ _Term_, + _Kind_, + _Lines_)
+
+
+Hook predicate that may be define in the module `user` to intercept
+messages from print_message/2.  _Term_ and  _Kind_ are the
+same as passed to print_message/2.  _Lines_ is a list of
+format statements as described with print_message_lines/3.
+
+This predicate should be defined dynamic and multifile to allow other
+modules defining clauses for it too.
+
+
+*/
+:- multifile user:message_hook/3.
+
+:- dynamic user:message_hook/3.
+
+/** @pred  exception(+ _Exception_, + _Context_, - _Action_)
+
+
+Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for  _Exception_ are described below. See also catch/3 and throw/1.
+If this hook predicate succeeds it must instantiate the  _Action_ argument to the atom `fail` to make the operation fail silently, `retry` to tell Prolog to retry the operation or `error` to make the system generate an exception. The action `retry` only makes sense if this hook modified the environment such that the operation can now succeed without error.
+
++ `undefined_predicate`
+ _Context_ is instantiated to a predicate-indicator ( _Module:Name/Arity_). If the predicate fails Prolog will generate an existence_error exception. The hook is intended to implement alternatives to the SWI built-in autoloader, such as autoloading code from a database. Do not use this hook to suppress existence errors on predicates. See also `unknown`.
++ `undefined_global_variable`
+ _Context_ is instantiated to the name of the missing global variable. The hook must call nb_setval/2 or b_setval/2 before returning with the action retry.
+
+*/
+
+:- multifile user:exception/3.
+
+:- dynamic user:exception/3.
+
+
+:- reconsult('pathconf.yap').
+/*
+   Add some tests
+*/
+
+
+:- yap_flag(user:unknown,error).
+
+/*
+:- if(predicate_property(run_tests, static)).
+
+aa b.
+
+p(X,Y) :- Y is X*X.
+
+prefix(information,   '% ', S,	   user_error) --> [].
+
+:- format('~d~n', [a]).
+
+:- format('~d~n', []).
+
+:- p(X,Y).
+
+a(1).
+
+a.
+
+a(2).
+a(2).
+
+lists:member(1,[1]).
+
+clause_to_indicator(T, M:Name/Arity) :- ,
+	strip_module(T, M, T1),
+	pred_arity( T1, Name, Arity ).
+:- endif.
+*/

packages/python/swig/yap4py/prolog/pl/listing.yap

@@ -0,0 +1,330 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		listing.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	listing a prolog program				 *
+*									 *
+*************************************************************************/
+
+:- system_module( '$_listing', [listing/0,
+        listing/1,
+        portray_clause/1,
+        portray_clause/2], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_preds', ['$clause'/4,
+        '$current_predicate'/4]).
+
+/* listing : Listing clauses in the database
+
+*/
+
+/** @pred  listing
+
+
+vxuLists in the current output stream all the clauses for which source code
+is available (these include all clauses for dynamic predicates and
+clauses for static predicates compiled when source mode was `on`).
+
+- listing/0 lists in the current module
+
+- listing/1 receives a generalization of the predicate indicator:
+
+    + `listing(_)` will list the whole sources.
+
+    + `listing(lists:_)` will list the module lists.
+
+    + `listing(lists:append)` will list all `append` predicates in the module lists.
+
+    + `listing(lists:append/_)` will do the same.
+
+    +  listing(lists:append/3)` will list the popular `append/3` predicate in the module lists.
+
+- listing/2 is similar to listing/1, but t he first argument is a stream reference.
+
+The `listing` family of built-ins does not enumerate predicates whose
+name starts with a `$` character.
+
+*/
+listing :-
+    current_output(Stream),
+    '$current_module'(Mod),
+    \+ system_module(Mod),
+    Mod \= prolog,
+    Mod \= system,
+    \+ '$hidden_atom'( Mod ),
+    current_predicate( Name, Mod:Pred ),
+    \+ '$undefined'(Pred, Mod), % skip predicates exported from prolog.
+    functor(Pred,Name,Arity),
+    '$listing'(Name,Arity,Mod,Stream),
+    fail.
+listing.
+
+/** @pred  listing(+ _P_)
+
+Lists predicate  _P_ if its source code is available.
+
+
+*/
+listing(MV) :-
+    current_output(Stream),
+    listing(Stream, MV).
+
+listing(Stream, MV) :-
+    strip_module( MV, M, I),
+    '$mlisting'(Stream, I, M).
+listing(_Stream, []) :- !.
+listing(Stream, [MV|MVs]) :- !,
+    listing(Stream,  MV),
+    listing(Stream, MVs).
+
+'$mlisting'(Stream, MV, M) :-
+    ( var(MV) ->
+	  MV = NA,
+	  '$do_listing'(Stream, M, NA)
+	 ;
+      atom(MV) ->
+	  MV/_ = NA,
+	  '$do_listing'(Stream, M, NA)
+	 ;
+	 MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, NA/Ar2, M), Ar2 >= 2, Ar is Ar2-2 )
+	 ;
+      MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(Ar) )  ->
+	  '$do_listing'(Stream, M, MV)
+	 ;
+      MV = M1:PP ->  '$mlisting'(Stream, PP, M1)
+	 ;
+     '$do_error'(type_error(predicate_indicator,MV),listing(Stream, MV) )
+    ).
+
+'$do_listing'(Stream, M, Name/Arity) :-
+    ( current_predicate(Name, M:Pred),
+      functor( Pred, Name, Arity),
+      \+ '$undefined'(Pred, M),
+      '$listing'(Name,Arity,M,Stream),
+      fail
+   ;
+   true
+   ).
+
+%
+% at this point we are ground and we know who we want to list.
+%
+'$listing'(Name, Arity, M, Stream) :-
+	% skip by default predicates starting with $
+        functor(Pred,Name,Arity),
+        '$list_clauses'(Stream,M,Pred).
+'$listing'(_,_,_,_).
+
+'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
+'$funcspec'(Name,Name,_) :- atom(Name), !.
+'$funcspec'(Name,_,_) :-
+	'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
+
+'$list_clauses'(Stream, M, Pred) :-
+	'$predicate_flags'(Pred,M,Flags,Flags),
+	(Flags /\ 0x48602000 =\= 0
+	->
+	  nl(Stream),
+	  fail
+	;
+          !
+        ).
+'$list_clauses'(Stream, M, Pred) :-
+    ( '$is_dynamic'(Pred, M) -> true ; '$is_log_updatable'(Pred, M) ),
+    functor( Pred, N, Ar ),
+    '$current_module'(Mod),
+    (
+	M == Mod
+    ->
+      format( Stream, ':- dynamic ~q/~d.~n', [N,Ar])
+    ;
+      format( Stream, ':- dynamic ~q:~q/~d.~n', [M,N,Ar])
+     ),
+     fail.
+'$list_clauses'(Stream, M, Pred) :-
+    '$is_thread_local'(Pred, M),
+    functor( Pred, N, Ar ),
+    '$current_module'(Mod),
+    (
+	M == Mod
+    ->
+      format( Stream, ':- thread_local ~q/~d.~n', [N,Ar])
+    ;
+      format( Stream, ':- thread_local ~q:~q/~d.~n', [M,N,Ar])
+     ),
+     fail.
+'$list_clauses'(Stream, M, Pred) :-
+    '$is_multifile'(Pred, M),
+    functor( Pred, N, Ar ),
+    '$current_module'(Mod),
+    (
+	M == Mod
+    ->
+      format( Stream, ':- multifile ~q/~d.~n', [N,Ar])
+    ;
+      format( Stream, ':- multifile ~q:~q/~d.~n', [M,N,Ar])
+     ),
+     fail.
+'$list_clauses'(Stream, M, Pred) :-
+   '$is_metapredicate'(Pred, M),
+    functor( Pred, Name, Arity ),
+    prolog:'$meta_predicate'(Name,M,Arity,PredDef),
+    '$current_module'(Mod),
+    (
+	M == Mod
+    ->
+      format( Stream, ':- ~q.~n', [PredDef])
+    ;
+      format( Stream, ':- ~q:~q.~n', [M,PredDef])
+     ),
+     fail.
+'$list_clauses'(Stream, _M, _Pred) :-
+        nl( Stream ),
+        fail.
+'$list_clauses'(Stream, M, Pred) :-
+    '$predicate_flags'(Pred,M,Flags,Flags),
+	% has to be dynamic, source, or log update.
+	Flags /\ 0x08402000 =\= 0,
+	'$clause'(Pred, M, Body, _),
+	'$current_module'(Mod),
+	( M \= Mod -> H = M:Pred ; H = Pred ),
+	'$portray_clause'(Stream,(H:-Body)),
+        fail.
+
+/** @pred  portray_clause(+ _S_,+ _C_)
+
+Write clause  _C_ on stream  _S_ as if written by listing/0.
+*/
+portray_clause(Stream, Clause) :-
+	copy_term_nat(Clause, CopiedClause),
+	'$portray_clause'(Stream, CopiedClause),
+	fail.
+portray_clause(_, _).
+
+/** @pred  portray_clause(+ _C_)
+
+Write clause  _C_ as if written by listing/0.
+
+*/
+portray_clause(Clause) :-
+        current_output(Stream),
+	portray_clause(Stream, Clause).
+
+'$portray_clause'(Stream, (Pred :- true)) :- !,
+	'$beautify_vars'(Pred),
+	format(Stream, '~q.~n', [Pred]).
+'$portray_clause'(Stream, (Pred:-Body)) :- !,
+	'$beautify_vars'((Pred:-Body)),
+	format(Stream, '~q :-', [Pred]),
+	'$write_body'(Body, 3, ',', Stream),
+	format(Stream, '.~n', []).
+'$portray_clause'(Stream, Pred) :-
+	'$beautify_vars'(Pred),
+	format(Stream, '~q.~n', [Pred]).
+
+'$write_body'(X,I,T,Stream) :- var(X), !,
+	'$beforelit'(T,I,Stream),
+	writeq(Stream, '_').
+'$write_body'((P,Q), I, T, Stream) :-
+        !,
+        '$write_body'(P,I,T, Stream),
+        put(Stream, 0',),
+        '$write_body'(Q,I,',',Stream).
+'$write_body'((P->Q;S),I,_, Stream) :-
+	!,
+	format(Stream, '~n~*c(',[I,0' ]),
+	I1 is I+2,
+	'$write_body'(P,I1,'(',Stream),
+	format(Stream, '~n~*c->',[I,0' ]),
+	'$write_disj'((Q;S),I,I1,'->',Stream),
+	format(Stream, '~n~*c)',[I,0' ]).
+'$write_body'((P->Q|S),I,_,Stream) :-
+	!,
+	format(Stream, '~n~*c(',[I,0' ]),
+	I1 is I+2,
+	'$write_body'(P,I,'(',Stream),
+	format(Stream, '~n~*c->',[I,0' ]),
+	'$write_disj'((Q|S),I,I1,'->',Stream),
+	format(Stream, '~n~*c)',[I,0' ]).
+'$write_body'((P->Q),I,_,Stream) :-
+	!,
+	format(Stream, '~n~*c(',[I,0' ]),
+	I1 is I+2,
+        '$write_body'(P,I1,'(',Stream),
+	format(Stream, '~n~*c->',[I,0' ]),
+        '$write_body'(Q,I1,'->',Stream),
+	format(Stream, '~n~*c)',[I,0' ]).
+'$write_body'((P;Q),I,_,Stream) :-
+        !,
+	format(Stream, '~n~*c(',[I,0' ]),
+	I1 is I+2,
+	'$write_disj'((P;Q),I,I1,'->',Stream),
+	format(Stream, '~n~*c)',[I,0' ]).
+'$write_body'((P|Q),I,_,Stream) :-
+        !,
+	format(Stream, '~n~*c(',[I,0' ]),
+	I1 is I+2,
+	'$write_disj'((P|Q),I,I1,'->',Stream),
+	format(Stream, '~n~*c)',[I,0' ]).
+'$write_body'(X,I,T,Stream) :-
+        '$beforelit'(T,I,Stream),
+        writeq(Stream,X).
+
+
+
+
+'$write_disj'((Q;S),I0,I,C,Stream) :- !,
+	'$write_body'(Q,I,C,Stream),
+	format(Stream, '~n~*c;',[I0,0' ]),
+	'$write_disj'(S,I0,I,';',Stream).
+'$write_disj'((Q|S),I0,I,C,Stream) :- !,
+	'$write_body'(Q,I,C,Stream),
+	format(Stream, '~n~*c|',[I0,0' ]),
+	'$write_disj'(S,I0,I,'|',Stream).
+'$write_disj'(S,_,I,C,Stream) :-
+	'$write_body'(S,I,C,Stream).
+
+
+'$beforelit'('(',_,Stream) :-
+    !,
+    format(Stream,' ',[]).
+'$beforelit'(_,I,Stream) :- format(Stream,'~n~*c',[I,0' ]).
+
+'$beautify_vars'(T) :-
+	'$list_get_vars'(T,[],L),
+	msort(L,SL),
+	'$list_transform'(SL,0).
+
+
+'$list_get_vars'(V,L,[V|L] ) :- var(V), !.
+'$list_get_vars'(Atomic, M, M) :-
+	primitive(Atomic), !.
+'$list_get_vars'([Arg|Args], M, N) :-  !,
+	'$list_get_vars'(Arg, M, K),
+	'$list_get_vars'(Args, K, N).
+'$list_get_vars'(Term, M, N) :-
+	Term =.. [_|Args],
+	'$list_get_vars'(Args, M, N).
+
+'$list_transform'([],_) :- !.
+'$list_transform'([X,Y|L],M) :-
+	X == Y,
+	X = '$VAR'(M),
+	!,
+	N is M+1,
+	'$list_transform'(L,N).
+'$list_transform'(['$VAR'(-1)|L],M) :- !,
+	'$list_transform'(L,M).
+'$list_transform'([_|L],M) :-
+	'$list_transform'(L,M).

packages/python/swig/yap4py/prolog/pl/load_foreign.yap

@@ -0,0 +1,244 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		load_foreign.yap					 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Utility predicates for load_foreign			 *
+*									 *
+*************************************************************************/
+
+
+:- system_module( '$_load_foreign', [load_foreign_files/3,
+        open_shared_object/2,
+        open_shared_object/3], ['$import_foreign'/3]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_modules', ['$do_import'/3]).
+
+/**
+
+@defgroup LoadForeign Access to Foreign Language Programs
+@ingroup fli_c_cx
+
+@{
+
+*/
+
+/** @pred load_foreign_files( _Files_, _Libs_, _InitRoutine_)
+
+should be used, from inside YAP, to load object files produced by the C
+compiler. The argument  _ObjectFiles_ should be a list of atoms
+specifying the object files to load,  _Libs_ is a list (possibly
+empty) of libraries to be passed to the unix loader (`ld`) and
+InitRoutine is the name of the C routine (to be called after the files
+are loaded) to perform the necessary declarations to YAP of the
+predicates defined in the files.
+
+YAP will search for  _ObjectFiles_ in the current directory first. If
+it cannot find them it will search for the files using the environment
+variable:
+
++ YAPLIBDIR
+
+if defined, or in the default library.
+
+YAP supports the SWI-Prolog interface to loading foreign code, the shlib package.
+
+*/
+load_foreign_files(Objs,Libs,Entry) :-
+    source_module(M),
+    '$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
+'$check_libs_for_load_foreign_files'(Libs,NewLibs,load_foreign_files(Objs,Libs,Entry)),
+'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
+    (
+	recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
+	->
+
+'$load_foreign_files'(NewObjs,NewLibs,Entry),
+        (
+	    prolog_load_context(file, F)
+	->
+	    ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
+	;
+	    true
+        )
+	;
+	true
+   ),
+   !.
+
+/** @pred load_absolute_foreign_files( _Files_, _Libs_, _InitRoutine_)
+
+Loads object files produced by the C compiler. It is useful when no search should be performed and instead one has the full paths to the _Files_ and _Libs_.
+
+*/
+load_absolute_foreign_files(Objs,Libs,Entry) :-
+    source_module(M),
+    (
+	recordzifnot( '$foreign', M:'$foreign'(Objs,Libs,Entry), _)
+	->
+	'$load_foreign_files'(Objs,Libs,Entry),
+        (
+	    prolog_load_context(file, F)
+	->
+	    ignore( recordzifnot( '$load_foreign_done', [F, M], _) )
+	;
+	    true
+        )
+	;
+	true
+   ),
+   !.
+
+'$check_objs_for_load_foreign_files'(V,_,G) :- var(V), !,
+	'$do_error'(instantiation_error,G).
+'$check_objs_for_load_foreign_files'([],[],_) :- !.
+'$check_objs_for_load_foreign_files'([Obj|Objs],[NObj|NewObjs],G) :- !,
+	'$check_obj_for_load_foreign_files'(Obj,NObj,G),
+	'$check_objs_for_load_foreign_files'(Objs,NewObjs,G).
+'$check_objs_for_load_foreign_files'(Objs,_,G) :-
+	'$do_error'(type_error(list,Objs),G).
+
+'$check_obj_for_load_foreign_files'(V,_,G) :- var(V), !,
+	'$do_error'(instantiation_error,G).
+'$check_obj_for_load_foreign_files'(Obj,NewObj,_) :- atom(Obj), !,
+        ( atom(Obj), Obj1 = foreign(Obj) ; Obj1 = Obj ),
+	absolute_file_name(foreign(Obj),[file_type(executable),
+					 access(read),
+					 expand(true),
+					 file_errors(fail)
+					], NewObj).
+'$check_obj_for_load_foreign_files'(Obj,_,G) :-
+	'$do_error'(type_error(atom,Obj),G).
+
+'$check_libs_for_load_foreign_files'(V,_,G) :- var(V), !,
+	'$do_error'(instantiation_error,G).
+'$check_libs_for_load_foreign_files'([],[],_) :- !.
+'$check_libs_for_load_foreign_files'([Lib|Libs],[NLib|NLibs],G) :- !,
+	'$check_lib_for_load_foreign_files'(Lib,NLib,G),
+	'$check_libs_for_load_foreign_files'(Libs,NLibs,G).
+'$check_libs_for_load_foreign_files'(Libs,_,G) :-
+	'$do_error'(type_error(list,Libs),G).
+
+'$check_lib_for_load_foreign_files'(V,_,G) :- var(V), !,
+	'$do_error'(instantiation_error,G).
+'$check_lib_for_load_foreign_files'(Lib,NLib,_) :- atom(Lib), !,
+	'$process_obj_suffix'(Lib,NewLib),
+	'$checklib_prefix'(NewLib,NLib).
+'$check_lib_for_load_foreign_files'(Lib,_,G) :-
+	'$do_error'(type_error(atom,Lib),G).
+
+'$process_obj_suffix'(Obj,Obj) :-
+	current_prolog_flag(shared_object_extension, ObjSuffix),
+	sub_atom(Obj, _, _, 0, ObjSuffix), !.
+'$process_obj_suffix'(Obj,NewObj) :-
+	current_prolog_flag(shared_object_extension, ObjSuffix),
+	atom_concat([Obj,'.',ObjSuffix],NewObj).
+
+'$checklib_prefix'(F,F) :- is_absolute_file_name(F), !.
+'$checklib_prefix'(F, F) :-
+	sub_atom(F, 0, _, _, lib), !.
+'$checklib_prefix'(F, Lib) :-
+	atom_concat(lib, F, Lib).
+
+'$import_foreign'(F, M0, M) :-
+    M \= M0,
+    predicate_property(M0:P,built_in),
+    predicate_property(M0:P,file(F)),
+    functor(P, N, K),
+    '$do_import'(N/K-N/K, M0, M),
+    fail.
+'$import_foreign'(_F, _M0, _M).
+
+'$check_entry_for_load_foreign_files'(V,G) :- var(V), !,
+	'$do_error'(instantiation_error,G).
+'$check_entry_for_load_foreign_files'(Entry,_) :- atom(Entry), !.
+'$check_entry_for_load_foreign_files'(Entry,G) :-
+	'$do_error'(type_error(atom,Entry),G).
+
+/** @pred open_shared_object(+ _File_, - _Handle_)
+
+File is the name of a shared object file (called dynamic load
+library in MS-Windows). This file is attached to the current process
+and  _Handle_ is unified with a handle to the library. Equivalent to
+`open_shared_object(File, [], Handle)`. See also
+load_foreign_library/1 and `load_foreign_library/2`.
+
+On errors, an exception `shared_object`( _Action_,
+ _Message_) is raised.  _Message_ is the return value from
+dlerror().
+
+
+*/
+open_shared_object(File, Handle) :-
+	open_shared_object(File, [], Handle).
+
+/** @pred open_shared_object(+ _File_, - _Handle_, + _Options_)
+
+As `open_shared_object/2`, but allows for additional flags to
+be passed.  _Options_ is a list of atoms. `now` implies the
+symbols are
+resolved immediately rather than lazily (default). `global` implies
+symbols of the loaded object are visible while loading other shared
+objects (by default they are local). Note that these flags may not
+be supported by your operating system. Check the documentation of
+`dlopen()` or equivalent on your operating system. Unsupported
+flags  are silently ignored.
+
+
+*/
+open_shared_object(File, Opts, Handle) :-
+	'$open_shared_opts'(Opts, open_shared_object(File, Opts, Handle), OptsI),
+	'$open_shared_object'(File, OptsI, Handle),
+	prolog_load_context(module, M),
+	ignore( recordzifnot( '$foreign', M:'$swi_foreign'(File,Opts, Handle), _) ).
+
+'$open_shared_opts'(Opts, G, _OptsI) :-
+	var(Opts), !,
+	'$do_error'(instantiation_error,G).
+'$open_shared_opts'([], _, 0) :- !.
+'$open_shared_opts'([Opt|Opts], G, V) :-
+	'$open_shared_opts'(Opts, G, V0),
+	'$open_shared_opt'(Opt, G, OptV),
+	V0 is V \/ OptV.
+
+'$open_shared_opt'(Opt, G, _) :-
+	var(Opt), !,
+	'$do_error'(instantiation_error,G).
+'$open_shared_opt'(now, __, 1) :- !.
+'$open_shared_opt'(global, __, 2) :- !.
+'$open_shared_opt'(Opt, Goal, _) :-
+	'$do_error'(domain_error(open_shared_object_option,Opt),Goal).
+
+/** @pred call_shared_object_function(+ _Handle_, + _Function_)
+
+Call the named function in the loaded shared library. The function is
+called without arguments and the return-value is ignored. YAP supports
+installing foreign language predicates using calls to 'UserCCall()`,
+`PL_register_foreign()`, and friends.
+
+ */
+
+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 ), _) ).
+%% @}
+
+/** @pred $slave is det
+
+Called at boot-time when Prolog is run from another language (eg, Java, Python, Android)
+*/
+
+'$slave' :-
+    getenv( '__PYVENV_LAUNCHER__', _ ),
+    use_module( library(python) ).

packages/python/swig/yap4py/prolog/pl/messages.yap

@@ -0,0 +1,987 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+  *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		utilities for displaying messages in YAP.		 *
+* comments:	error messages for YAP					 *
+*									 *
+* Last rev:     $Date: 2008-07-16 10:58:59 $,$Author: vsc $						 *
+*									 *
+*									 *
+*************************************************************************/
+
+/**
+ * @file   messages.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Thu Nov 19 10:22:26 2015
+ *
+ * @brief  The YAP Message Handler
+ *
+ *
+*/
+
+/**
+
+  @defgroup Messages Message Handling
+  @ingroup YAPControl
+
+The interaction between YAP and the user relies on YAP's ability to
+portray messages. These messages range from prompts to error
+information. All message processing is performed through the builtin
+print_message/2, in two steps:
+
++ The message is processed into a list of commands
++ The commands in the list are sent to the `format/3` builtin
+in sequence.
+
+
+The first argument to print_message/2 specifies the importance of
+the message. The options are:
+
++ `error`
+error handling
++ `warning`
+compilation and run-time warnings,
++ `informational`
+generic informational messages
++ `help`
+help messages (not currently implemented in YAP)
++ `query`
+query 	used in query processing (not currently implemented in YAP)
++ `silent`,M,Na,Ar,File, FilePos]],
+	[nl, nl].
+caller( error(_,Term), _) -->
+	{  lists:memberchk([g|g(Call)], Term) },
+	['~*|called from
+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:
+
+
+An error record comsists of An ISO compatible descriptor of the format
+
+error(errror_kind(Culprit,..), Info)
+
+In YAP, the infoo field describes:
+
+- what() more detauls on the event
+
+- input_stream, may be ine of;
+
+	- loop_sream
+	- file()
+	- none
+
+	- prolog_source(_) a record containing file, line, predicate, and clause
+ that activated the goal, or a list therof. YAP tries to search for the user
+ code generatinng the error.
+
+ - c_source(0), a record containing the line of C-code thhat caused the event. This
+ is reported under systm debugging mode, or if  this is user code.
+
+ - stream_source() - a record containg data on the the I/O stream datum causisng the evwnt.
+
+ - user_message () - ttext on the event.
+
+
+
+@{
+
+*/
+
+
+
+:- module(system('$messages'),
+	  [system_message/4,
+	   prefix/6,
+	   prefix/5,
+	   file_location/3]).
+
+
+:- use_system_module( user, [message_hook/3]).
+
+:- multifile prolog:message/3.
+
+:- multifile user:message_hook/3.
+
+
+/** @pred  message_to_string(+ _Term_, - _String_)
+
+
+Translates a message-term into a string object. Primarily intended for SWI-Prolog emulation.
+
+
+
+ */
+prolog:message_to_string(Event, Message) :-
+	translate_message(Event, warning, Message, []).
+
+
+%%	@pred compose_message(+Term, +Level, +Lines, -Lines0) is det
+%
+%	Print the message if the user did not intercept the message.
+%	The first is used for errors and warnings that can be related
+%	to source-location.  Note that syntax errors have their own
+%	source-location and should therefore not be handled this way.
+compose_message( Term, Level ) -->
+	['   ~w:'- [Level]
+	],
+	prolog:message(Term), !.
+compose_message( query(_QueryResult,_), _Level) -->
+	[].
+compose_message( absolute_file_path(File), _Level) -->
+	[ '~N~n  absolute_file of ~w' - [File] ].
+compose_message( absolute_file_path(Msg, Args), _Level) -->
+	[ '     : ' - [],
+	  Msg - Args,
+	  nl ].
+compose_message( arguments([]), _Level) -->
+	[].
+compose_message( arguments([A|As]), Level) -->
+	[ '  ~w' - [A],
+	  nl ],
+	  compose_message( arguments(As), Level).
+compose_message( ancestors([]), _Level) -->
+	[ 'There are no ancestors.' ].
+compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,already), _Level) -->
+	[ 'There is already a spy point on ~w:~w/~w.' - [M,F,N] ].
+compose_message( breakp(bp(debugger,_,_,M:F/N,_),add,ok), _Level) -->
+	[ 'Spy point set on ~w:~w/~w.' - [M,F,N] ].
+compose_message( breakp(bp(debugger,_,_,M:F/N,_),remove,last), _Level) -->
+	[ 'Spy point on ~w:~w/~w removed.' - [M,F,N] ].
+compose_message( breakp(no,breakpoint_for,M:F/N), _Level) -->
+	[ 'There is no spy point on ~w:~w/~w.' - [M,F,N] ].
+compose_message( breakpoints([]), _Level) -->
+	[ 'There are no spy-points set.' ].
+compose_message( breakpoints(L), _Level) -->
+	[ 'Spy-points set on:' ],
+	list_of_preds(L).
+compose_message( clauses_not_together(P), _Level) -->
+	[ 'Discontiguous definition of ~q.' - [P] ].
+compose_message( debug(debug), _Level) -->
+	[ 'Debug mode on.' - [] ].
+compose_message( debug(off), _Level) -->
+	[ 'Debug mode off.'- [] ].
+compose_message( debug(trace), _Level) -->
+	[ 'Trace mode on.'- [] ].
+compose_message( declaration(Args,Action), _Level) -->
+	[ 'declaration ~w ~w.' - [Args,Action] ].
+compose_message( defined_elsewhere(P,F), _Level) -->
+	[  'predicate ~q previously defined in file ~w' - [P,F] ].
+compose_message( functionality(Library), _Level) -->
+	[  '~q not available' - [Library] ].
+compose_message( import(Pred,To,From,private), _Level) -->
+	[ 'Importing private predicate ~w:~w to ~w.' - [From,Pred,To] ].
+compose_message( redefine_imported(M,M0,PI), _Level) -->
+	{ source_location(ParentF, Line) },
+	[ '~w:~w: Module ~w redefines imported predicate ~w:~w.' - [ParentF, Line, M,M0,PI] ].
+compose_message( leash([]), _Level) -->
+	[ 'No leashing.' ].
+compose_message( leash([A|B]), _Level) -->
+	[ 'Leashing set to ~w.' - [[A|B]] ].
+compose_message( no, _Level) -->
+	[ 'no' - []  ].
+compose_message( no_match(P), _Level) -->
+	[ 'No matching predicate for ~w.' - [P] ].
+compose_message( leash([A|B]), _Level) -->
+	[  'Leashing set to ~w.' - [[A|B]] ].
+compose_message( halt, _Level) --> !,
+	[ 'YAP execution halted.'-[] ].
+compose_message( false, _Level) --> !,
+	[ 'false.'-[] ].
+compose_message( '$abort', _Level) --> !,
+	[ 'YAP execution aborted'-[] ].
+compose_message( abort(user), _Level) --> !,
+	[ 'YAP execution aborted' - [] ].
+compose_message( loading(_,F), _Level) --> { F == user }, !.
+compose_message( loading(What,FileName), _Level) --> !,
+	[ '~a ~w...' - [What, FileName] ].
+compose_message( loaded(_,user,_,_,_), _Level) --> !.
+compose_message( loaded(included,AbsFileName,Mod,Time,Space), _Level) --> !,
+	[ '~a included in module ~a, ~d msec ~d bytes' -
+		     [AbsFileName,Mod,Time,Space] ].
+compose_message( loaded(What,AbsoluteFileName,Mod,Time,Space), _Level) --> !,
+	[ '~a ~a in module ~a, ~d msec ~d bytes' -
+		     [What, AbsoluteFileName,Mod,Time,Space] ].
+compose_message(trace_command(-1), _Leve) -->
+	[ 'EOF is not a valid debugger command.'  ].
+compose_message(trace_command(C), _Leve) -->
+	[ '~c is not a valid debugger command.' - [C] ].
+compose_message(trace_help, _Leve) -->
+	[ '   Please enter a valid debugger command (h for help).'  ].
+compose_message(version(Version), _Leve) -->
+	[ '~a' - [Version] ].
+compose_message(myddas_version(Version), _Leve) -->
+	[ 'MYDDAS version ~a' - [Version] ].
+compose_message(yes, _Level) --> !,
+	[  'yes'- []  ].
+compose_message(Term, Level) -->
+		{ '$show_consult_level'(LC) },
+	location(Term, Level, LC),
+	main_message( Term, Level, LC ),
+	c_goal( Term, Level ),
+	caller( Term, Level ),
+	extra_info(  Term, Level ),
+	!,
+	[nl,nl].
+compose_message(Term, Level) -->
+	{  Level == error -> true ; Level == warning },
+	{ '$show_consult_level'(LC) },
+	main_message( Term, Level, LC),
+	[nl,nl].
+
+location(error(syntax_error(_),info(between(_,LN,_), FileName, _)), _ , _) -->
+		!,
+	[ '~a:~d:~d ' - [FileName,LN,0] ] .
+
+location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
+	!,
+	[ '~a:~d:0 ' - [FileName,LN] ] .
+location( error(_,Term), Level, LC ) -->
+	{  source_location(F0, L),
+	   stream_property(_Stream, alias(loop_stream)) }, !,
+	display_consulting( F0, Level, LC ),
+	{ lists:memberchk([p|p(M,Na,Ar,_File,_FilePos)], Term ) },
+	[  '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
+location( error(_,Term), Level, LC ) -->
+	{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) }, !,
+	display_consulting( File, Level, LC ),
+	[  '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
+
+%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
+main_message(error(Msg,Info), _, _) --> {var(Info)}, !,
+	[  ' error: uninstantiated message ~w~n.' - [Msg], nl ].
+main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream,Term)), Level, LC ) -->
+	!,
+	  [' ~a: syntax error ~s' - [Level,Msg]],
+	  [nl],
+	  ( syntax_error_term( between(L0,LM,LF), Term, LC )
+	  ->
+	    []
+	  ;
+	    [' ~a: failed_processing syntax error term ~q' - [Level,Term]],
+	    [nl]
+	  ).
+main_message(error(style_check(style_check(singleton(SVs),_Pos,_File,P)),_), Level, _LC) -->
+    !,
+%    {writeln(ci)},
+	{ clause_to_indicator(P, I) },
+	[  ' ~a: singleton variable~*c ~s in ~q.' - [ Level,  NVs, 0's, SVsL, I] ],
+	{ svs(SVs,SVs,SVsL),
+	  ( SVs = [_] -> NVs = 0 ; NVs = 1 )
+	}.
+main_message(error(style_check(style_check(multiple(N,A,Mod,I0),_Pos,File,_P)),_), Level, _LC) -->
+    !,
+	[  ' ~a: ~a redefines ~q from  ~a.' - [Level,File, Mod:N/A, I0] ].
+main_message(error(style_check(style_check(discontiguous(N,A,Mod),_S,_W,_P)),_) , Level, _LC)-->
+    !,
+	[  ' ~a: discontiguous definition for ~p.' - [Level,Mod:N/A] ].
+main_message(error(consistency_error(Who)), Level, _LC) -->
+    !,
+	[ ' ~a: has argument ~a not consistent with type.'-[Level,Who] ].
+main_message(error(domain_error(Who , Type), _Where), Level, _LC) -->
+    !,
+    	[ ' ~a:  ~q does not belong to domain ~a,' - [Level,Type,Who], nl ].
+	main_message(error(evaluation_error(What), _Where), Level, _LC) -->
+	        !,
+	        [ ' ~a: ~w during evaluation of arithmetic expressions,' - [Level,What], nl ].
+		main_message(error(evaluation_error(What, Who), _Where), Level, _LC) -->
+		        !,
+		        [ ' ~a: ~w caused ~a during evaluation of arithmetic expressions,' - [Level,Who,What], nl ].
+main_message(error(existence_error(Type , Who), _Where), Level, _LC) -->
+    !,
+	[  ' ~a:  ~q ~q could not be found,' - [Level,Type, Who], nl ].
+main_message(error(permission_error(Op, Type, Id), _Where), Level, _LC) -->
+	[ ' ~a:  ~q is not allowed in ~a ~q,' - [Level, Op, Type,Id], nl ].
+main_message(error(instantiation_error, _Where), Level, _LC) -->
+	[ ' ~a: unbound variable' - [Level], nl ].
+main_message(error(representation_error(Type)), Level, _LC) -->
+	[ ' ~a: ~a representation error ~a' - [Level, Type], nl ].
+main_message(error(type_error(Type,Who), _What), Level, _LC) -->
+	[ ' ~a: ~q should be of type ~a' - [Level,Who,Type]],
+	[ nl ].
+main_message(error(system_error(Who), _What), Level, _LC) -->
+	[ ' ~a: ~q error' - [Level,Who]],
+	[ nl ].
+main_message(error(uninstantiation_error(T),_), Level, _LC) -->
+	[ ' ~a: found ~q, expected unbound variable ' - [Level,T], nl ].
+
+display_consulting( F, Level, LC) -->
+	{  LC > 0,
+	   source_location(F0, L),
+		  F \= F0
+	 }, !,
+	[ '~a:~d:0: ~a  while compiling.'-[F0,L,Level], nl ].
+display_consulting(_F, _, _LC) -->
+	  [].
+
+caller( error(_,Term), _) -->
+	{  lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },
+	{  lists:memberchk([g|g(Call)], Term) },
+	  !,
+	  ['~*|goal was ~q' - [10,Call]],
+	  [nl],
+	  ['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
+	[nl].
+caller( error(_,Term), _) -->
+	{ lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) },
+	!,
+	['~*|exception raised from  ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
+	[nl].
+caller( error(_,Term), _) -->
+	{  lists:memberchk([g|g(Call)], Term) },
+	!,
+	['~*|goal  ~q '-[10,Call]],
+	[nl].
+caller( _, _) -->
+	[].
+
+c_goal( error(_,Term), Level ) -->
+	{ lists:memberchk([c|c(File, Line, Func)], Term ) },
+	!,
+	['~*|~a raised at C-function ~a() in ~a:~d:0: '-[10, Level, Func, File, Line]],
+	[nl].
+c_goal( _, _Level ) --> [].
+
+
+prolog_message(X) -->
+	system_message(X).
+
+system_message(error(Msg,Info)) -->
+	( { var(Msg) } ; { var(Info)} ), !,
+	['bad error ~w' - [error(Msg,Info)]].
+system_message(error(consistency_error(Who),Where)) -->
+	[ 'CONSISTENCY ERROR (arguments not compatible with format)- ~w ~w' - [Who,Where] ].
+system_message(error(context_error(Goal,Who),Where)) -->
+	[ 'CONTEXT ERROR- ~w: ~w appeared in ~w' - [Goal,Who,Where] ].
+system_message(error(domain_error(DomainType,Opt), Where)) -->
+	[ 'DOMAIN ERROR- ~w: ' - Where],
+	domain_error(DomainType, Opt).
+system_message(error(format_argument_type(Type,Arg), Where)) -->
+	[ 'FORMAT ARGUMENT ERROR- ~~~a called with ~w in ~w: ' - [Type,Arg,Where]].
+system_message(error(existence_error(directory,Key), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
+system_message(error(existence_error(key,Key), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
+system_message(error(existence_error(mutex,Key), Where)) -->
+    [ 'EXISTENCE ERROR- ~w: ~w is an erased mutex' - [Where,Key] ].
+system_message(existence_error(prolog_flag,F)) -->
+	[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
+system_message(error(existence_error(prolog_flag,P), Where)) --> !,
+	[ 'EXISTENCE ERROR- ~w: prolog flag ~w is undefined' - [Where,P] ].
+system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
+	[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context  ~w~n                 Goal was ~w' - [P,Parent,Call] ].
+system_message(error(existence_error(stream,Stream), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ].
+system_message(error(existence_error(thread,Thread), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
+system_message(error(existence_error(variable,Var), Where)) -->
+	[ 'EXISTENCE ERROR- ~w: variable ~w does not exist' - [Where,Var] ].
+system_message(error(existence_error(Name,F), W)) -->
+	{ object_name(Name, ObjName) },
+	[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].
+system_message(error(evaluation_error(int_overflow), Where)) -->
+	[ 'INTEGER OVERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(float_overflow), Where)) -->
+	[ 'FLOATING POINT OVERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(undefined), Where)) -->
+	[ 'UNDEFINED ARITHMETIC RESULT ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(underflow), Where)) -->
+	[ 'UNDERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(float_underflow), Where)) -->
+	[ 'FLOATING POINT UNDERFLOW ERROR- ~w' - [Where] ].
+system_message(error(evaluation_error(zero_divisor), Where)) -->
+	[ 'ZERO DIVISOR ERROR- ~w' - [Where] ].
+system_message(error(not_implemented(Type, What), Where)) -->
+	[ '~w: ~w not implemented- ~w' - [Where, Type, What] ].
+system_message(error(operating_SYSTEM_ERROR_INTERNAL, Where)) -->
+	[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
+system_message(error(out_of_heap_error, Where)) -->
+	[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_stack_error, Where)) -->
+	[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_trail_error, Where)) -->
+	[ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_attvars_error, Where)) -->
+	[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(out_of_auxspace_error, Where)) -->
+	[ 'OUT OF AUXILIARY STACK SPACE ERROR- ~w' - [Where] ].
+system_message(error(permission_error(access,private_procedure,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot see clauses for ~w' - [Where,P] ].
+system_message(error(permission_error(access,static_procedure,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot access static procedure ~w' - [Where,P] ].
+system_message(error(permission_error(alias,new,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ].
+system_message(error(permission_error(create,Name,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,Name,P] ].
+system_message(error(permission_error(import,M1:I,redefined,SecondMod), Where)) -->
+	[ 'PERMISSION ERROR- loading ~w: modules ~w and ~w both define ~w' - [Where,M1,SecondMod,I] ].
+system_message(error(permission_error(input,binary_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from binary stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,closed_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: trying to read from closed stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,past_end_of_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: past end of stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from ~w' - [Where,Stream] ].
+system_message(error(permission_error(input,text_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot read from text stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
+system_message(error(permission_error(modify,flag,W), _)) -->
+	[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
+system_message(error(permission_error(modify,operator,W), Q)) -->
+	[ 'PERMISSION ERROR- ~w: cannot modify operator ~q' - [Q,W] ].
+system_message(error(permission_error(modify,dynamic_procedure,F), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying dynamic procedure ~w' - [Where,F] ].
+system_message(error(permission_error(modify,static_procedure,F), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying static procedure ~w' - [Where,F] ].
+system_message(error(permission_error(modify,static_procedure_in_use,_), Where)) -->
+	[ 'PERMISSION ERROR- ~w: modifying a static procedure in use' - [Where] ].
+system_message(error(permission_error(modify,table,P), _)) -->
+	[ 'PERMISSION ERROR- cannot table procedure ~w' - [P] ].
+system_message(error(permission_error(module,redefined,Mod), Who)) -->
+	[ 'PERMISSION ERROR ~w- redefining module ~a in a different file' - [Who,Mod] ].
+system_message(error(permission_error(open,source_sink,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot open file ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,binary_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot
+	write to binary stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot write to ~w' - [Where,Stream] ].
+system_message(error(permission_error(output,text_stream,Stream), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot write to text stream ~w' - [Where,Stream] ].
+system_message(error(permission_error(resize,array,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot resize array ~w' - [Where,P] ].
+system_message(error(permission_error(unlock,mutex,P), Where)) -->
+	[ 'PERMISSION ERROR- ~w: cannot unlock mutex ~w' - [Where,P] ].
+system_message(error(representation_error(character), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: expected character' - [Where] ].
+system_message(error(representation_error(character_code), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: expected character code' - [Where] ].
+system_message(error(representation_error(max_arity), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ].
+system_message(error(representation_error(variable), Where)) -->
+	[ 'REPRESENTATION ERROR- ~w: should be a variable' - [Where] ].
+system_message(error(resource_error(code_space), Where)) -->
+	[ 'RESOURCE ERROR- not enough code space' - [Where] ].
+system_message(error(resource_error(huge_int), Where)) -->
+	[ 'RESOURCE ERROR- too large an integer in absolute value' - [Where] ].
+system_message(error(resource_error(memory), Where)) -->
+	[ 'RESOURCE ERROR- not enough virtual memory' - [Where] ].
+system_message(error(resource_error(stack), Where)) -->
+	[ 'RESOURCE ERROR- not enough stack' - [Where] ].
+system_message(error(resource_error(streams), Where)) -->
+	[ 'RESOURCE ERROR- could not find a free stream' - [Where] ].
+system_message(error(resource_error(threads), Where)) -->
+	[ 'RESOURCE ERROR- too many open threads' - [Where] ].
+system_message(error(resource_error(trail), Where)) -->
+	[ 'RESOURCE ERROR- not enough trail space' - [Where] ].
+system_message(error(signal(SIG,_), _)) -->
+	[ 'UNEXPECTED SIGNAL: ~a' - [SIG] ].
+% SWI like I/O error message.
+system_message(error(unhandled_exception,Throw)) -->
+	[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
+system_message(error(uninstantiation_error(TE), _Where)) -->
+	[ 'UNINSTANTIATION ERROR - expected unbound term, got ~q' - [TE] ].
+system_message(Messg) -->
+	[ '~q' - Messg ].
+
+
+domain_error(array_overflow, Opt) --> !,
+	[ 'invalid static index ~w for array' - Opt ].
+domain_error(array_type, Opt) --> !,
+	[ 'invalid static array type ~w' - Opt ].
+domain_error(builtin_procedure, _) --> !,
+	[ 'non-iso built-in procedure'  ].
+domain_error(character_code_list, Opt) --> !,
+	[ 'invalid list of codes ~w' - [Opt] ].
+domain_error(close_option, Opt) --> !,
+	[ 'invalid close option ~w' - [Opt] ].
+domain_error(delete_file_option, Opt) --> !,
+	[ 'invalid list of options ~w' - [Opt] ].
+domain_error(encoding, Opt) --> !,
+	[ 'invalid encoding ~w' - [Opt] ].
+domain_error(flag_value, [Opt,Flag]) --> !,
+	[ 'invalid value ~w for flag ~w' - [Opt,Flag] ].
+domain_error(flag_value, Opt) --> !,
+	[ 'invalid value ~w for flag' - [Opt] ].
+domain_error(io_mode, Opt) --> !,
+	[ 'invalid io mode ~w' - [Opt] ].
+domain_error(mutable, Opt) --> !,
+	[ 'invalid id mutable ~w' - [Opt] ].
+domain_error(module_decl_options, Opt) --> !,
+	[ 'expect module declaration options, found ~w' - [Opt] ].
+domain_error(non_empty_list, Opt) --> !,
+	[ 'found empty list' - [Opt] ].
+domain_error(not_less_than_zero, Opt) --> !,
+	[ 'number ~w less than zero' - [Opt] ].
+domain_error(not_newline, Opt) --> !,
+	[ 'number ~w not newline' - [Opt] ].
+domain_error(not_zero, Opt) --> !,
+	[ '~w is not allowed in the domain' - [Opt] ].
+domain_error(operator_priority, Opt) --> !,
+	[ '~w invalid operator priority' - [Opt] ].
+domain_error(operator_specifier, Opt) --> !,
+	[ 'invalid operator specifier ~w' - [Opt] ].
+domain_error(out_of_range, Opt) --> !,
+	[ 'expression ~w is out of range' - [Opt] ].
+domain_error(predicate_spec, Opt) --> !,
+	[ '~w invalid predicate specifier' - [Opt] ].
+domain_error(radix, Opt) --> !,
+	[ 'invalid radix ~w' - [Opt] ].
+domain_error(read_option, Opt) --> !,
+	[ '~w invalid option to read_term' - [Opt] ].
+domain_error(semantics_indicator, Opt) --> !,
+	[ 'predicate indicator, got ~w' - [Opt] ].
+domain_error(shift_count_overflow, Opt) --> !,
+	[ 'shift count overflow in ~w' - [Opt] ].
+domain_error(source_sink, Opt) --> !,
+	[ '~w is not a source sink term' - [Opt] ].
+domain_error(stream, Opt) --> !,
+	[ '~w is not a stream' - [Opt] ].
+domain_error(stream_or_alias, Opt) --> !,
+	[ '~w is not a stream (or alias)' - [Opt] ].
+domain_error(stream_encoding, Opt) --> !,
+	[ '~w is not a supported stream encoding' - [Opt] ].
+domain_error(stream_position, Opt) --> !,
+	[ '~w is not a stream position' - [Opt] ].
+domain_error(stream_property, Opt) --> !,
+	[ '~w is not a stream property' - [Opt] ].
+domain_error(syntax_error_handler, Opt) --> !,
+	[ '~w is not a syntax error handler' - [Opt] ].
+domain_error(table, Opt) --> !,
+	[ 'non-tabled procedure ~w' - [Opt] ].
+domain_error(thread_create_option, Opt) --> !,
+	[ '~w is not a thread_create option' - [Opt] ].
+domain_error(time_out_spec, Opt) --> !,
+	[ '~w is not valid specificatin for time_out' - [Opt] ].
+domain_error(unimplemented_option, Opt) --> !,
+	[ '~w is not yet implemented' - [Opt] ].
+domain_error(write_option, Opt) --> !,
+	[ '~w invalid write option' - [Opt] ].
+domain_error(Domain, Opt) -->
+	[ '~w not a valid element for ~w' - [Opt,Domain] ].
+
+extra_info( error(_,Extra), _ ) -->
+	    {lists:memberchk([i|Msg], Extra)}, !,
+        ['~*|user provided data is: ~q' - [10,Msg]],
+        [nl].
+extra_info( _, _ ) -->
+	[].
+
+object_name(array, array).
+object_name(atom, atom).
+object_name(atomic, atomic).
+object_name(byte, byte).
+object_name(callable, 'callable goal').
+object_name(char, char).
+object_name(character_code, 'character code').
+object_name(compound, 'compound term').
+object_name(db_reference, 'data base reference').
+object_name(evaluable, 'evaluable term').
+object_name(file, file).
+object_name(float, float).
+object_name(in_byte, byte).
+object_name(in_character, character).
+object_name(integer, integer).
+
+object_name(key, 'database key').
+object_name(leash_mode, 'leash mode').
+object_name(library, library).
+object_name(list, list).
+object_name(message_queue, 'message queue').
+object_name(mutex, mutex).
+object_name(number, number).
+object_name(operator, operator).
+object_name(pointer, pointer).
+object_name(predicate_indicator, 'predicate indicator').
+object_name(source_sink, file).
+object_name(unsigned_byte, 'unsigned byte').
+object_name(unsigned_char, 'unsigned char').
+object_name(variable, 'unbound variable').
+
+svs([A=VA], [A=VA], S) :- !,
+	atom_string(A, S).
+svs([A=VA,B=VB], [A=VA,B=VB], SN) :- !,
+	atom_string(A, S),
+	atom_string(B, S1),
+	string_concat([S,` and `,S1], SN).
+svs([A=_], _, SN) :- !,
+	atom_string(A, S),
+	string_concat(`, and `,S, SN).
+svs([A=V|L], [A=V|L], SN) :- !,
+	atom_string(A, S),
+	svs(L, [A=V|L], S1 ),
+	string_concat([ S, S1], SN).
+svs([A=_V|L], All, SN) :- !,
+	atom_string(A, S),
+	svs(L, All, S1 ),
+	string_concat([`, `, S, S1], SN).
+
+list_of_preds([]) --> [].
+list_of_preds([P|L]) -->
+	['~q' - [P]],
+	list_of_preds(L).
+
+syntax_error_term(between(_I,_J,_L),LTaL,LC) -->
+	['term between lines ~d and ~d' - [_I,_L], nl ],
+	syntax_error_tokens(LTaL, LC).
+
+syntax_error_tokens([], _LC) --> [].
+syntax_error_tokens([T|L], LC) -->
+	syntax_error_token(T, LC),
+	syntax_error_tokens(L, LC).
+
+syntax_error_token(atom(A), _LC) --> !,
+	[ '~q' - [A] ].
+syntax_error_token(number(N), _LC) --> !,
+	[ '~w' - [N] ].
+syntax_error_token(var(_,S), _LC)  --> !,
+	[ '~a'  - [S] ].
+syntax_error_token(string(S), _LC) --> !,
+	[ '`~s`' - [S] ].
+syntax_error_token(error, _LC) --> !,
+	[ ' <== HERE ==> ' ].
+syntax_error_token('EOT', _LC) --> !,
+	[ '.' - [], nl  ].
+syntax_error_token('(', _LC) --> !,
+	[ '( '- []  ].
+syntax_error_token('{', _LC) --> !,
+	[ '{ '- []  ].
+syntax_error_token('[', _LC) --> !,
+	[ '[' - [] ].
+syntax_error_token(')', _LC) --> !,
+	[ ' )'- []  ].
+syntax_error_token(']', _LC) --> !,
+	[ ']'- []  ].
+syntax_error_token('}', _LC) --> !,
+	[ ' }' - [] ].
+syntax_error_token(',', _LC) --> !,
+	[ ', ' - [] ].
+syntax_error_token('.', _LC) --> !,
+	[ '.' - [] ].
+syntax_error_token(';', _LC) --> !,
+	[ '; ' - [] ].
+syntax_error_token(':', _LC) --> !,
+	[ ':' - [] ].
+syntax_error_token('|', _LC) --> !,
+	[ '|' - [] ].
+syntax_error_token('l', _LC) --> !,
+	[ '|' - [] ].
+syntax_error_token(nl, LC) --> !,
+	[  '~*|     ' -[LC], nl ].
+syntax_error_token(B, _LC) --> !,
+	[ nl, 'bad_token: ~q' - [B], nl ].
+
+
+print_lines( S, _, Key) -->
+	[nl, end(Key0)],
+	{ Key == Key0 },
+	!,
+	{ nl(S),
+	  flush_output(S) }.
+print_lines( S, _, Key) -->
+	[flush, end(Key0)],
+	{ Key == Key0 },
+	!,
+	{ flush_output(S) }.
+print_lines(S, _, Key) -->
+	[ end(Key0) ],
+	{ Key0 == Key }, !,
+	{ nl(S) }.
+print_lines( S, Prefix, Key) -->
+	[at_same_line],
+	!,
+	print_lines( S, Prefix, Key).
+print_lines( S, Prefixes, Key) -->
+	[nl],
+	!,
+	{ nl(S),
+	  Prefixes = [PrefixS - Cmds|More],
+	  format(S, PrefixS, Cmds)
+	},
+	{
+	   More == []
+	  ->
+	   NPrefixes = Prefixes
+	  ;
+	   NPrefixes = More
+	},
+	print_lines( S, NPrefixes, Key).
+print_lines( S, Prefixes, Key) -->
+	[flush],
+	!,
+	{ flush_output(S) },
+	print_lines( S, Prefixes, Key ).
+print_lines(S, Prefixes, Key) -->
+	[end(_OtherKey)],
+	!,
+	print_lines( S, Prefixes, Key ).
+% consider this a message within the message
+print_lines(S, Prefixes, Key) -->
+	[begin(Severity, OtherKey)],
+	!,
+	{ prefix( Severity, P ) },
+	print_message_lines(S, [P], OtherKey),
+	print_lines( S, Prefixes, Key ).
+print_lines(S, Prefixes, Key) -->
+	[prefix(Fmt-Args)],
+	!,
+	print_lines( S, [Fmt-Args|Prefixes], Key ).
+print_lines(S, Prefixes, Key) -->
+	[prefix(Fmt)],
+	{ atom( Fmt ) ; string( Fmt ) },
+	!,
+	print_lines( S, [Fmt-[]|Prefixes], Key ).
+print_lines(S, Prefixes, Key) -->
+	[Fmt-Args],
+	!,
+	{ format(S, Fmt, Args) },
+	print_lines( S, Prefixes, Key ).
+print_lines(S, Prefixes, Key) -->
+	[format(Fmt,Args)],
+	!,
+	{ format(S, Fmt, Args) },
+	print_lines( S, Prefixes, Key ).
+% deprecated....
+print_lines(S, Prefixes, Key) -->
+	[ Fmt ],
+	{ atom(Fmt) ; string( Fmt ) },
+	!,
+	{ format(S, Fmt, []) },
+	print_lines(S, Prefixes, Key).
+print_lines(S, _Prefixes, _Key) -->
+	[ Msg ],
+	{ format(S, 'Illegal message Component: ~q !!!.~n', [Msg]) }.
+
+prefix(help,	      '~N'-[]).
+prefix(query,	      '~N'-[]).
+prefix(debug,	      '~N'-[]).
+prefix(warning,	      '~N'-[]).
+/*	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'warning, ' - [] ]
+	;   { atom(Id) }
+	->  ['warning [Thread ~a ], ' - [Id] ]
+	;   ['warning [Thread ~d ], ' - [Id] ]
+	).
+*/
+prefix(error,	      '~N'-[]).
+/*
+	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'error ' ]
+        ;   { thread_main_name(Id) }
+	->  [ 'error [ Thread ~w ] ' - [Id] ]
+	),
+	!.
+prefix(error,	      '',   user_error) -->
+	{ thread_self(Id) },
+	(   { Id == main }
+	->  [ 'error ' - [], nl ]
+	;   { atom(Id) }
+	->  [ 'error [ Thread ~a ] ' - [Id], nl ]
+	;   [ 'error [ Thread ~d ] ' - [Id], nl ]
+	).
+*/
+prefix(banner,	      '~N'-[]).
+prefix(informational, '~N~*|% '-[LC]) :-
+	'$show_consult_level'(LC).
+prefix(debug(_),      '~N% '-[]).
+prefix(information,   '~N% '-[]).
+
+
+clause_to_indicator(T, MNameArity) :-
+	strip_module(T, M0, T1),
+	pred_arity( T1, M0, MNameArity ).
+
+pred_arity(V, M, M:call/1) :- var(V), !.
+pred_arity((:- _Path), _M, prolog:(:-)/1 ) :- !.
+pred_arity((?- _Path), _M, prolog:(?)/1 ) :- !.
+pred_arity((H:-_),M, MNameArity) :-
+    nonvar(H),
+    !,
+    strip_module(M:H, M1, H1),
+    pred_arity( H1, M1, MNameArity).
+pred_arity((H-->_), M, M2:Name//Arity) :-
+    nonvar(H),
+    !,
+    strip_module(M:H, M1, H1),
+    pred_arity( H1, M1, M2:Name/Arity).
+% special for a, [x] --> b, [y].
+pred_arity((H,_), M, MNameArity) :-
+    nonvar(H),
+    !,
+    strip_module(M:H, M1, H1),
+    pred_arity( H1, M1, MNameArity).
+pred_arity(Name/Arity, M, M:Name/Arity) :-
+    !.
+pred_arity(Name//Arity, M, M:Name//Arity) :-
+    !.
+pred_arity(H,M, M:Name/Arity) :-
+    functor(H,Name,Arity).
+
+
+translate_message(Term, Level) -->
+	compose_message(Term, Level), !.
+translate_message(Term, _) -->
+	{ Term = error(_, _) },
+	[ 'Unknown exception: ~p'-[Term] ].
+translate_message(Term, _) -->
+	[ 'Unknown message: ~p'-[Term] ].
+
+%	print_message_lines(+Stream, +Prefix, +Lines)
+%
+%	Quintus/SICStus/SWI compatibility predicate to print message lines
+%       using  a prefix.
+
+/** @pred  print_message_lines(+ _Stream_, + _Prefix_, + _Lines_)
+
+Print a message (see print_message/2) that has been translated to
+a list of message elements.  The elements of this list are:
+
++ _Format_-_Args_
+Where  _Format_ is an atom and  _Args_ is a list
+of format argument.  Handed to `format/3`.
++ `flush`
+If this appears as the last element,  _Stream_ is flushed
+(see `flush_output/1`) and no final newline is generated.
++ `at_same_line`
+If this appears as first element, no prefix is printed for
+the  line and the line-position is not forced to 0
+(see `format/1`, `~N`).
++ `prefix`(Prefix)
+define a prefix for the next line, say `''` will be seen as an
+empty prefix.
+(see `format/1`, `~N`).
++ `<Format>`
+Handed to `format/3` as `format(Stream, Format, [])`, may get confused
+with other commands.
++ nl
+A new line is started and if the message is not complete
+the  _Prefix_ is printed too.
+*/
+prolog:print_message_lines(S, Prefix0, Lines) :-
+	Lines = [begin(_, Key)|Msg],
+	(
+	 atom(Prefix0)
+	->
+	 Prefix = Prefix0-[]
+	;
+	 string(Prefix0)
+	->
+	 Prefix = Prefix0-[]
+	;
+	 Prefix = Prefix0
+	),
+	(Msg = [at_same_line|Msg1]
+	->
+	 print_lines(S, [Prefix], Key, Msg1, [])
+		;
+	 print_lines(S, [Prefix], Key, [Prefix|Msg], [])
+	).
+
+/** @pred prolog:print_message(+ Severity, +Term)
+
+The predicate print_message/2 is used to print messages, notably from
+exceptions, in a human-readable format.  _Kind_ is one of
+`informational`, `banner`, `warning`, `error`, `help` or `silent`. In YAP, the message is always outut to the stream user_error.
+
+If the Prolog flag verbose is `silent`, messages with
+ _Kind_ `informational`, or `banner` are treated as
+  silent.  See `-q` in [Running_YAP_Interactively].
+
+This predicate first translates the  _Term_ into a list of `message
+lines` (see print_message_lines/3 for details).  Next it will
+call the hook message_hook/3 to allow the user intercepting the
+message.  If message_hook/3 fails it will print the message unless
+ _Kind_ is silent.
+
+If you need to report errors from your own predicates, we advise you to
+stick to the existing error terms if you can; but should you need to
+invent new ones, you can define corresponding error messages by
+asserting clauses for `prolog:message/2`. You will need to declare
+the predicate as multifile.
+
+Note: errors in the implementation of print_message/2 are very
+confusing to YAP (who will process the error?). So we write this small
+stub to ensure everything os ok
+
+*/
+prolog:print_message(Severity, Msg) :-
+	(
+	 var(Severity)
+	->
+	 !,
+	 format(user_error, 'malformed message ~q: message level is unbound~n', [Msg])
+	;
+	 var(Msg)
+	->
+	 !,
+	 format(user_error, 'uninstantiated message~n', [])
+ ;
+	 Severity == silent
+ ->
+	 true
+	;
+	 '$pred_exists'(portray_message(_,_),user),
+	 user:portray_message(Severity, Msg)
+	),
+	!.
+prolog:print_message(Level, _Msg) :-
+	current_prolog_flag(verbose_load, silent),
+	stream_property(_Stream, alias(loop_stream) ),
+	Level = informational,
+	!.
+prolog:print_message(Level, _Msg) :-
+	current_prolog_flag(verbose, silent),
+	Level \= error,
+	Level \= warning,
+	!.
+prolog:print_message(_, _Msg) :-
+	% first step at hook processing
+	'$nb_getval'('$if_skip_mode',skip,fail),
+	!.
+prolog:print_message(force(_Severity), Msg) :- !,
+	print(user_error,Msg).
+% This predicate has more hooks than a pirate ship!
+prolog:print_message(Severity, Term) :-
+	prolog:message( Term,Lines0, [ end(Id)]),
+	Lines = [begin(Severity, Id)| Lines0],
+	(
+	 user:message_hook(Term, Severity, Lines)
+	->
+	 true
+	;
+	 prefix( Severity, Prefix ),
+	 prolog:print_message_lines(user_error, Prefix, Lines)
+	),
+	!.
+prolog:print_message(Severity, Term) :-
+	translate_message( Term, Severity, Lines0, [ end(Id)]),
+	Lines = [begin(Severity, Id)| Lines0],
+	(
+	 user:message_hook(Term, Severity, Lines)
+	->
+	 true
+	;
+	 prefix( Severity, Prefix ),
+	 prolog:print_message_lines(user_error, Prefix, Lines)
+	),
+	!.
+prolog:print_message(Severity, _Term) :-
+	format('No handler for ~a message ~q,~n',[Severity, _Term]).
+
+
+/**
+  @}
+*/

packages/python/swig/yap4py/prolog/pl/meta.yap

@@ -0,0 +1,582 @@
+/**
+
+
+  @defgroup YAPMetaPredicates Using Meta-Calls with Modules
+ @ingroup YAPModules
+ @{
+
+  @pred meta_predicate(_G1_,...., _Gn) is directive
+
+Declares that this predicate manipulates references to predicates.
+Each _Gi_ is a mode specification.
+
+If the argument is `:`, it does not refer directly to a predicate
+but must be module expanded. If the argument is an integer, the argument
+is a goal or a closure and must be expanded. Otherwise, the argument is
+not expanded. Note that the system already includes declarations for all
+built-ins.
+
+For example, the declaration for call/1 and setof/3 are:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+:- meta_predicate call(0), setof(?,0,?).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+meta_predicate declaration
+ implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
+
+*/
+
+% directive now meta_predicate Ps :- $meta_predicate(Ps).
+
+:- dynamic prolog:'$meta_predicate'/4.
+
+:- multifile prolog:'$meta_predicate'/4,
+      '$inline'/2,
+      '$full_clause_optimisation'/4.
+
+
+'$meta_predicate'(M:P) :-
+	var(P),
+	'$do_error'(instantiation_error,meta_predicate(M:P)).
+'$meta_predicate'(M:P) :-
+	var(M),
+	'$do_error'(instantiation_error,meta_predicate(M:P)).
+'$meta_predicate'(M:(P,Ps)) :- !,
+	'$meta_predicate'(M:P),
+	'$meta_predicate'(M:Ps).
+'$meta_predicate'( M:D ) :-
+    '$yap_strip_module'( M:D, M1, P),
+	'$install_meta_predicate'(M1:P).
+
+'$install_meta_predicate'(M1:P) :-
+	functor(P,F,N),
+	( M1 = prolog -> M = _ ; M1 = M),
+	( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true),
+	asserta(prolog:'$meta_predicate'(F,M,N,P)),
+	'$predicate_flags'(P, M1, Fl, Fl),
+	NFlags is Fl \/ 0x200000,
+	'$predicate_flags'(P, M1, Fl, NFlags).
+
+                                % comma has its own problems.
+
+:- '$install_meta_predicate'(prolog:','(0,0)).
+
+%% handle module transparent predicates by defining a
+%% new context module.
+'$is_mt'(H, B, HM, _SM, M, (context_module(CM),B), CM) :-
+    '$yap_strip_module'(HM:H, M, NH),
+	'$module_transparent'(_, M, _, NH), !.
+'$is_mt'(_H, B, _HM, _SM, BM, B, BM).
+
+
+
+% I assume the clause has been processed, so the
+% var case is long gone! Yes :)
+'$clean_cuts'(G,('$current_choicepoint'(DCP),NG)) :-
+	'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
+'$clean_cuts'(G,G).
+
+'$clean_cuts'(G,DCP,NG) :-
+	'$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !.
+'$clean_cuts'(G,_,G).
+
+'$conj_has_cuts'(V,_,V, _) :- var(V), !.
+'$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !.
+'$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !,
+	'$conj_has_cuts'(G1, DCP, NG1, OK),
+	'$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !,
+	'$conj_has_cuts'(G1, DCP, NG1, OK),
+	'$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !,
+	% G1: the system must have done it already
+	'$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !,
+	% G1: the system must have done it already
+	'$conj_has_cuts'(G2, DCP, NG2, OK).
+'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !,
+	% G1: the system must have done it already
+	'$conj_has_cuts'(G2, DCP, NG2, OK),
+	'$conj_has_cuts'(G3, DCP, NG3, OK).
+'$conj_has_cuts'(G,_,G, _).
+
+% return list of vars in expanded positions on the head of a clause.
+%
+% these variables should not be expanded by meta-calls in the body of the goal.
+%
+%  should be defined before caller.
+%
+'$module_u_vars'(M, H, UVars) :-
+    '$do_module_u_vars'(M:H,UVars).
+
+'$do_module_u_vars'(M:H,UVars) :-
+	functor(H,F,N),
+	'$meta_predicate'(F,M,N,D), !,
+	'$do_module_u_vars'(N,D,H,UVars).
+'$do_module_u_vars'(_,[]).
+
+'$do_module_u_vars'(0,_,_,[]) :- !.
+'$do_module_u_vars'(I,D,H,LF) :-
+	arg(I,D,X), ( X=':' -> true ; integer(X)),
+	arg(I,H,A), '$uvar'(A, LF, L), !,
+	I1 is I-1,
+	'$do_module_u_vars'(I1,D,H,L).
+'$do_module_u_vars'(I,D,H,L) :-
+	I1 is I-1,
+	'$do_module_u_vars'(I1,D,H,L).
+
+'$uvar'(Y, [Y|L], L)  :- var(Y), !.
+% support all/3
+'$uvar'(same( G, _), LF, L)  :-
+    '$uvar'(G, LF, L).
+'$uvar'('^'( _, G), LF, L)  :-
+    '$uvar'(G, LF, L).
+
+/**
+ * @pred '$meta_expand'( _Input_, _HeadModule_, _BodyModule_, _SourceModule_, _HVars_-_Head_, _OutGoal_)
+ *
+ * expand Input if a metapredicate, otherwF,MI,Arity,PredDefise ignore
+ *
+ * @return
+*/
+'$meta_expand'(G, _, CM, HVars, OG) :-
+    var(G),
+    !,
+	(
+     lists:identical_member(G, HVars)
+    ->
+     OG = G
+    ;
+     OG = CM:G
+    ).
+% nothing I can do here:
+'$meta_expand'(G0, PredDef, CM, HVars, NG) :-
+	G0 =.. [Name|GArgs],
+	PredDef =.. [Name|GDefs],
+	functor(PredDef, Name, Arity ),
+	length(NGArgs, Arity),
+	NG =.. [Name|NGArgs],
+	'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
+
+'$expand_args'([],  _, [], _, []).
+'$expand_args'([A|GArgs], CM,   [M|GDefs], HVars, [NA|NGArgs]) :-
+	( M == ':' -> true ; number(M) ),
+    !,
+	'$expand_arg'(A, CM, HVars, NA),
+	'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
+'$expand_args'([A|GArgs],  CM, [_|GDefs], HVars, [A|NGArgs]) :-
+	'$expand_args'(GArgs, CM, GDefs, HVars, NGArgs).
+
+
+% check if an argument should be expanded
+'$expand_arg'(G,  CM, HVars, OG) :-
+    var(G),
+    !,
+    ( lists:identical_member(G, HVars) -> OG = G; OG = CM:G).
+'$expand_arg'(G,  CM, _HVars, NCM:NG) :-
+    '$yap_strip_module'(CM:G, NCM, NG).
+
+% expand module names in a body
+% args are:
+%       goals to expand
+%       code to pass to listing
+%       code to pass to compiler
+%       head module   HM
+%       source module  SM
+%       current module for looking up preds  M
+%
+% to understand the differences, you can consider:
+%
+%  a:(d:b(X)) :- g:c(X), d(X), user:hello(X)).
+%
+% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get:
+%
+%  d:b(X) :- g:c(g:X), a:d(X), user:hello(X).
+%
+% on the other hand,
+%
+%  a:(d:b(X) :- c(X), d(X), d:e(X)).
+%
+% will give
+%
+%  d:b(X) :- a:c(a:X), a:d(X), e(X).
+%
+%
+%       head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les.
+%       goals or arguments/sub-arguments?
+% I cannot use call here because of format/3
+% modules:
+% A4: module for body of clause (this is the one used in looking up predicates)
+% A5: context module (this is the current context
+				% A6: head module (this is the one used in compiling and accessing).
+%
+%
+%'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):- writeln(V), fail.
+'$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :-
+	var(V),
+    !,
+	( lists:identical_member(V, HVars)
+	->
+      '$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
+	;
+	  ( atom(BM)
+      ->
+        NG = call(BM:V),
+        NGO = '$execute_in_mod'(V,BM)
+   ;
+        '$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
+      )
+   ).
+'$expand_goals'(BM:V,NG,NGO,HM,SM,_BM,HVarsH) :-
+	    '$yap_strip_module'( BM:V, CM, G),
+	     nonvar(CM),
+	     !,
+	     '$expand_goals'(G,NG,NGO,HM,SM,CM,HVarsH).
+
+'$expand_goals'(CM0:V,NG,NGO,HM,SM,BM,HVarsH) :-
+	  strip_module( CM0:V, CM, G),
+	  !,
+	  '$expand_goals'(call(CM:G),NG,NGO,HM,SM,BM,HVarsH).
+% if I don't know what the module is, I cannot do anything to the goal,
+% so I just put a call for later on.
+'$expand_goals'(V,NG,NGO,_HM,_SM,BM,_HVarsH) :-
+	var(BM),
+	!,
+    NG = call(BM:V),
+    NGO = '$execute_wo_mod'(V,BM).
+'$expand_goals'(depth_bound_call(G,D),
+                  depth_bound_call(G1,D),
+                  ('$set_depth_limit_for_next_call'(D),GO),
+                  HM,SM,BM,HVars) :-
+    '$expand_goals'(G,G1,GO,HM,SM,BM,HVars),
+    '$composed_built_in'(GO), !.
+'$expand_goals'((A,B),(A1,B1),(AO,BO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- var(A), !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A*->B;C),(A1*->B1;C1),
+        (
+          yap_hacks:current_choicepoint(DCP),
+          AO,
+          yap_hacks:cut_at(DCP),BO
+          ;
+          CO
+        ),
+        HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
+	'$clean_cuts'(AOO, AO),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+	'$expand_goals'(C,C1,CO,HM,SM,BM,HVars).
+'$expand_goals'((A;B),(A1;B1),(AO;BO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A|B),(A1|B1),(AO|BO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'((A->B),(A1->B1),(AO->BO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AOO,HM,SM,BM,HVars),
+	'$clean_cuts'(AOO, AO),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
+'$expand_goals'(\+G,\+G,A\=B,_HM,_BM,_SM,_HVars) :-
+    nonvar(G),
+    G = (A = B),
+    !.
+'$expand_goals'(\+A,\+A1,('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> false;true),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
+'$expand_goals'(once(A),once(A1),
+	('$current_choice_point'(CP),AO,'$$cut_by'(CP)),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+        '$clean_cuts'(AO0, CP, AO).
+'$expand_goals'(ignore(A),ignore(A1),
+	('$current_choice_point'(CP),AO,'$$cut_by'(CP)-> true ; true),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+    '$clean_cuts'(AO0, AO).
+'$expand_goals'(forall(A,B),forall(A1,B1),
+		  ((AO, ( BO-> false ; true)) -> false ; true),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+        '$clean_cuts'(AO0, AO).
+'$expand_goals'(not(A),not(A1),('$current_choice_point'(CP),AO,'$$cut_by'(CP) -> fail; true),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO,HM,SM,BM,HVars).
+'$expand_goals'(if(A,B,C),if(A1,B1,C1),
+	('$current_choicepoint'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+	'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
+        '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'((A*->B;C),(A1*->B1;C1),
+	('$current_choicepoint'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+	'$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
+    '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'((A*->B),(A1*->B1),
+	('$current_choicepoint'(DCP),AO,BO),HM,SM,BM,HVars) :- !,
+	'$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),
+	'$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
+    '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'(true,true,true,_,_,_,_) :- !.
+'$expand_goals'(fail,fail,fail,_,_,_,_) :- !.
+'$expand_goals'(false,false,false,_,_,_,_) :- !.
+'$expand_goals'(G, G1, GO, HM, SM, BM, HVars) :-
+    '$yap_strip_module'(BM:G,  NBM, GM),
+    '$expand_goal'(GM, G1, GO, HM, SM, NBM, HVars).
+
+
+'$import_expansion'(M:G, M1:G1) :-
+    '$imported_predicate'(G, M, G1, M1),
+     !.
+'$import_expansion'(MG, MG).
+
+'$meta_expansion'(GMG, BM, HVars, GM:GF) :-
+	'$yap_strip_module'(GMG, GM, G ),
+	 functor(G, F, Arity ),
+	 '$meta_predicate'(F, GM, Arity, PredDef),
+	 !,
+	 '$meta_expand'(G, PredDef, BM, HVars, GF).
+'$meta_expansion'(GMG, _BM, _HVars, GM:G) :-
+	'$yap_strip_module'(GMG, GM, G ).
+
+ /**
+ * @brief Perform meta-variable and user expansion on a goal _G_
+ *
+ * given the example
+~~~~~
+:- module(m, []).
+
+o:p(B) :- n:g, X is 2+3, call(B).
+~~~~~
+ *
+ * @param G input goal, without module quantification.
+ * @param G1F output, non-optimised for debugging
+ * @param GOF output, optimised, ie, `n:g`, `prolog:(X is 2+3)`, `call(m:B)`, where `prolog` does not  need to be explicit
+ * @param GOF output, optimised, `n:g`, `prolog:(X=5)`,  `call(m:B)`
+ * @param HM head module, input, o
+ * @param HM source module, input, m
+ * @param M current module, input, `n`, `m`, `m`
+ * @param HVars-H, list of meta-variables and initial head, `[]` and `p(B)`
+ *
+ *
+ */
+'$expand_goal'(G0, G1F, GOF, HM, SM, BM, HVars-H) :-
+    '$yap_strip_module'( BM:G0, M0N, G0N),
+    '$user_expansion'(M0N:G0N, M1:G1),
+    '$import_expansion'(M1:G1, M2:G2),
+    '$meta_expansion'(M2:G2, M1, HVars, M2:B1F),
+    '$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M2, H).
+
+'$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :-
+    '$match_mod'(G, HM, SM, BM, G1F),
+    '$c_built_in'(G1F, BM, H, GO),
+    '$yap_strip_module'(BM:GO, MO, IGO),
+    '$match_mod'(IGO, HM, SM, MO, GOF).
+
+'$user_expansion'(M0N:G0N, M1:G1) :-
+    '_user_expand_goal'(M0N:G0N, M:G),
+    !,
+    ( M:G == M0N:G0N
+    ->
+      M1:G1 = M:G
+    ;
+      '$user_expansion'(M:G, M1:G1)
+    ).
+'$user_expansion'(MG, MG).
+
+  '$match_mod'(G, HMod, SMod, M, O) :-
+    (
+     % \+ '$is_multifile'(G1,M),
+     %->
+      '$is_system_predicate'(G,prolog)
+     ->
+      O = G
+    ;
+      M == HMod, M == SMod
+    ->
+     O = G
+    ;
+     O = M:G
+    ).
+
+'$build_up'(HM, NH, SM, true, NH, true, NH) :- HM == SM, !.
+'$build_up'(HM, NH, _SM, true, HM:NH, true, HM:NH) :- !.
+'$build_up'(HM, NH, SM, B1, (NH :- B1), BO, ( NH :- BO)) :- HM == SM, !.
+'$build_up'(HM, NH, _SM, B1, (NH :- B1), BO, ( HM:NH :- BO)) :- !.
+
+'$expand_clause_body'(V, _NH1, _HM1, _SM, M, call(M:V), call(M:V) ) :-
+    var(V), !.
+'$expand_clause_body'(true, _NH1, _HM1, _SM, _M, true, true ) :- !.
+'$expand_clause_body'(B, H, HM, SM, M, B1, BO ) :-
+	'$module_u_vars'(HM , H, UVars),	 % collect head variables in
+                                % expanded positions
+                                % support for SWI's meta primitive.
+    '$is_mt'(H, B, HM, SM, M, IB, BM),
+	'$expand_goals'(IB, B1, BO1, HM, SM, BM, UVars-H),
+    (
+     '$full_clause_optimisation'(H, BM, BO1, BO)
+    ->
+     true
+    ;
+     BO = BO1
+	).
+
+%
+% check if current module redefines an imported predicate.
+% and remove import.
+%
+'$not_imported'(H, Mod) :-
+	recorded('$import','$import'(NM,Mod,NH,H,_,_),R),
+	NM \= Mod,
+	functor(NH,N,Ar),
+	print_message(warning,redefine_imported(Mod,NM,N/Ar)),
+	erase(R),
+	fail.
+'$not_imported'(_, _).
+
+
+'$verify_import'(_M:G, prolog:G) :-
+    '$is_system_predicate'(G, prolog).
+'$verify_import'(M:G, NM:NG) :-
+    '$get_undefined_pred'(G, M, NG, NM),
+    !.
+'$verify_import'(MG, MG).
+
+
+
+% expand arguments of a meta-predicate
+% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables)
+
+
+% expand module names in a clause (interface predicate).
+% A1: Input Clause
+% A2: Output Class to Compiler (lives in module HM)
+% A3: Output Class to clause/2 and listing (lives in module HM)
+%
+% modules:
+% A6: head module (this is the one used in compiling and accessing).
+% A5: context module (this is the current context
+% A4: module for body of clause (this is the one used in looking up predicates)
+%
+                             % has to be last!!!
+'$expand_a_clause'(MHB, SM0, Cl1, ClO) :- % MHB is the original clause, SM0 the current source, Cl1 and ClO output clauses
+    '$yap_strip_module'(SM0:MHB, SM, HB),  % remove layers of modules over the clause. SM is the source module.
+    '$head_and_body'(HB, H, B),           % HB is H :- B.
+    '$yap_strip_module'(SM:H, HM, NH), % further module expansion
+    '$not_imported'(NH, HM),
+    '$yap_strip_module'(SM:B, BM, B0), % further module expansion
+    '$expand_clause_body'(B0, NH, HM, SM0, BM, B1, BO),
+    '$build_up'(HM, NH, SM0, B1, Cl1, BO, ClO).
+
+
+
+expand_goal(Input, Output) :-
+    '$expand_meta_call'(Input, [], Output ).
+
+'$expand_meta_call'(G, HVars, MF:GF ) :-
+    source_module(SM),
+    '$yap_strip_module'(SM:G, M, IG),
+    '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
+    '$yap_strip_module'(M:GF0, MF, GF).
+
+:- '$meta_predicate'(prolog:(
+	abolish(:),
+	abolish(:,+),
+	all(?,0,-),
+	assert(:),
+	assert(:,+),
+	assert_static(:),
+	asserta(:),
+	asserta(:,+),
+	asserta_static(:),
+	assertz(:),
+	assertz(:,+),
+	assertz_static(:),
+	at_halt(0),
+	bagof(?,0,-),
+	bb_get(:,-),
+	bb_put(:,+),
+	bb_delete(:,?),
+	bb_update(:,?,?),
+	call(0),
+	call(1,?),
+	call(2,?,?),
+	call(3,?,?,?),
+	call_with_args(0),
+	call_with_args(1,?),
+	call_with_args(2,?,?),
+	call_with_args(3,?,?,?),
+	call_with_args(4,?,?,?,?),
+	call_with_args(5,?,?,?,?,?),
+	call_with_args(6,?,?,?,?,?,?),
+	call_with_args(7,?,?,?,?,?,?,?),
+	call_with_args(8,?,?,?,?,?,?,?,?),
+	call_with_args(9,?,?,?,?,?,?,?,?,?),
+	call_cleanup(0,0),
+	call_cleanup(0,?,0),
+	call_residue(0,?),
+	call_residue_vars(0,?),
+	call_shared_object_function(:,+),
+	catch(0,?,0),
+	clause(:,?),
+	clause(:,?,?),
+	compile(:),
+	consult(:),
+	current_predicate(:),
+	current_predicate(?,:),
+	db_files(:),
+			     depth_bound_call(0,+),
+	discontiguous(:),
+	ensure_loaded(:),
+	exo_files(:),
+	findall(?,0,-),
+	findall(?,0,-,?),
+	forall(0,0),
+	format(+,:),
+	format(+,+,:),
+	freeze(?,0),
+	hide_predicate(:),
+	if(0,0,0),
+	ignore(0),
+	incore(0),
+	multifile(:),
+	nospy(:),
+        not(0),
+        notrace(0),
+        once(0),
+        phrase(2,?),
+        phrase(2,?,+),
+	predicate_property(:,?),
+	predicate_statistics(:,-,-,-),
+	on_exception(+,0,0),
+	qsave_program(+,:),
+	reconsult(:),
+	retract(:),
+	retract(:,?),
+	retractall(:),
+	reconsult(:),
+	setof(?,0,-),
+	setup_call_cleanup(0,0,0),
+	setup_call_catcher_cleanup(0,0,?,0),
+	spy(:),
+	stash_predicate(:),
+	use_module(:),
+	use_module(:,?),
+	use_module(?,:,?),
+	when(+,0),
+	with_mutex(+,0),
+	with_output_to(?,0),
+	'->'(0 , 0),
+	'*->'(0 , 0),
+	';'(0 , 0),
+%	','(0 , 0),
+	^(+,0),
+	{}(0,?,?),
+	','(2,2,?,?),
+	;(2,2,?,?),
+	'|'(2,2,?,?),
+	->(2,2,?,?),
+	\+(2,?,?),
+	\+( 0 )
+            )).

packages/python/swig/yap4py/prolog/pl/modules.yap

@@ -0,0 +1,785 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		modules.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	module support						 *
+*									 *
+*************************************************************************/
+
+
+/**
+@file modules.yap
+**/
+:- system_module( '$_modules', [abolish_module/1,
+        add_import_module/3,
+        current_module/1,
+        current_module/2,
+        delete_import_module/2,
+        expand_goal/2,
+        export/1,
+        export_list/2,
+        export_resource/1,
+        import_module/2,
+        ls_imports/0,
+        module/1,
+        module_property/2,
+        set_base_module/1,
+        source_module/1,
+        use_module/1,
+        use_module/2,
+        use_module/3], ['$add_to_imports'/3,
+        '$clean_cuts'/2,
+        '$convert_for_export'/7,
+        '$do_import'/3,
+        '$extend_exports'/3,
+        '$get_undefined_pred'/4,
+        '$imported_predicate'/4,
+        '$meta_expand'/6,
+        '$meta_predicate'/2,
+        '$meta_predicate'/4,
+        '$module'/3,
+        '$module'/4,
+        '$module_expansion'/6,
+        '$module_transparent'/2,
+        '$module_transparent'/4]).
+
+
+
+:- use_system_module( '$_arith', ['$c_built_in'/3]).
+
+:- use_system_module( '$_consult', ['$lf_opt'/3,
+        '$load_files'/3]).
+
+:- use_system_module( '$_debug', ['$skipeol'/1]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_eval', ['$full_clause_optimisation'/4]).
+
+:- multifile '$system_module'/1.
+
+
+:- '$purge_clauses'(module(_,_), prolog).
+:- '$purge_clauses'('$module'(_,_), prolog).
+:- '$purge_clauses'(use_module(_), prolog).
+:- '$purge_clauses'(use_module(_,_), prolog).
+%
+% start using default definition of module.
+%
+
+/**
+   \pred use_module( +Files ) is directive
+   @load a module file
+
+This predicate loads the file specified by _Files_, importing all
+their public predicates into the current type-in module. It is
+implemented as if by:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+use_module(F) :-
+	load_files(F, [if(not_loaded),must_be_module(true)]).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Notice that _Files_ may be a single file, or a list with a number
+files. The _Files_  are loaded in YAP only once, even if they have been
+updated meanwhile. YAP should also verify whether the files actually
+define modules. Please consult load_files/3 for other options when
+loading a file.
+
+Predicate name clashes between two different modules may arise, either
+when trying to import predicates that are also defined in the current
+type-in module, or by trying to import the same predicate from two
+different modules.
+
+In the first case, the local predicate is considered to have priority
+and use_module/1 simply gives a warning. As an example, if the file
+`a.pl` contains:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+:- module( a, [a/1] ).
+
+:- use_module(b).
+
+a(1).
+a(X) :- b(X).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+and the file `b.pl` contains:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+:- module( b, [a/1,b/1] ).
+
+a(2).
+
+b(1).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+YAP will execute as follows:
+
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+?- [a].
+ % consulting .../a.pl...
+  % consulting .../b.pl...
+  % consulted .../b.pl in module b, 0 msec 0 bytes
+ % consulted .../a.pl in module a, 1 msec 0 bytes
+true.
+ ?- a(X).
+X = 1 ? ;
+X = 1.
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The example shows that the query `a(X)`has a single answer, the one
+defined in `a.pl`. Calls to `a(X)`succeed in the top-level, because
+the module `a` was loaded into `user`. On the other hand, `b(X)`is not
+exported by `a.pl`, and is not available to calls, although it can be
+accessed as a predicate in the module 'a' by using the `:` operator.
+
+Next, consider the three files `c.pl`, `d1.pl`, and `d2.pl`:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+% c.pl
+:- module( c, [a/1] ).
+
+:- use_module([d1, d2]).
+
+a(X) :-
+	b(X).
+a(X) :-
+	c(X).
+a(X) :-
+   d(X).
+
+% d1.pl
+:- module( d1, [b/1,c/1] ).
+
+vvb(2).
+c(3).
+
+
+% d2.pl
+:- module( d2, [b/1,d/1] ).
+
+b(1).
+d(4).
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The result is as follows:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+./yap -l c
+YAP 6.3.4 (x86_64-darwin13.3.0): Tue Jul 15 10:42:11 CDT 2014
+
+     ERROR!!
+     at line 3 in o/d2.pl,
+     PERMISSION ERROR- loading .../c.pl: modules d1 and d2 both define b/1
+ ?- a(X).
+X = 2 ? ;
+     ERROR!!
+     EXISTENCE ERROR- procedure c/1 is undefined, called from context  prolog:$user_call/2
+                 Goal was c:c(_131290)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The state of  the module system after this error is undefined.
+
+
+**/
+use_module(F) :- '$load_files'(F,
+			       [if(not_loaded),must_be_module(true)], use_module(F)).
+
+
+/**
+  \pred  use_module(+Files, +Imports)
+  loads a module file but only imports the named predicates
+
+
+This predicate loads the file specified by _Files_, importing their
+public predicates specified by _Imports_ into the current type-in
+module. It is implemented as if by:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+use_module(Files, Imports) :-
+	load_files(Files, [if(not_loaded),must_be_module(true),imports(Imports)]).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The _Imports_ argument may be use to specify which predicates one
+wants to load. It can also be used to give the predicates a different name. As an example,
+the graphs library is implemented on top of the red-black trees library, and some predicates are just aliases:
+
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~pl
+:- use_module(library(rbtrees), [
+	rb_min/3 as min_assoc,
+	rb_max/3 as max_assoc,
+
+        ...]).
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Unfortunately it is still not possible to change argument order.
+
+**/
+use_module(F,Is) :-
+	'$load_files'(F, [if(not_loaded),must_be_module(true),imports(Is)], use_module(F,Is)).
+
+'$module'(O,N,P,Opts) :- !,
+	'$module'(O,N,P),
+	'$process_module_decls_options'(Opts,module(Opts,N,P)).
+
+
+'$process_module_decls_options'(Var,Mod) :-
+	var(Var), !,
+	'$do_error'(instantiation_error,Mod).
+'$process_module_decls_options'([],_) :- !.
+'$process_module_decls_options'([H|L],M) :- !,
+	'$process_module_decls_option'(H,M),
+	'$process_module_decls_options'(L,M).
+'$process_module_decls_options'(T,M) :-
+	'$do_error'(type_error(list,T),M).
+
+'$process_module_decls_option'(Var,M) :-
+	var(Var),
+	'$do_error'(instantiation_error,M).
+'$process_module_decls_option'(At,M) :-
+	atom(At), !,
+	use_module(M:At).
+'$process_module_decls_option'(library(L),M) :- !,
+	use_module(M:library(L)).
+'$process_module_decls_option'(hidden(Bool),M) :- !,
+	'$process_hidden_module'(Bool, M).
+'$process_module_decls_option'(Opt,M) :-
+	'$do_error'(domain_error(module_decl_options,Opt),M).
+
+'$process_hidden_module'(TNew,M) :-
+        '$convert_true_off_mod3'(TNew, New, M),
+	source_mode(Old, New),
+	'$prepare_restore_hidden'(Old,New).
+
+'$convert_true_off_mod3'(true, off, _) :- !.
+'$convert_true_off_mod3'(false, on, _) :- !.
+'$convert_true_off_mod3'(X, _, M) :-
+	'$do_error'(domain_error(module_decl_options,hidden(X)),M).
+
+'$prepare_restore_hidden'(Old,Old) :- !.
+'$prepare_restore_hidden'(Old,New) :-
+	recorda('$system_initialization', source_mode(New,Old), _).
+
+
+'$extend_exports'(HostF, Exports, DonorF ) :-
+   ( recorded('$module','$module'( DonorF, DonorM, _,DonorExports, _),_) -> true ; DonorF = user_input ),
+    ( recorded('$module','$module'( HostF, HostM, SourceF, _, _),_) -> true ; HostF = user_input ),
+    recorded('$module','$module'(HostF, HostM, _, AllExports, _Line), R), erase(R),
+    '$convert_for_export'(Exports, DonorExports, DonorM, HostM, _TranslationTab, AllReExports, reexport(DonorF, Exports)),
+    lists:append( AllReExports, AllExports, Everything0 ),
+    sort( Everything0, Everything ),
+    ( source_location(_, Line) -> true ; Line = 0 ),
+    recorda('$module','$module'(HostF,HostM,SourceF, Everything, Line),_).
+
+'$module_produced by'(M, M0, N, K) :-
+	recorded('$import','$import'(M,M0,_,_,N,K),_), !.
+'$module_produced by'(M, M0, N, K) :-
+	recorded('$import','$import'(MI,M0,G1,_,N,K),_),
+	functor(G1, N1, K1),
+	'$module_produced by'(M,MI,N1,K1).
+
+
+/** @pred current_module( ? Mod:atom) is nondet
+
+
+Succeeds if  _M_ is a user-visible modules. A module is defined as soon as some
+predicate defined in the module is loaded, as soon as a goal in the
+module is called, or as soon as it becomes the current type-in module.
+
+
+*/
+current_module(Mod) :-
+	'$all_current_modules'(Mod),
+	\+ '$hidden_atom'(Mod).
+
+/** @pred current_module( ? Mod:atom, ? _F_ : file ) is nondet
+
+Succeeds if  _M_ is a module associated with the file  _F_, that is, if _File_ is the source for _M_. If _M_ is not declared in a file, _F_ unifies with `user`.
+ */
+current_module(Mod,TFN) :-
+	( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
+	( recorded('$module','$module'(TFN,Mod,_,_Publics, _),_) -> true ; TFN = user ).
+
+system_module(Mod) :-
+	( atom(Mod) -> true ; '$all_current_modules'(Mod) ),
+	'$is_system_module'(Mod).
+
+'$trace_module'(X) :-
+	telling(F),
+	tell('P0:debug'),
+	write(X),nl,
+	tell(F), fail.
+'$trace_module'(_).
+
+'$trace_module'(X,Y) :- X==Y, !.
+'$trace_module'(X,Y) :-
+	telling(F),
+	tell('~/.dbg.modules'),
+	write('***************'), nl,
+	portray_clause(X),
+	portray_clause(Y),
+	tell(F),fail.
+'$trace_module'(_,_).
+
+
+'$continue_imported'(Mod,Mod,Pred,Pred) :-
+	'$pred_exists'(Pred, Mod),
+    !.
+'$continue_imported'(FM,Mod,FPred,Pred) :-
+	recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), 
+	'$continue_imported'(FM, IM, FPred, IPred), !.
+'$continue_imported'(FM,Mod,FPred,Pred) :-
+	prolog:'$parent_module'(Mod,IM),
+	'$continue_imported'(FM, IM, FPred, Pred).
+
+
+
+% be careful here not to generate an undefined exception.
+'$imported_predicate'(G, _ImportingMod, G, prolog) :-
+	nonvar(G), '$is_system_predicate'(G, prolog), !.
+'$imported_predicate'(G, ImportingMod, G0, ExportingMod) :-
+	( var(G) -> true ;
+	  var(ImportingMod) -> true ;
+	  '$undefined'(G, ImportingMod)
+	),
+	'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
+	ExportingMod \= ImportingMod,
+    !.
+
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+	recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
+	'$continue_imported'(ExportingMod, ExportingModI, G0, G0I),
+    !.
+% SWI builtin
+'$get_undefined_pred'(G, _ImportingMod, G, user) :-
+	nonvar(G),
+	'$pred_exists'(G, user), !.
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+    recorded('$dialect',swi,_),
+    prolog_flag(autoload, true),
+    prolog_flag(unknown, OldUnk, fail),
+    (
+     '$autoload'(G, ImportingMod, ExportingModI, swi)
+    ->
+     prolog_flag(unknown, _, OldUnk)
+     ;
+     prolog_flag(unknown, _, OldUnk),
+     fail
+     ),
+    '$continue_imported'(ExportingMod, ExportingModI, G0, G).
+% autoload
+
+% parent module mechanism
+'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
+	'$parent_module'(ImportingMod,ExportingModI),
+	'$continue_imported'(ExportingMod, ExportingModI, G0, G).
+
+'$autoload'(G, _ImportingMod, ExportingMod, Dialect) :-
+    functor(G, Name, Arity),
+    '$pred_exists'(index(Name,Arity,ExportingMod,_),Dialect),
+    call(Dialect:index(Name,Arity,ExportingMod,_)),
+    !.
+'$autoload'(G, ImportingMod, ExportingMod, _Dialect) :-
+    functor(G, N, K),
+	functor(G0, N, K),
+	'$autoloader_find_predicate'(G0,ExportingMod),
+	ExportingMod \= ImportingMod,
+    (recordzifnot('$import','$import'(ExportingMod,ImportingMod,G0,G0, N  ,K),_) -> true ; true ).
+
+
+'$autoloader_find_predicate'(G,ExportingModI) :-
+	'$nb_getval'('$autoloader_set', true, false), !,
+	autoloader:find_predicate(G,ExportingModI).
+'$autoloader_find_predicate'(G,ExportingModI) :-
+	yap_flag(autoload, true, false),
+    yap_flag( unknown, Unknown, fail),
+	yap_flag(debug, Debug, false), !,
+	load_files([library(autoloader),
+		    autoloader:library('INDEX'),
+		    swi:library('dialect/swi/INDEX')],
+		   [autoload(true),if(not_loaded)]),
+	nb_setval('$autoloader_set', true),
+	yap_flag(autoload, _, true),
+    yap_flag( unknown, _, Unknown),
+    yap_flag( debug, _, Debug),
+	autoloader:find_predicate(G,ExportingModI).
+
+
+/**
+be associated to a new file.
+
+\param[in]	_Module_ is the name of the module to declare
+\param[in]	_MSuper_ is the name of the context module. Use `prolog`or `system`
+                if you do not need a context.
+\param[in]	_File_ is the canonical name of the file from which the module is loaded
+\param[in]  Line is the line-number of the :- module/2 directive.
+\param[in]	 If _Redefine_ `true`, allow associating the module to a new file
+*/
+
+'$declare_module'(Name, _Super, Context, _File, _Line) :-
+	add_import_module(Name, Context, start).
+
+/**
+ \pred abolish_module( + Mod) is det
+ get rid of a module and of all predicates included in the module.
+*/
+abolish_module(Mod) :-
+	recorded('$module','$module'(_,Mod,_,_,_),R), erase(R),
+	fail.
+abolish_module(Mod) :-
+	recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
+	fail.
+abolish_module(Mod) :-
+	'$current_predicate'(Na,Mod,S,_),
+	functor(S, Na, Ar),
+	abolish(Mod:Na/Ar),
+	fail.
+abolish_module(_).
+
+export(Resource) :-
+	var(Resource),
+	'$do_error'(instantiation_error,export(Resource)).
+export([]) :- !.
+export([Resource| Resources]) :- !,
+	export_resource(Resource),
+	export(Resources).
+export(Resource) :-
+	export_resource(Resource).
+
+export_resource(Resource) :-
+	var(Resource), !,
+	'$do_error'(instantiation_error,export(Resource)).
+export_resource(P) :-
+	P = F/N, atom(F), number(N), N >= 0, !,
+	'$current_module'(Mod),
+	(	recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
+		erase(R),
+		recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line),_)
+	;	prolog_load_context(file, File) ->
+		recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
+	;	recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
+	).
+export_resource(P0) :-
+	P0 = F//N, atom(F), number(N), N >= 0, !,
+	N1 is N+2, P = F/N1,
+	'$current_module'(Mod),
+	(	recorded('$module','$module'(File,Mod,SourceF,ExportedPreds,Line),R) ->
+		erase(R),
+		recorda('$module','$module'(File,Mod,SourceF,[P|ExportedPreds],Line ),_)
+	;	prolog_load_context(file, File) ->
+		recorda('$module','$module'(File,Mod,SourceF,[P],Line),_)
+	;	recorda('$module','$module'(user_input,Mod,user_input,[P],1),_)
+	).
+export_resource(op(Prio,Assoc,Name)) :- !,
+  op(Prio,Assoc,prolog:Name).
+export_resource(op(Prio,Assoc,Name)) :- !,
+  op(Prio,Assoc,user:Name).
+export_resource(Resource) :-
+	'$do_error'(type_error(predicate_indicator,Resource),export(Resource)).
+
+export_list(Module, List) :-
+	recorded('$module','$module'(_,Module,_,List,_),_).
+
+
+'$add_to_imports'([], _, _).
+% no need to import from the actual module
+'$add_to_imports'([T|Tab], Module, ContextModule) :-
+	'$do_import'(T, Module, ContextModule),
+	'$add_to_imports'(Tab, Module, ContextModule).
+
+'$do_import'(op(Prio,Assoc,Name), _Mod, ContextMod) :-
+	op(Prio,Assoc,ContextMod:Name).
+'$do_import'(N0/K0-N0/K0, Mod, Mod) :- !.
+'$do_import'(N0/K0-N0/K0, _Mod, prolog) :- !.
+'$do_import'(_N/K-N1/K, _Mod, ContextMod) :-
+       recorded('$module','$module'(_F, ContextMod, _SourceF, MyExports,_),_),
+       once(lists:member(N1/K, MyExports)),
+       functor(S, N1, K),
+       %  reexport predicates if they are undefined in the current module.
+       \+ '$undefined'(S,ContextMod), !.
+'$do_import'( N/K-N1/K, Mod, ContextMod) :-
+	functor(G,N,K),
+	'$follow_import_chain'(Mod,G,M0,G0),
+	G0=..[_N0|Args],
+	G1=..[N1|Args],
+	( '$check_import'(M0,ContextMod,N1,K) ->
+	  ( ContextMod == prolog ->
+	    recordzifnot('$import','$import'(M0,user,G0,G1,N1,K),_),
+        fail
+	  ;
+	    recordaifnot('$import','$import'(M0,ContextMod,G0,G1,N1,K),_),
+        fail
+        ;
+        true
+	  )
+	;
+	  true
+	).
+
+'$follow_import_chain'(M,G,M0,G0) :-
+	recorded('$import','$import'(M1,M,G1,G,_,_),_), M \= M1, !,
+	'$follow_import_chain'(M1,G1,M0,G0).
+'$follow_import_chain'(M,G,M,G).
+
+% trying to import Mod:N/K into ContextM
+'$check_import'(Mod, ContextM, N, K) :-
+	recorded('$import','$import'(MI, ContextM, _, _, N,K),_R),
+	% dereference MI to M1, in order to find who
+	% is actually generating
+	( '$module_produced by'(M1, MI,  N, K) -> true ; MI = M1 ),
+	( '$module_produced by'(M2, Mod, N, K) -> true ; Mod = M2 ),
+	M2 \= M1,  !,
+    '$redefine_import'( M1, M2, Mod, ContextM, N/K).
+'$check_import'(_,_,_,_).
+
+'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
+	'$nb_getval'('$lf_status', TOpts, fail),
+	'$lf_opt'(redefine_module, TOpts, Action), !,
+	'$redefine_action'(Action, M1, M2, Mod, ContextM, N/K).
+'$redefine_import'( M1, M2, Mod, ContextM, N/K) :-
+	'$redefine_action'(false, M1, M2, Mod, ContextM, N/K).
+
+
+'$redefine_action'(ask, M1, M2, M, _, N/K) :-
+	stream_property(user_input,tty(true)), !,
+	format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,M2]),
+	format(user_error,'            Do you want to import it from ~w ? [y, n, e or h] ',M),
+	'$mod_scan'(C),
+	( C == e -> halt(1) ;
+	  C == y ).
+'$redefine_action'(true, M1, _, _, _, _) :- !,
+	recorded('$module','$module'(F, M1, _, _MyExports,_Line),_),
+	unload_file(F).
+'$redefine_action'(false, M1, M2, _M, ContextM, N/K) :-
+	recorded('$module','$module'(F, ContextM, _, _MyExports,_Line),_),
+	'$current_module'(_, M2),
+	'$do_error'(permission_error(import,M1:N/K,redefined,M2),F).
+
+'$mod_scan'(C) :-
+	get_char(C),
+	'$skipeol'(C),
+	(C == y -> true; C == n).
+
+/**
+  @pred  set_base_module( +ExportingModule ) is det
+All exported predicates from _ExportingModule_ are automatically available to the
+current source  module.
+
+This built-in was introduced by SWI-Prolog. In YAP, by default, modules only
+inherit from `prolog`. This extension allows predicates in the current
+module (see module/2 and module/1) to inherit from `user` or other modules.
+
+*/
+set_base_module(ExportingModule) :-
+	var(ExportingModule),
+	'$do_error'(instantiation_error,set_base_module(ExportingModule)).
+set_base_module(ExportingModule) :-
+	atom(ExportingModule), !,
+	'$current_module'(Mod),
+	retractall(prolog:'$parent_module'(Mod,_)),
+	asserta(prolog:'$parent_module'(Mod,ExportingModule)).
+set_base_module(ExportingModule) :-
+	'$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)).
+
+/**
+ *  @pred  import_module( +ImportingModule, +ExportingModule ) is det
+ *  All exported predicates from _ExportingModule_
+ * are automatically available to the
+ * source  module _ImportModule_.
+
+This innovation was introduced by SWI-Prolog. By default, modules only
+inherit from `prolog` and `user`. This extension allows predicates in
+any module to inherit from `user`  and other modules.
+
+*/
+import_module(Mod, ImportModule) :-
+	var(Mod),
+	'$do_error'(instantiation_error,import_module(Mod, ImportModule)).
+import_module(Mod, ImportModule) :-
+	atom(Mod), !,
+	prolog:'$parent_module'(Mod,ImportModule).
+import_module(Mod, EM) :-
+	'$do_error'(type_error(atom,Mod),import_module(Mod, EM)).
+
+
+/**
+  @pred add_import_module( + _Module_, + _ImportModule_ , +_Pos_) is det
+Add all exports in _ImportModule_ as available to _Module_.
+
+
+All exported predicates from _ExportModule_ are made available to the
+ source  module _ImportModule_. If _Position_ is bound to `start` the
+ module _ImportModule_ is tried first, if _Position_ is bound to `end`,
+ the module is consulted last.
+
+*/
+add_import_module(Mod, ImportModule, Pos) :-
+	var(Mod),
+	'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, Pos) :-
+	var(Pos),
+	'$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, start) :-
+	atom(Mod), !,
+	retractall(prolog:'$parent_module'(Mod,ImportModule)),
+	asserta(prolog:'$parent_module'(Mod,ImportModule)).
+add_import_module(Mod, ImportModule, end) :-
+	atom(Mod), !,
+	retractall(prolog:'$parent_module'(Mod,ImportModule)),
+	assertz(prolog:'$parent_module'(Mod,ImportModule)).
+add_import_module(Mod, ImportModule, Pos) :-
+	\+ atom(Mod), !,
+	'$do_error'(type_error(atom,Mod),add_import_module(Mod, ImportModule, Pos)).
+add_import_module(Mod, ImportModule, Pos) :-
+	'$do_error'(domain_error(start_end,Pos),add_import_module(Mod, ImportModule, Pos)).
+
+/**
+  @pred delete_import_module( + _ExportModule_, + _ImportModule_ ) is det
+Exports in _ImportModule_ are no longer available to _Module_.
+
+
+All exported predicates from _ExportModule_ are discarded from the
+ ones used vy the source  module _ImportModule_.
+
+*/
+delete_import_module(Mod, ImportModule) :-
+	var(Mod),
+	'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
+delete_import_module(Mod, ImportModule) :-
+	var(ImportModule),
+	'$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)).
+delete_import_module(Mod, ImportModule) :-
+	atom(Mod),
+	atom(ImportModule), !,
+	retractall(prolog:'$parent_module'(Mod,ImportModule)).
+delete_import_module(Mod, ImportModule) :-
+	\+ atom(Mod), !,
+	'$do_error'(type_error(atom,Mod),delete_import_module(Mod, ImportModule)).
+delete_import_module(Mod, ImportModule) :-
+	'$do_error'(type_error(atom,ImportModule),delete_import_module(Mod, ImportModule)).
+
+'$set_source_module'(Source0, SourceF) :-
+	prolog_load_context(module, Source0), !,
+	module(SourceF).
+'$set_source_module'(Source0, SourceF) :-
+	current_module(Source0, SourceF).
+
+/**
+  @pred module_property( +Module, ? _Property_ ) is nondet
+
+Enumerate non-deterministically the main properties of _Module_ .
+
+Reports the following properties of _Module_:
+
+  + `class`( ?_Class_ ): whether it is a `system`, `library`, or `user` module.
+
+  + `line_count`(?_Ls_): number of lines in source file (if there is one).
+
+  + `file`(?_F_): source file for _Module_ (if there is one).
+
+  + `exports`(-Es): list of all predicate symbols and
+   operator symbols exported or re-exported by this module.
+
+*/
+module_property(Mod, Prop) :-
+    var(Mod),
+    !,
+	recorded('$module','$module'(_,Mod,_,_Es,_),_),
+    module_property(Mod, Prop).
+module_property(Mod, class(L)) :-
+	'$module_class'(Mod, L).
+module_property(Mod, line_count(L)) :-
+	recorded('$module','$module'(_F,Mod,_,_,L),_).
+module_property(Mod, file(F)) :-
+	recorded('$module','$module'(F,Mod,_,_,_),_).
+module_property(Mod, exports(Es)) :-
+	(
+        recorded('$module','$module'(_,Mod,_,Es,_),_)
+    ->
+        true
+        ;
+        Mod==user
+        ->
+        findall( P, (current_predicate(user:P)), Es)
+        ;
+       Mod==prolog
+        ->
+        findall( N/A, (predicate_property(Mod:P0, public),functor(P0,N,A)), Es)
+    ).
+
+'$module_class'( Mod, system) :- '$is_system_module'( Mod ), !.
+'$module_class'( Mod, library) :- '$library_module'( Mod ), !.
+'$module_class'(_Mod, user) :- !.
+'$module_class'(   _, temporary) :- fail.
+'$module_class'(   _, test) :- fail.
+'$module_class'(   _, development) :- fail.
+
+'$library_module'(M1) :-
+	recorded('$module','$module'(_, M1, library(_), _MyExports,_Line),_).
+
+ls_imports :-
+	recorded('$import','$import'(M0,M,G0,G,_N,_K),_R),
+	numbervars(G0+G, 0, _),
+	format('~a:~w <- ~a:~w~n', [M, G, M0, G0]),
+	fail.
+ls_imports.
+
+unload_module(Mod) :-
+    clause( '$meta_predicate'(_F,Mod,_N,_P), _, R),
+    erase(R),
+    fail.
+unload_module(Mod) :-
+    recorded('$multifile_defs','$defined'(_FileName,_Name,_Arity,Mod), R),
+    erase(R),
+    fail.
+unload_module(Mod) :-
+    recorded( '$foreign', Mod:_Foreign, R),
+    erase(R),
+    fail.
+% remove imported modules
+unload_module(Mod) :-
+    setof( M, recorded('$import',_G0^_G^_N^_K^_R^'$import'(Mod,M,_G0,_G,_N,_K),_R), Ms),
+    recorded('$module','$module'( _, Mod, _, _, Exports), _),
+    lists:member(M, Ms),
+    current_op(X, Y, M:Op),
+    lists:member( op(X, Y, Op), Exports ),
+    op(X, 0, M:Op),
+    fail.
+unload_module(Mod) :-
+    recorded('$module','$module'( _, Mod, _, _, Exports), _),
+    lists:member( op(X, _Y, Op), Exports ),
+    op(X, 0, Mod:Op),
+    fail.
+unload_module(Mod) :-
+    current_predicate(Mod:P),
+    abolish(P),
+    fail.
+unload_module(Mod) :-
+    recorded('$import','$import'(Mod,_M,_G0,_G,_N,_K),R),
+    erase(R),
+    fail.
+unload_module(Mod) :-
+    recorded('$module','$module'( _, Mod, _, _, _), R),
+    erase(R),
+    fail.
+
+/*  debug */
+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),
+    format('   ~w:~w :- ~w:~w.~n',[M,G,HostM,G0]),
+	fail.
+module_state.

packages/python/swig/yap4py/prolog/pl/newmod.yap

@@ -0,0 +1,246 @@
+/**
+  @pred module(+M) is det
+   set the type-in module
+
+
+Defines  _M_ to be the current working or type-in module. All files
+which are not bound to a module are assumed to belong to the working
+module (also referred to as type-in module). To compile a non-module
+file into a module which is not the working one, prefix the file name
+with the module name, in the form ` _Module_: _File_`, when
+loading the file.
+
+**/
+module(N) :-
+	var(N),
+	'$do_error'(instantiation_error,module(N)).
+module(N) :-
+	atom(N), !,
+	% set it as current module.
+	'$current_module'(_,N).
+module(N) :-
+	'$do_error'(type_error(atom,N),module(N)).
+
+/**
+ \pred	module(+ Module:atom, +ExportList:list) is directive
+  define a new module
+
+This directive defines the file where it appears as a _module file_;
+it must be the first declaration in the file.  _Module_ must be an
+atom specifying the module name; _ExportList_ must be a list
+containing the module's public predicates specification, in the form
+`[predicate_name/arity,...]`. The _ExportList_ can  include
+operator declarations for operators that are exported by the module.
+
+The public predicates of a module file can be made accessible to other
+files through loading the source file, using the directives
+use_module/1 or use_module/2,
+ensure_loaded/1 and the predicates
+consult/1 or reconsult/1. The
+non-public predicates of a module file are not supposed to be visible
+to other modules; they can, however, be accessed by prefixing the module
+name with the `:/2` operator.
+
+**/
+'$module_dec'(system(N, Ss), Ps) :- !,
+		new_system_module(N),
+    '$mk_system_predicates'( Ss , N ),
+    '$module_dec'(N, Ps).
+'$module_dec'(system(N), Ps) :- !,
+		new_system_module(N),
+%    '$mk_system_predicates'( Ps , N ),
+    '$module_dec'(N, Ps).
+'$module_dec'(N, Ps) :-
+   source_location(F,Line),
+  '$nb_getval'( '$user_source_file', F0 , fail),
+	'$add_module_on_file'(N, F, Line,F0, Ps),
+	'$current_module'(_M0,N).
+
+'$mk_system_predicates'( Ps, _N ) :-
+    lists:member(Name/A , Ps),
+    '$new_system_predicate'(Name, A, prolog),
+    fail.
+'$mk_system_predicates'( _Ps, _N ).
+
+/*
+declare_module(Mod) -->
+	arguments(file(+file:F),
+		  line(+integer:L),
+		  parent(+module:P),
+		  type(+module_type:T),
+		  exports(+list(exports):E),
+
+		  Props, P0) -> true ; Props = P0),
+	( deleteline(L), P0, P1) -> true ; P0 == P1),
+	( delete(parent(P), P1, P2) -> true ; P1 == P2),
+	( delete(line(L), P2, P3) -> true ; P3 == P4),
+	( delete(file(F), Props, P0) -> true ; Props = P0),
+	( delete(file(F), Props, P0) -> true ; Props = P0),
+	( delete(file(F), Props, P0) -> true ; Props = P0),
+	de
+*/
+'$module'(_,N,P) :-
+	'$module_dec'(N,P).
+
+/** set_module_property( +Mod, +Prop)
+
+   Set a property for a module. Currently this includes:
+     - base module, a module from where we automatically import all definitions, see add_import_module/2.
+	 - the export list
+	 - module class is currently ignored.
+*/
+set_module_property(Mod, base(Base)) :-
+	must_be_of_type( module, Mod),
+	add_import_module(Mod, Base, start).
+set_module_property(Mod, exports(Exports)) :-
+	must_be_of_type( module, Mod),
+	'$add_module_on_file'(Mod, user_input, 1, '/dev/null', Exports).
+set_module_property(Mod, exports(Exports, File, Line)) :-
+	must_be_of_type( module, Mod),
+	'$add_module_on_file'(Mod, File, Line, '/dev/null', Exports).
+set_module_property(Mod, class(Class)) :-
+	must_be_of_type( module, Mod),
+	must_be_of_type( atom, Class).
+
+    '$add_module_on_file'(DonorMod, DonorF, _LineF, SourceF, Exports) :-
+        recorded('$module','$module'(OtherF, DonorMod, _, _, _, _),R),
+        % the module has been found, are we reconsulting?
+        (
+    	DonorF \= OtherF
+        ->
+            '$do_error'(permission_error(module,redefined,DonorMod, OtherF, DonorF),module(DonorMod,Exports))
+        ;
+          recorded('$module','$module'(DonorF,DonorMod, SourceF,  _, _, _), R),
+          erase( R ),
+          fail
+        ).
+    '$add_module_on_file'(DonorM, DonorF, Line, SourceF, Exports) :-
+        '$current_module'( HostM ),
+        ( recorded('$module','$module'( HostF, HostM, _, _, _, _),_) -> true ; HostF = user_input ),
+        % first build the initial export table
+        '$convert_for_export'(all, Exports, DonorM, HostM, TranslationTab, AllExports0, load_files),
+        sort( AllExports0, AllExports ),
+        '$add_to_imports'(TranslationTab, DonorM, DonorM), % insert ops, at least for now
+        % last, export everything to the host: if the loading crashed you didn't actually do
+        % no evil.
+        recorda('$module','$module'(DonorF,DonorM,SourceF, AllExports, Line),_),
+        ( recorded('$source_file','$source_file'( DonorF, Time, _), R), erase(R),
+          recorda('$source_file','$source_file'( DonorF, Time, DonorM), _) ).
+
+
+          '$convert_for_export'(all, Exports, _Module, _ContextModule, Tab, MyExports, _) :-
+          	'$simple_conversion'(Exports, Tab, MyExports).
+          '$convert_for_export'([], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+          	'$clean_conversion'([], Exports, Module, ContextModule, Tab, MyExports, Goal).
+          '$convert_for_export'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+          	'$clean_conversion'([P1|Ps], Exports, Module, ContextModule, Tab, MyExports, Goal).
+          '$convert_for_export'(except(Excepts), Exports, Module, ContextModule, Tab, MyExports, Goal) :-
+          	'$neg_conversion'(Excepts, Exports, Module, ContextModule, MyExports, Goal),
+          	'$simple_conversion'(MyExports, Tab, _).
+
+          '$simple_conversion'([], [], []).
+          '$simple_conversion'([F/N|Exports], [F/N-F/N|Tab], [F/N|E]) :-
+          	'$simple_conversion'(Exports, Tab, E).
+          '$simple_conversion'([F//N|Exports], [F/N2-F/N2|Tab], [F/N2|E]) :-
+          	N2 is N+1,
+          	'$simple_conversion'(Exports, Tab, E).
+          '$simple_conversion'([F/N as NF|Exports], [F/N-NF/N|Tab], [NF/N|E]) :-
+          	'$simple_conversion'(Exports, Tab, E).
+          '$simple_conversion'([F//N as NF|Exports], [F/N2-NF/N2|Tab], [NF/N2|E]) :-
+          	N2 is N+1,
+          	'$simple_conversion'(Exports, Tab, E).
+          '$simple_conversion'([op(Prio,Assoc,Name)|Exports], [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|E]) :-
+          	'$simple_conversion'(Exports, Tab, E).
+
+          '$clean_conversion'([], _, _, _, [], [], _).
+          '$clean_conversion'([(N1/A1 as N2)|Ps], List, Module, ContextModule, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- !,
+          	( lists:memberchk(N1/A1, List)
+          	->
+          	  true
+          	;
+          	  '$bad_export'((N1/A1 as N2), Module, ContextModule)
+          	),
+          	'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+          '$clean_conversion'([N1/A1|Ps], List, Module, ContextModule, [N1/A1-N1/A1|Tab], [N1/A1|MyExports], Goal) :- !,
+          	(
+          	 lists:memberchk(N1/A1, List)
+          	->
+          	   true
+          	;
+          	  '$bad_export'(N1/A1, Module, ContextModule)
+          	),
+          	'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+          '$clean_conversion'([N1//A1|Ps], List, Module, ContextModule, [N1/A2-N1/A2|Tab], [N1/A2|MyExports], Goal) :- !,
+          	A2 is A1+2,
+          	(
+          	  lists:memberchk(N1/A2, List)
+          	->
+          	  true
+          	;
+          	  '$bad_export'(N1//A1, Module, ContextModule)
+
+          	),
+          	'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+          '$clean_conversion'([N1//A1 as N2|Ps], List, Module, ContextModule, [N2/A2-N1/A2|Tab], [N2/A2|MyExports], Goal) :- !,
+          	A2 is A1+2,
+          	(
+          	  lists:memberchk(N2/A2, List)
+          	->
+          	  true
+          	;
+          	  '$bad_export'((N1//A1 as A2), Module, ContextModule)
+          	),
+          	'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+          '$clean_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, [op(Prio,Assoc,Name)|Tab], [op(Prio,Assoc,Name)|MyExports], Goal) :- !,
+          	(
+          	 lists:memberchk(op(Prio,Assoc,Name), List)
+          	->
+          	 true
+          	;
+          	 '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
+          	),
+          	'$clean_conversion'(Ps, List, Module, ContextModule, Tab, MyExports, Goal).
+          '$clean_conversion'([P|_], _List, _, _, _, _, Goal) :-
+          	'$do_error'(domain_error(module_export_predicates,P), Goal).
+
+          '$bad_export'(_, _Module, _ContextModule) :- !.
+          '$bad_export'(Name/Arity, Module, ContextModule) :-
+          	functor(P, Name, Arity),
+          	predicate_property(Module:P, _), !,
+          	print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
+          '$bad_export'(Name//Arity, Module, ContextModule) :-
+          	Arity2 is Arity+2,
+          	functor(P, Name, Arity2),
+          	predicate_property(Module:P, _), !,
+          	print_message(warning, declaration(Name/Arity, Module, ContextModule, private)).
+          '$bad_export'(Indicator, Module, ContextModule) :- !,
+          	print_message(warning, declaration( Indicator, Module, ContextModule, undefined)).
+
+          '$neg_conversion'([], Exports, _, _, Exports, _).
+          '$neg_conversion'([N1/A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+          	(
+          	 lists:delete(List, N1/A1, RList)
+          	->
+          	 '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+          	;
+          	 '$bad_export'(N1/A1, Module, ContextModule)
+          	).
+          '$neg_conversion'([N1//A1|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+          	A2 is A1+2,
+          	(
+          	 lists:delete(List, N1/A2, RList)
+          	->
+          	 '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+          	;
+          	 '$bad_export'(N1//A1, Module, ContextModule)
+          	).
+          '$neg_conversion'([op(Prio,Assoc,Name)|Ps], List, Module, ContextModule, MyExports, Goal) :- !,
+          	(
+          	 lists:delete(List, op(Prio,Assoc,Name), RList)
+          	->
+          	 '$neg_conversion'(Ps, RList, Module, ContextModule, MyExports, Goal)
+          	;
+          	 '$bad_export'(op(Prio,Assoc,Name), Module, ContextModule)
+          	).
+          '$clean_conversion'([P|_], _List, _, _, _, Goal) :-
+          	'$do_error'(domain_error(module_export_predicates,P), Goal).

packages/python/swig/yap4py/prolog/pl/os.yap

@@ -0,0 +1,222 @@
+ /*************************************************************************
+ *									 *
+ *	 YAP Prolog 							 *
+ *									 *
+ *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+ *									 *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+ *									 *
+ *************************************************************************/
+
+
+:- system_module( '$os', [
+	       cd/0,
+	       cd/1,
+	       getcwd/1,
+	       ls/0,
+	       pwd/0,
+	       unix/1,
+	       putenv/2,
+	       getenv/2,
+	       setenv/2
+	 ], [] ).
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+/**
+@defgroup YAPOS Access to Operating System Functionality
+@ingroup builtins
+
+The following built-in predicates allow access to underlying
+Operating System functionality.
+
+%% @{
+
+ */
+
+/** @pred  cd
+
+Changes the current directory (on UNIX environments) to the user's home directory.
+
+
+*/
+cd :-
+	cd('~').
+
+/** @pred  cd(+ _D_)
+
+
+Changes the current directory (on UNIX environments).
+
+
+*/
+cd(F) :-
+      absolute_file_name(F, Dir, [file_type(directory),file_errors(fail),access(execute),expand(true)]),
+      working_directory(_, Dir).
+
+/** @pred  getcwd(- _D_)
+
+
+Unify the current directory, represented as an atom, with the argument
+ _D_.
+
+
+*/
+getcwd(Dir) :- working_directory(Dir, Dir).
+
+/** @pred  ls
+
+
+Prints a list of all files in the current directory.
+
+
+*/
+ls :-
+	getcwd(X),
+	'$load_system_ls'(X,L),
+	'$do_print_files'(L).
+
+'$load_system_ls'(X,L) :-
+	'$undefined'(directory_files(X, L), system),
+	load_files(library(system),[silent(true)]),
+	fail.
+'$load_system_ls'(X,L) :-
+	system:directory_files(X, L).
+
+
+'$do_print_files'([]) :-
+	nl.
+'$do_print_files'([F| Fs]) :-
+	'$do_print_file'(F),
+	'$do_print_files'(Fs).
+
+'$do_print_file'('.') :- !.
+'$do_print_file'('..') :- !.
+'$do_print_file'(F) :- atom_concat('.', _, F), !.
+'$do_print_file'(F) :-
+	write(F), write('  ').
+
+/** @pred  pwd
+
+
+Prints the current directory.
+
+
+*/
+pwd :-
+	getcwd(X),
+	write(X), nl.
+
+/** @pred  unix(+ _S_)
+
+
+Access to Unix-like functionality:
+
++ argv/1
+Return a list of arguments to the program. These are the arguments that
+follow a `--`, as in the usual Unix convention.
++ cd/0
+Change to home directory.
++ cd/1
+Change to given directory. Acceptable directory names are strings or
+atoms.
++ environ/2
+If the first argument is an atom, unify the second argument with the
+value of the corresponding environment variable.
++ getcwd/1
+Unify the first argument with an atom representing the current directory.
++ putenv/2
+Set environment variable  _E_ to the value  _S_. If the
+environment variable  _E_ does not exist, create a new one. Both the
+environment variable and the value must be atoms.
++ shell/1
+Execute command under current shell. Acceptable commands are strings or
+atoms.
++ system/1
+Execute command with `/bin/sh`. Acceptable commands are strings or
+atoms.
++ shell/0
+Execute a new shell.
+
+
+
+*/
+unix(V) :- var(V), !,
+	'$do_error'(instantiation_error,unix(V)).
+unix(argv(L)) :-
+	current_prolog_flag(argv, L).
+unix(cd) :- cd('~').
+unix(cd(A)) :- cd(A).
+unix(environ(X,Y)) :- '$do_environ'(X,Y).
+unix(getcwd(X)) :- getcwd(X).
+unix(shell(V)) :- var(V), !,
+	'$do_error'(instantiation_error,unix(shell(V))).
+unix(shell(A)) :- atom(A), !, '$shell'(A).
+unix(shell(A)) :- string(A), !, '$shell'(A).
+unix(shell(V)) :-
+	'$do_error'(type_error(atomic,V),unix(shell(V))).
+unix(system(V)) :- var(V), !,
+	'$do_error'(instantiation_error,unix(system(V))).
+unix(system(A)) :- atom(A), !, system(A).
+unix(system(A)) :- string(A), !, system(A).
+unix(system(V)) :-
+	'$do_error'(type_error(atom,V),unix(system(V))).
+unix(shell) :- sh.
+unix(putenv(X,Y)) :- '$putenv'(X,Y).
+
+
+'$is_list_of_atoms'(V,_) :- var(V),!.
+'$is_list_of_atoms'([],_) :- !.
+'$is_list_of_atoms'([H|L],L0) :- !,
+	'$check_if_head_may_be_atom'(H,L0),
+	'$is_list_of_atoms'(L,L0).
+'$is_list_of_atoms'(H,L0) :-
+	'$do_error'(type_error(list,H),unix(argv(L0))).
+
+'$check_if_head_may_be_atom'(H,_) :-
+	var(H), !.
+'$check_if_head_may_be_atom'(H,_) :-
+	atom(H), !.
+'$check_if_head_may_be_atom'(H,L0) :-
+	'$do_error'(type_error(atom,H),unix(argv(L0))).
+
+
+'$do_environ'(X, Y) :-
+	var(X), !,
+	'$do_error'(instantiation_error,unix(environ(X,Y))).
+'$do_environ'(X, Y) :- atom(X), !,
+	'$getenv'(X,Y).
+'$do_environ'(X, Y) :-
+	'$do_error'(type_error(atom,X),unix(environ(X,Y))).
+
+
+/** @pred  putenv(+ _E_,+ _S_)
+
+
+Set environment variable  _E_ to the value  _S_. If the
+environment variable  _E_ does not exist, create a new one. Both the
+environment variable and the value must be atoms.
+
+
+*/
+putenv(Na,Val) :-
+	'$putenv'(Na,Val).
+
+getenv(Na,Val) :-
+	'$getenv'(Na,Val).
+
+/** @pred setenv(+ _Name_,+ _Value_)
+
+
+Set environment variable.   _Name_ and  _Value_ should be
+instantiated to atoms or integers.  The environment variable will be
+passed to `shell/[0-2]` and can be requested using `getenv/2`.
+They also influence expand_file_name/2.
+
+
+*/
+setenv(Na,Val) :-
+	'$putenv'(Na,Val).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/pathconf.yap

@@ -0,0 +1,189 @@
+/**
+ @defgroup pathconf Configuration of the Prolog file search path
+ @ingroup AbsoluteFileName
+
+  Prolog systems search follow a complex search on order to track down files.
+
+@{
+**/
+:- module(user).
+
+/**
+@pred 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 library_directory/1.
+
+:- dynamic library_directory/1.
+%%  Specifies the set of directories where
+% one can find Prolog libraries.
+%
+library_directory(Home) :-
+    current_prolog_flag(prolog_library_directory, Home),
+    Home \= ''.
+% 1. honor YAPSHAREDIR
+library_directory( Dir ) :-
+        getenv( 'YAPSHAREDIR', Dir).
+%% 2. honor user-library
+library_directory( '~/share/Yap' ).
+%% 3. honor current directory
+library_directory( '.' ).
+%% 4. honor default location.
+library_directory( Dir ) :-
+	system_library( Dir ).
+
+/**
+  @pred 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.
+  */
+:- dynamic commons_directory/1.
+
+:- multifile commons_directory/1.
+
+
+commons_directory( Path ):-
+    system_commons( Path ).
+
+/**
+  @pred 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 foreign_directory/1.
+
+:- dynamic foreign_directory/1.
+
+%foreign_directory( Path ):-
+foreign_directory(Home) :-
+    current_prolog_flag(prolog_foreign_directory, Home),
+    Home \= ''.
+foreign_directory( '.').
+foreign_directory(yap('lib/Yap')).
+foreign_directory( Path ):-
+    system_foreign( Path ).
+
+/**
+  @pred 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).
+  prolog_file_type(pyd, executable).
+~~~~~~~~~~~~~~~~~~~~~
+*/
+
+:- dynamic prolog_file_type/2.
+
+prolog_file_type(yap, prolog).
+prolog_file_type(pl, prolog).
+prolog_file_type(prolog, prolog).
+prolog_file_type(A, prolog) :-
+	current_prolog_flag(associate, A),
+	A \== prolog,
+	A \== pl,
+	A \== yap.
+prolog_file_type(qly, qly).
+prolog_file_type(A, executable) :-
+	current_prolog_flag(shared_object_extension, A).
+  	prolog_file_type(pyd, executable).
+  
+/**
+  @pred 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(executable, 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 file_search_path/2.
+
+:- dynamic file_search_path/2.
+
+
+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(executable, 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)
+    ).
+
+
+%% @}

packages/python/swig/yap4py/prolog/pl/preddecls.yap

@@ -0,0 +1,270 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		preds.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Predicate Manipulation for YAP: declaration support	 *
+*									 *
+*************************************************************************/
+:- system_module( '$_preddecls', [(discontiguous)/1,
+        (dynamic)/1,
+        (multifile)/1,
+        (discontiguous)/1], ['$check_multifile_pred'/3,
+        '$discontiguous'/2,
+        '$dynamic'/2]).
+
+:- use_system_module( '$_consult', ['$add_multifile'/3]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+'$log_upd'(1).
+
+/**
+  @defgroup YAPPredDecls Declaring Properties of Predicates
+  @ingroup YAPCompilerSettings
+
+The YAP Compiler allows the programmer to include declarations with
+important pproprties of predicates, such as where they can be modified
+during execution time, whether they are meta-predicates, or whether they can be
+defined  across multiple files. We next join some of these declarations.
+
+*/
+
+%
+% can only do as goal in YAP mode.
+%
+/** @pred  dynamic( + _P_ )
+
+
+Declares predicate  _P_ or list of predicates [ _P1_,..., _Pn_]
+as a dynamic predicate.  _P_ must be written as a predicate indicator, that is in form
+ _Name/Arity_ or _Module:Name/Arity_.
+
+~~~~~
+:- dynamic god/1.
+~~~~~
+
+
+a more convenient form can be used:
+
+~~~~~
+:- dynamic son/3, father/2, mother/2.
+~~~~~
+
+or, equivalently,
+
+~~~~~
+:- dynamic [son/3, father/2, mother/2].
+~~~~~
+
+Note:
+
+a predicate is assumed to be dynamic when
+asserted before being defined.
+
+
+*/
+dynamic(X) :-
+	current_prolog_flag(language, yap), !,
+  '$current_module'(M),
+	'$dynamic'(X, M).
+dynamic(X) :-
+	'$do_error'(context_error(dynamic(X),declaration),query).
+
+'$dynamic'(X,M) :- var(X), !,
+	'$do_error'(instantiation_error,dynamic(M:X)).
+'$dynamic'(X,M) :- var(M), !,
+	'$do_error'(instantiation_error,dynamic(M:X)).
+'$dynamic'(Mod:Spec,_) :- !,
+	'$dynamic'(Spec,Mod).
+'$dynamic'([], _) :- !.
+'$dynamic'([H|L], M) :- !, '$dynamic'(H, M), '$dynamic'(L, M).
+'$dynamic'((A,B),M) :- !, '$dynamic'(A,M), '$dynamic'(B,M).
+'$dynamic'(A//N,Mod) :- integer(N), !,
+	N1 is N+2,
+	'$dynamic'(A/N1,Mod).
+'$dynamic'(A/N,Mod) :-
+  functor(G, A, N),
+  '$mk_d'(G,Mod).
+
+/** @pred public(  _P_ ) is iso
+
+Instructs the compiler that the source of a predicate of a list of
+predicates  _P_ must be kept. This source is then accessible through
+the clause/2 procedure and through the `listing` family of
+built-ins.
+
+Note that all dynamic procedures are public. The `source` directive
+defines all new or redefined predicates to be public.
+
+**/
+'$public'(X, _) :- var(X), !,
+	'$do_error'(instantiation_error,public(X)).
+'$public'(Mod:Spec, _) :- !,
+	'$public'(Spec,Mod).
+'$public'((A,B), M) :- !, '$public'(A,M), '$public'(B,M).
+'$public'([],_) :- !.
+'$public'([H|L], M) :- !, '$public'(H, M), '$public'(L, M).
+'$public'(A//N1, Mod) :- integer(N1), !,
+	N is N1+2,
+	'$public'(A/N, Mod).
+'$public'(A/N, Mod) :- integer(N), atom(A), !,
+	functor(T,A,N),
+	'$do_make_public'(T, Mod).
+'$public'(X, Mod) :-
+	'$do_pi_error'(type_error(callable,X),dynamic(Mod:X)).
+
+'$do_make_public'(T, Mod) :-
+	'$is_dynamic'(T, Mod), !.  % all dynamic predicates are public.
+'$do_make_public'(T, Mod) :-
+	'$predicate_flags'(T,Mod,F,F),
+	NF is F\/0x00400000,
+	'$predicate_flags'(T,Mod,F,NF).
+
+
+/** @pred     multifile( _P_ ) is iso
+
+Declares that a predicate or several predicates may be defined
+throughout several files. _P_ is a collection of one or more predicate
+indicators:
+
+~~~~~~~
+:- multifile user:portray_message/2, multifile user:message_hook/3.
+~~~~~~~
+
+Instructs the compiler about the declaration of a predicate  _P_ in
+more than one file. It must appear in the first of the loaded files
+where the predicate is declared, and before declaration of any of its
+clauses.
+
+Multifile declarations must be supported by reconsult/1 and
+compile/1: when a multifile predicate is reconsulted,
+only the clauses from the same file are removed.
+
+Since YAP4.3.0 multifile procedures can be static or dynamic.
+
+**/
+multifile(P) :-
+    strip_module(P, OM, Pred),
+	'$multifile'(Pred, OM).
+
+'$multifile'(V, _) :-
+    var(V),
+    !,
+	'$do_error'(instantiation_error,multifile(V)).
+'$multifile'((X,Y), M) :-
+    !,
+    '$multifile'(X, M),
+    '$multifile'(Y, M).
+'$multifile'(Mod:PredSpec, _) :-
+    !,
+	'$multifile'(PredSpec, Mod).
+'$multifile'(N//A, M) :- !,
+	integer(A),
+	A1 is A+2,
+	'$multifile'(N/A1, M).
+'$multifile'(N/A, M) :-
+	'$add_multifile'(N,A,M),
+	fail.
+'$multifile'(N/A, M) :-
+    functor(S,N,A),
+	'$is_multifile'(S, M), !.
+'$multifile'(N/A, M) :- !,
+	'$new_multifile'(N,A,M).
+'$multifile'([H|T], M) :- !,
+	'$multifile'(H,M),
+	'$multifile'(T,M).
+'$multifile'(P, M) :-
+	'$do_error'(type_error(predicate_indicator,P),multifile(M:P)).
+
+discontiguous(V) :-
+	var(V), !,
+	'$do_error'(instantiation_error,discontiguous(V)).
+discontiguous(M:F) :- !,
+	'$discontiguous'(F,M).
+discontiguous(F) :-
+	'$current_module'(M),
+	'$discontiguous'(F,M).
+
+'$discontiguous'(V,M) :- var(V), !,
+	'$do_error'(instantiation_error,M:discontiguous(V)).
+'$discontiguous'((X,Y),M) :- !,
+	'$discontiguous'(X,M),
+	'$discontiguous'(Y,M).
+'$discontiguous'(M:A,_) :- !,
+	'$discontiguous'(A,M).
+'$discontiguous'(N//A1, M) :- !,
+	integer(A1), !,
+	A is A1+2,
+	'$discontiguous'(N/A, M).
+'$discontiguous'(N/A, M) :- !,
+	'$new_discontiguous'(N,A,M).
+'$discontiguous'(P,M) :-
+	'$do_error'(type_error(predicate_indicator,P),M:discontiguous(P)).
+
+%
+% did we declare multifile properly?
+%
+'$check_multifile_pred'(Hd, M, _) :-
+	functor(Hd,Na,Ar),
+	source_location(F, _),
+	recorded('$multifile_defs','$defined'(F,Na,Ar,M),_), !.
+% oops, we did not.
+'$check_multifile_pred'(Hd, M, Fl) :-
+	% so this is not a multi-file predicate any longer.
+	functor(Hd,Na,Ar),
+	NFl is \(0x20000000) /\ Fl,
+	'$predicate_flags'(Hd,M,Fl,NFl),
+	'$warn_mfile'(Na,Ar).
+
+'$warn_mfile'(F,A) :-
+	write(user_error,'% Warning: predicate '),
+	write(user_error,F/A), write(user_error,' was a multifile predicate '),
+	write(user_error,' (line '),
+	'$start_line'(LN), write(user_error,LN),
+	write(user_error,')'),
+	nl(user_error).
+
+'$is_public'(T, Mod) :-
+	'$is_dynamic'(T, Mod), !.  % all dynamic predicates are public.
+'$is_public'(T, Mod) :-
+	'$predicate_flags'(T,Mod,F,F),
+	F\/0x00400000 =\= 0.
+
+/**
+ @pred module_transparent( + _Preds_ ) is directive
+   _Preds_ is a list of predicates that can access the calling context.
+
+This predicate was implemented to achieve compatibility with the older
+module expansion system in SWI-Prolog. Please use meta_predicate/1 for
+new code.
+
+_Preds_ is a comma separated sequence of name/arity predicate
+indicators (like in dynamic/1). Each goal associated with a
+transparent declared predicate will inherit the context module from
+its caller.
+
+*/
+:- dynamic('$module_transparent'/4).
+
+'$module_transparent'((P,Ps), M) :- !,
+	'$module_transparent'(P, M),
+	'$module_transparent'(Ps, M).
+'$module_transparent'(M:D, _) :- !,
+	'$module_transparent'(D, M).
+'$module_transparent'(F/N, M) :-
+	'$module_transparent'(F,M,N,_), !.
+'$module_transparent'(F/N, M) :-
+	functor(P,F,N),
+	asserta(prolog:'$module_transparent'(F,M,N,P)),
+	'$predicate_flags'(P, M, Fl, Fl),
+	NFlags is Fl \/ 0x200004,
+	'$predicate_flags'(P, M, Fl, NFlags).

packages/python/swig/yap4py/prolog/pl/preddyns.yap

@@ -0,0 +1,350 @@
+                                % The next predicates are applicable only
+                                % to dynamic code
+
+/** @file preddyns.yap */
+
+/**
+ * @ingroup Database
+ * @{
+
+Next follow the main operations on dynamic predicates.
+
+*/
+
+/** @pred  asserta(+ _C_) is iso
+
+
+Adds clause  _C_ to the beginning of the program. If the predicate is
+undefined, it is declared  dynamic (see dynamic/1).
+
+*/
+asserta(Clause) :-
+    '$assert'(Clause, asserta, _).
+
+/** @pred  assertz(+ _C_) is iso
+
+
+Adds clause  _C_ to the end of the program. If the predicate is
+undefined, it is declared  dynamic (see dynamic/1).
+
+Most Prolog systems only allow asserting clauses for dynamic
+predicates. This is also as specified in the ISO standard. YAP also allows
+asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks.
+*/
+assertz(Clause) :-
+    '$assert'(Clause, assertz, _).
+
+/** @pred  assert(+ _C_)
+
+Same as assertz/1. Adds clause  _C_ to the program. If the predicate is undefined,
+declare it as dynamic. New code should use assertz/1 for better portability.
+
+Most Prolog systems only allow asserting clauses for dynamic
+predicates. This is also as specified in the ISO standard. YAP allows
+asserting clauses for static predicates, as long as the predicate is not
+in use and the language flag is <tt>cprolog</tt>. Note that this feature is
+deprecated, if you want to assert clauses for static procedures you
+should use assert_static/1.
+
+*/
+assert(Clause) :-
+    '$assert'(Clause, assertz, _).
+
+'$assert'(Clause, Where, R) :-
+'$yap_strip_clause'(Clause, _, _Clause0),
+    '$expand_clause'(Clause,C0,C),
+    '$$compile'(C, Where, C0, R).
+
+/** @pred  asserta(+ _C_,- _R_)
+
+The same as `asserta(C)` but unifying  _R_ with
+the  database reference that identifies the new clause, in a
+one-to-one way. Note that `asserta/2` only works for dynamic
+predicates. If the predicate is undefined, it will automatically be
+declared dynamic.
+
+*/
+asserta(Clause, Ref) :-
+    '$assert'(Clause, asserta, Ref).
+
+/** @pred  assertz(+ _C_,- _R_)
+
+The same as `assertz(C)` but unifying  _R_ with
+the  database reference that identifies the new clause, in a
+one-to-one way. Note that `asserta/2` only works for dynamic
+predicates. If the predicate is undefined, it will automatically be
+declared dynamic.
+
+
+*/
+assertz(Clause, Ref) :-
+    '$assert'(Clause, assertz, Ref).
+
+/** @pred  assert(+ _C_,- _R_)
+
+The same as `assert(C)` ( (see Modifying the Database)) but
+unifies  _R_ with the  database reference that identifies the new
+clause, in a one-to-one way. Note that `asserta/2` only works for dynamic
+predicates. If the predicate is undefined, it will automatically be
+declared dynamic.
+
+
+*/
+assert(Clause, Ref) :-
+    '$assert'(Clause, assertz, Ref).
+
+
+'$assertz_dynamic'(X, C, C0, Mod) :-
+    (X/\4)=:=0,
+    !,
+    '$head_and_body'(C,H,B),
+    '$assertat_d'(assertz,H,B,C0,Mod,_).
+'$assertz_dynamic'(X,C,C0,Mod) :-
+	'$head_and_body'(C,H,B),
+	functor(H,N,A),
+	('$check_if_reconsulted'(N,A) ->
+     true
+    ;
+     (X/\8)=:=0 ->
+     '$inform_as_reconsulted'(N,A),
+     '$remove_all_d_clauses'(H,Mod)
+    ;
+     true
+	),
+	'$assertat_d'(assertz,H,B,C0,Mod,_).
+
+
+'$remove_all_d_clauses'(H,M) :-
+	'$is_multifile'(H, M), !,
+	functor(H, Na, A),
+	'$erase_all_mf_dynamic'(Na,A,M).
+'$remove_all_d_clauses'(H,M) :-
+	'$recordedp'(M:H,_,R), erase(R), fail.
+'$remove_all_d_clauses'(_,_).
+
+'$erase_all_mf_dynamic'(Na,A,M) :-
+	source_location( F , _),
+	recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,A,M,F,R), R1),
+	erase(R1),
+	erase(R),
+	fail.
+'$erase_all_mf_dynamic'(_,_,_).
+
+'$assertat_d'(asserta,Head,Body,C0,Mod,R) :- !,
+	'$compile_dynamic'((Head:-Body), asserta, C0, Mod, CR),
+    ( get_value('$abol',true)
+    ->
+      '$predicate_flags'(Head,Mod,Fl,Fl),
+      ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
+    ;
+      true
+    ),
+	'$head_and_body'(C0, H0, B0),
+	'$recordap'(Mod:Head,(H0 :- B0),R,CR),
+	( '$is_multifile'(Head, Mod) ->
+      source_location(F, _),
+      functor(H0, Na, Ar),
+      recorda('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
+	;
+      true
+	).
+'$assertat_d'(assertz,Head,Body,C0,Mod,R) :-
+	'$compile_dynamic'((Head:-Body), assertz, C0, Mod, CR),
+    ( get_value('$abol',true)
+    ->
+      '$predicate_flags'(Head,Mod,Fl,Fl),
+      ( Fl /\ 0x20000000 =\= 0 -> '$check_multifile_pred'(Head,Mod,Fl) ; true )
+    ;
+      true
+    ),
+	'$head_and_body'(C0, H0, B0),
+	'$recordzp'(Mod:Head,(H0 :- B0),R,CR),
+	( '$is_multifile'(H0, Mod) ->
+      source_location(F, _),
+      functor(H0, Na, Ar),
+      recordz('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,Mod,F,R), _)
+	;
+      true
+	).
+
+/** @pred  retract(+ _C_) is iso
+
+
+Erases the first clause in the program that matches  _C_. This
+predicate may also be used for the static predicates that have been
+compiled when the source mode was `on`. For more information on
+source/0 ( (see Setting the Compiler)).
+
+
+*/
+retract( C ) :-
+    strip_module( C, M, C0),
+	'$check_head_and_body'(M:C0,M1,H,B,retract(M:C)),
+	'$predicate_flags'(H, M1, F, F),
+	'$retract2'(F, H, M1, B,_).
+
+'$retract2'(F, H, M, B, R) :-
+	F /\ 0x08000000 =:= 0x08000000, !,
+                                %	'$is_log_updatable'(H, M), !,
+	'$log_update_clause'(H,M,B,R),
+	( F /\ 0x20000000  =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
+	erase(R).
+'$retract2'(F, H, M, B, R) :-
+                                %	'$is_dynamic'(H,M), !,
+	F /\ 0x00002000 =:= 0x00002000, !,
+	'$recordedp'(M:H,(H:-B),R),
+	( F /\ 0x20000000  =:= 0x20000000, recorded('$mf','$mf_clause'(_,_,_,_,MRef),MR), erase(MR), erase(MRef), fail ; true),
+	erase(R).
+'$retract2'(_, H,M,_,_) :-
+	'$undefined'(H,M), !,
+	functor(H,Na,Ar),
+	'$dynamic'(Na/Ar,M),
+	fail.
+'$retract2'(_, H,M,B,_) :-
+	functor(H,Na,Ar),
+	\+ '$dynamic'(Na/Ar,M),
+	'$do_error'(permission_error(modify,static_procedure,Na/Ar),retract(M:(H:-B))).
+
+/** @pred  retract(+ _C_,- _R_)
+
+Erases from the program the clause  _C_ whose
+database reference is  _R_. The predicate must be dynamic.
+
+
+
+
+*/
+retract(M:C,R) :- !,
+    '$yap_strip_module'( C, M, H0),
+    '$retract'(H0, M, R).
+
+'$retract'(C, M0, R) :-
+	db_reference(R),
+    	'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
+	dynamic(H,M),
+	!,
+	instance(R,(H:-B)),
+    erase(R).
+'$retract'(C,M0,R) :-
+	'$check_head_and_body'(M0:C,M,H,B,retract(C,R)),
+	var(R), !,
+	'$retract2'(H, M, B, R).
+'$retract'(C,M,_) :-
+	'$fetch_predicate_indicator_from_clause'(C, M, PI),
+    \+ '$dynamic'(PI),
+	'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
+
+'$fetch_predicate_indicator_from_clause'((C :- _), M:Na/Ar) :-
+!,
+    '$yap_strip_module'(C, M, C1),
+    functor(C1, Na, Ar).
+'$fetch_predicate_indicator_from_clause'(C, M:Na/Ar) :-
+    '$yap_strip_module'(C, M, C1),
+	functor(C1, Na, Ar).
+
+
+/** @pred  retractall(+ _G_) is iso
+
+
+Retract all the clauses whose head matches the goal  _G_. Goal
+ _G_ must be a call to a dynamic predicate.
+
+*/
+retractall(M:V) :- !,
+	'$retractall'(V,M).
+retractall(V) :-
+	'$current_module'(M),
+	'$retractall'(V,M).
+
+'$retractall'(V,M) :- var(V), !,
+	'$do_error'(instantiation_error,retract(M:V)).
+'$retractall'(M:V,_) :- !,
+	'$retractall'(V,M).
+'$retractall'(T,M) :-
+	(
+     '$is_log_updatable'(T, M) ->
+	 ( '$is_multifile'(T, M) ->
+	   '$retractall_lu_mf'(T,M)
+	 ;
+	   '$retractall_lu'(T,M)
+	 )
+	;
+     \+ callable(T) ->
+     '$do_error'(type_error(callable,T),retractall(T))
+	;
+     '$undefined'(T,M) ->
+     functor(T,Na,Ar),
+     '$dynamic'(Na/Ar,M), !
+	;
+     '$is_dynamic'(T,M) ->
+     '$erase_all_clauses_for_dynamic'(T, M)
+	;
+     functor(T,Na,Ar),
+     '$do_error'(permission_error(modify,static_procedure,Na/Ar),retractall(T))
+	).
+
+'$retractall_lu'(T,M) :-
+	'$free_arguments'(T), !,
+	( '$purge_clauses'(T,M), fail ; true ).
+'$retractall_lu'(T,M) :-
+	'$log_update_clause'(T,M,_,R),
+	erase(R),
+	fail.
+'$retractall_lu'(_,_).
+
+'$retractall_lu_mf'(T,M) :-
+	'$log_update_clause'(T,M,_,R),
+	( recorded('$mf','$mf_clause'(_,_,_,_,R),MR), erase(MR), fail ; true),
+	erase(R),
+	fail.
+'$retractall_lu_mf'(_,_).
+
+'$erase_all_clauses_for_dynamic'(T, M) :-
+	'$recordedp'(M:T,(T :- _),R), erase(R), fail.
+'$erase_all_clauses_for_dynamic'(T,M) :-
+	'$recordedp'(M:T,_,_), fail.
+'$erase_all_clauses_for_dynamic'(_,_).
+
+/* support for abolish/1 */
+'$abolishd'(T, M) :-
+	'$is_multifile'(T,M),
+	functor(T,Name,Arity),
+	recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R),
+	erase(R),
+	erase(Ref),
+	fail.
+'$abolishd'(T, M) :-
+	recorded('$import','$import'(_,M,_,T,_,_),R),
+	erase(R),
+	fail.
+'$abolishd'(T, M) :-
+	'$purge_clauses'(T,M), fail.
+'$abolishd'(T, M) :-
+	'$kill_dynamic'(T,M), fail.
+'$abolishd'(_, _).
+
+
+/** @pred  dynamic_predicate(+ _P_,+ _Semantics_)
+
+
+Declares predicate  _P_ or list of predicates [ _P1_,..., _Pn_]
+as a dynamic predicate following either `logical` or
+`immediate` semantics.
+
+
+*/
+dynamic_predicate(P,Sem) :-
+	'$bad_if_is_semantics'(Sem, dynamic(P,Sem)).
+dynamic_predicate(P,Sem) :-
+	'$log_upd'(OldSem),
+	( Sem = logical -> '$switch_log_upd'(1) ; '$switch_log_upd'(0) ),
+	'$current_module'(M),
+	'$dynamic'(P, M),
+	'$switch_log_upd'(OldSem).
+
+'$bad_if_is_semantics'(Sem, Goal) :-
+	var(Sem), !,
+	'$do_error'(instantiation_error,Goal).
+'$bad_if_is_semantics'(Sem, Goal) :-
+	Sem \= immediate, Sem \= logical, !,
+	'$do_error'(domain_error(semantics_indicator,Sem),Goal).

packages/python/swig/yap4py/prolog/pl/preds.yap

@@ -0,0 +1,815 @@
+/*************************************************************************
+*									 *
+  *	 YAP Prolog 							 *
+  *									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		preds.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Predicate Manipulation for YAP				 *
+*									 *
+*************************************************************************/
+
+/**
+ * @{
+ * @defgroup Database The Clausal Data Base
+ * @ingroup builtins
+
+Predicates in YAP may be dynamic or static. By default, when
+consulting or reconsulting, predicates are assumed to be static:
+execution is faster and the code will probably use less space.
+Static predicates impose some restrictions: in general there can be no
+addition or removal of  clauses for a procedure if it is being used in the
+current execution.
+
+Dynamic predicates allow programmers to change the Clausal Data Base with
+the same flexibility as in C-Prolog. With dynamic predicates it is
+always possible to add or remove clauses during execution and the
+semantics will be the same as for C-Prolog. But the programmer should be
+aware of the fact that asserting or retracting are still expensive operations,
+and therefore he should try to avoid them whenever possible.
+
+*/
+
+:- system_module( '$_preds', [abolish/1,
+        abolish/2,
+        assert/1,
+        assert/2,
+        assert_static/1,
+        asserta/1,
+        asserta/2,
+        asserta_static/1,
+        assertz/1,
+        assertz/2,
+        assertz_static/1,
+        clause/2,
+        clause/3,
+        clause_property/2,
+        compile_predicates/1,
+        current_key/2,
+        current_predicate/1,
+        current_predicate/2,
+        dynamic_predicate/2,
+        hide_predicate/1,
+        nth_clause/3,
+        predicate_erased_statistics/4,
+        predicate_property/2,
+        predicate_statistics/4,
+        retract/1,
+        retract/2,
+        retractall/1,
+        stash_predicate/1,
+        system_predicate/1,
+        system_predicate/2,
+        unknown/2], ['$assert_static'/5,
+        '$assertz_dynamic'/4,
+        '$clause'/4,
+        '$current_predicate'/4,
+        '$init_preds'/0,
+        '$noprofile'/2,
+        '$public'/2,
+        '$unknown_error'/1,
+        '$unknown_warning'/1]).
+
+:- use_system_module( '$_boot', ['$check_head_and_body'/4,
+        '$check_if_reconsulted'/2,
+        '$head_and_body'/3,
+        '$inform_as_reconsulted'/2]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_init', ['$do_log_upd_clause'/6,
+        '$do_log_upd_clause0'/6,
+        '$do_log_upd_clause_erase'/6,
+        '$do_static_clause'/5]).
+
+:- use_system_module( '$_modules', ['$imported_pred'/4,
+        '$meta_predicate'/4,
+        '$module_expansion'/5]).
+
+:- use_system_module( '$_preddecls', ['$check_multifile_pred'/3,
+        '$dynamic'/2]).
+
+:- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1]).
+
+/** @pred  assert_static(: _C_)
+
+
+Adds clause  _C_ to a static procedure. Asserting a static clause
+for a predicate while choice-points for the predicate are available has
+undefined results.
+
+
+*/
+assert_static(C) :-
+	'$assert'(C , assertz_static, _ ).
+
+/** @pred  asserta_static(: _C_)
+
+
+Adds clause  _C_ as the first clause for a static procedure.
+
+
+*/
+asserta_static(C) :-
+	'$assert'(C , asserta_static, _ ).
+
+
+/** @pred  assertz_static(: _C_)
+
+
+Adds clause  _C_ to the end of a static procedure.  Asserting a
+static clause for a predicate while choice-points for the predicate are
+available has undefined results.
+
+
+
+The following predicates can be used for dynamic predicates and for
+static predicates, if source mode was on when they were compiled:
+
+
+
+
+*/
+assertz_static(C) :-
+	'$assert'(C , assertz_static, _ ).
+
+/** @pred  clause(+ _H_, _B_) is iso
+
+
+A clause whose head matches  _H_ is searched for in the
+program. Its head and body are respectively unified with  _H_ and
+ _B_. If the clause is a unit clause,  _B_ is unified with
+ _true_.
+
+This predicate is applicable to static procedures compiled with
+`source` active, and to all dynamic procedures.
+
+
+*/
+clause(V0,Q) :-
+	'$yap_strip_module'(V0, M, V),
+    must_be_of_type( callable, V ),
+	'$clause'(V,M,Q,_).
+
+/** @pred  clause(+ _H_, _B_,- _R_)
+
+The same as clause/2, plus  _R_ is unified with the
+reference to the clause in the database. You can use instance/2
+to access the reference's value. Note that you may not use
+erase/1 on the reference on static procedures.
+*/
+clause(P,Q,R) :-
+	'$instance_module'(R,M0), !,
+	instance(R,T0),
+	( T0 = (H :- B) -> Q = B ; H=T0, Q = true),
+    '$yap_strip_module'(P, M, T),
+    '$yap_strip_module'(M0:H, M1, H1),
+    (
+     M == M1
+    ->
+     H1 = T
+    ;
+     M1:H1 = T
+    ).
+clause(V0,Q,R) :-
+	'$yap_strip_module'(V0, M, V),
+    must_be_of_type( callable, V ),
+	'$clause'(V,M,Q,R).
+
+'$clause'(P,M,Q,R) :-
+	'$is_exo'(P, M), !,
+	Q = true,
+	R = '$exo_clause'(M,P),
+	'$execute0'(P, M).
+'$clause'(P,M,Q,R) :-
+	'$is_log_updatable'(P, M), !,
+	'$log_update_clause'(P,M,Q,R).
+'$clause'(P,M,Q,R) :-
+	'$is_source'(P, M), !,
+	'$static_clause'(P,M,Q,R).
+'$clause'(P,M,Q,R) :-
+	'$some_recordedp'(M:P), !,
+	'$recordedp'(M:P,(P:-Q),R).
+'$clause'(P,M,Q,R) :-
+	\+ '$undefined'(P,M),
+	( '$is_system_predicate'(P,M) -> true ;
+	    '$number_of_clauses'(P,M,N), N > 0 ),
+	functor(P,Name,Arity),
+	'$do_error'(permission_error(access,private_procedure,Name/Arity),
+	      clause(M:P,Q,R)).
+
+'$init_preds' :-
+	once('$do_static_clause'(_,_,_,_,_)),
+	fail.
+'$init_preds' :-
+	once('$do_log_upd_clause0'(_,_,_,_,_,_)),
+	fail.
+'$init_preds' :-
+	once('$do_log_upd_clause'(_,_,_,_,_,_)),
+	fail.
+'$init_preds' :-
+	once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
+	fail.
+'$init_preds'.
+
+:- '$init_preds'.
+
+/** @pred  nth_clause(+ _H_, _I_,- _R_)
+
+
+Find the  _I_th clause in the predicate defining  _H_, and give
+a reference to the clause. Alternatively, if the reference  _R_ is
+given the head  _H_ is unified with a description of the predicate
+and  _I_ is bound to its position.
+
+
+*/
+nth_clause(V,I,R) :-
+	strip_module(V, M1, P), !,
+	'$nth_clause'(P, M1, I, R).
+
+
+'$nth_clause'(P,M,I,R) :-
+	var(I), var(R), !,
+	'$clause'(P,M,_,R),
+	'$fetch_nth_clause'(P,M,I,R).
+'$nth_clause'(P,M,I,R) :-
+	'$fetch_nth_clause'(P,M,I,R).
+
+/** @pred  abolish(+ _P_,+ _N_)
+
+Completely delete the predicate with name _P_ and arity _N_. It will
+remove both static and dynamic predicates. All state on the predicate,
+including whether it is dynamic or static, multifile, or
+meta-predicate, will be lost.
+*/
+abolish(N0,A) :-
+	strip_module(N0, Mod, N), !,
+	'$abolish'(N,A,Mod).
+
+'$abolish'(N,A,M) :- var(N), !,
+	'$do_error'(instantiation_error,abolish(M:N,A)).
+'$abolish'(N,A,M) :- var(A), !,
+	'$do_error'(instantiation_error,abolish(M:N,A)).
+'$abolish'(N,A,M) :-
+	( recorded('$predicate_defs','$predicate_defs'(N,A,M,_),R) -> erase(R) ),
+	fail.
+'$abolish'(N,A,M) :- functor(T,N,A),
+		( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
+	      	 /* else */	      '$abolishs'(T,M) ).
+
+/** @pred  abolish(+ _PredSpec_) is iso
+
+
+Deletes the predicate given by  _PredSpec_ from the database. If
+§§ _PredSpec_ is an unbound variable, delete all predicates for the
+current module. The
+specification must include the name and arity, and it may include module
+information. Under <tt>iso</tt> language mode this built-in will only abolish
+dynamic procedures. Under other modes it will abolish any procedures.
+
+
+*/
+abolish(X0) :-
+	strip_module(X0,M,X),
+	'$abolish'(X,M).
+
+'$abolish'(X,M) :-
+	current_prolog_flag(language, sicstus), !,
+	'$new_abolish'(X,M).
+'$abolish'(X, M) :-
+	'$old_abolish'(X,M).
+
+'$new_abolish'(V,M) :- var(V), !,
+	'$abolish_all'(M).
+'$new_abolish'(A/V,M) :- atom(A), var(V), !,
+	'$abolish_all_atoms'(A,M).
+'$new_abolish'(Na//Ar1, M) :-
+	integer(Ar1),
+	!,
+	Ar is Ar1+2,
+	'$new_abolish'(Na//Ar, M).
+'$new_abolish'(Na/Ar, M) :-
+	functor(H, Na, Ar),
+	'$is_dynamic'(H, M), !,
+	'$abolishd'(H, M).
+'$new_abolish'(Na/Ar, M) :- % succeed for undefined procedures.
+	functor(T, Na, Ar),
+	'$undefined'(T, M), !.
+'$new_abolish'(Na/Ar, M) :-
+	'$do_error'(permission_error(modify,static_procedure,Na/Ar),abolish(M:Na/Ar)).
+'$new_abolish'(T, M) :-
+	'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
+
+'$abolish_all'(M) :-
+        '$current_predicate'(Na, M, S, _),
+        functor(S, Na, Ar),
+	'$new_abolish'(Na/Ar, M),
+	fail.
+'$abolish_all'(_).
+
+'$abolish_all_atoms'(Na, M) :-
+        '$current_predicate'(Na,M,S,_),
+        functor(S, Na, Ar),
+	'$new_abolish'(Na/Ar, M),
+	fail.
+'$abolish_all_atoms'(_,_).
+
+'$check_error_in_predicate_indicator'(V, Msg) :-
+	var(V), !,
+	'$do_error'(instantiation_error, Msg).
+'$check_error_in_predicate_indicator'(M:S, Msg) :- !,
+	'$check_error_in_module'(M, Msg),
+	'$check_error_in_predicate_indicator'(S, Msg).
+'$check_error_in_predicate_indicator'(S, Msg) :-
+	S \= _/_,
+	S \= _//_, !,
+	'$do_error'(type_error(predicate_indicator,S), Msg).
+'$check_error_in_predicate_indicator'(Na/_, Msg) :-
+	var(Na), !,
+	'$do_error'(instantiation_error, Msg).
+'$check_error_in_predicate_indicator'(Na/_, Msg) :-
+	\+ atom(Na), !,
+	'$do_error'(type_error(atom,Na), Msg).
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
+	var(Ar), !,
+	'$do_error'(instantiation_error, Msg).
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
+	\+ integer(Ar), !,
+	'$do_error'(type_error(integer,Ar), Msg).
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
+	Ar < 0, !,
+	'$do_error'(domain_error(not_less_than_zero,Ar), Msg).
+% not yet implemented!
+%'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+%	Ar < maxarity, !,
+%	'$do_error'(type_error(representation_error(max_arity),Ar), Msg).
+
+'$check_error_in_module'(M, Msg) :-
+	var(M), !,
+	'$do_error'(instantiation_error, Msg).
+'$check_error_in_module'(M, Msg) :-
+	\+ atom(M), !,
+	'$do_error'(type_error(atom,M), Msg).
+
+'$old_abolish'(V,M) :- var(V), !,
+	( true -> % current_prolog_flag(language, sicstus) ->
+	    '$do_error'(instantiation_error,abolish(M:V))
+	;
+	    '$abolish_all_old'(M)
+	).
+'$old_abolish'(N/A, M) :- !,
+	'$abolish'(N, A, M).
+'$old_abolish'(A,M) :- atom(A), !,
+	( current_prolog_flag(language, iso) ->
+	  '$do_error'(type_error(predicate_indicator,A),abolish(M:A))
+	;
+	    '$abolish_all_atoms_old'(A,M)
+	).
+'$old_abolish'([], _) :- !.
+'$old_abolish'([H|T], M) :- !,  '$old_abolish'(H, M), '$old_abolish'(T, M).
+'$old_abolish'(T, M) :-
+	'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
+
+'$abolish_all_old'(M) :-
+        '$current_predicate'(Na, M, S, _),
+	functor( S, Na, Ar ),
+	'$abolish'(Na, Ar, M),
+	fail.
+'$abolish_all_old'(_).
+
+'$abolish_all_atoms_old'(Na, M) :-
+        '$current_predicate'(Na, M, S, _),
+	functor(S, Na, Ar),
+	'$abolish'(Na, Ar, M),
+	fail.
+'$abolish_all_atoms_old'(_,_).
+
+'$abolishs'(G, M) :- '$system_predicate'(G,M), !,
+	functor(G,Name,Arity),
+	'$do_error'(permission_error(modify,static_procedure,Name/Arity),abolish(M:G)).
+'$abolishs'(G, Module) :-
+	current_prolog_flag(language, sicstus), % only do this in sicstus mode
+	'$undefined'(G, Module),
+	functor(G,Name,Arity),
+	print_message(warning,no_match(abolish(Module:Name/Arity))).
+'$abolishs'(G, M) :-
+	'$is_multifile'(G,M),
+	functor(G,Name,Arity),
+	recorded('$mf','$mf_clause'(_,Name,Arity,M,_Ref),R),
+	erase(R),
+% no need	erase(Ref),
+	fail.
+'$abolishs'(T, M) :-
+	recorded('$import','$import'(_,M,_,_,T,_,_),R),
+	erase(R),
+	fail.
+'$abolishs'(G, M) :-
+	'$purge_clauses'(G, M), fail.
+'$abolishs'(_, _).
+
+/**  @pred stash_predicate(+ _Pred_) @anchor stash_predicate
+Make predicate  _Pred_ invisible to new code, and to `current_predicate/2`,
+`listing`, and friends. New predicates with the same name and
+functor can be declared.
+ **/
+stash_predicate(P0) :-
+	strip_module(P0, M, P),
+	'$stash_predicate2'(P, M).
+
+'$stash_predicate2'(V, M) :- var(V), !,
+	'$do_error'(instantiation_error,stash_predicate(M:V)).
+'$stash_predicate2'(N/A, M) :- !,
+	functor(S,N,A),
+	'$stash_predicate'(S, M) .
+'$stash_predicate2'(PredDesc, M) :-
+	'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)).
+
+/** @pred hide_predicate(+ _Pred_)
+Make predicate  _Pred_ invisible to `current_predicate/2`,
+`listing`, and friends.
+
+ **/
+hide_predicate(P0) :-
+	'$yap_strip_module'(P0, M, P),
+	must_be_of_type(callable, M:P),
+	'$hide_predicate'(P, M).
+
+/** @pred  predicate_property( _P_, _Prop_) is iso
+
+
+For the predicates obeying the specification  _P_ unify  _Prop_
+  with a property of  _P_. These properties may be:
+
++ `built_in `
+true for built-in predicates,
+
++ `dynamic`
+true if the predicate is dynamic
+
++ `static `
+true if the predicate is static
+
++ `meta_predicate( _M_) `
+true if the predicate has a meta_predicate declaration  _M_.
+
++ `multifile `
+true if the predicate was declared to be multifile
+
++ `imported_from( _Mod_) `
+true if the predicate was imported from module  _Mod_.
+
++ `exported `
+true if the predicate is exported in the current module.
+
++ `public`
+true if the predicate is public; note that all dynamic predicates are
+public.
+
++ `tabled `
+true if the predicate is tabled; note that only static predicates can
+be tabled in YAP.
+
++ `source (predicate_property flag) `
+true if source for the predicate is available.
+
++ `number_of_clauses( _ClauseCount_) `
+Number of clauses in the predicate definition. Always one if external
+or built-in.
+
+*/
+predicate_property(Pred,Prop) :-
+	strip_module(Pred, Mod, TruePred),
+	'$predicate_property2'(TruePred,Prop,Mod).
+
+'$predicate_property2'(Pred, Prop, Mod) :-
+	var(Mod), !,
+	'$all_current_modules'(Mod),
+	'$predicate_property2'(Pred, Prop, Mod).
+'$predicate_property2'(Pred,Prop,M0) :-
+	var(Pred), !,
+	(M = M0 ;
+	 M0 \= prolog, M = prolog ;
+	 M0 \= user, M = user), % prolog and user modules are automatically incorporate in every other module
+	'$generate_all_preds_from_mod'(Pred, SourceMod, M),
+	'$predicate_property'(Pred,SourceMod,M,Prop).
+'$predicate_property2'(M:Pred,Prop,_) :- !,
+	'$predicate_property2'(Pred,Prop,M).
+'$predicate_property2'(Pred,Prop,Mod) :-
+	'$pred_exists'(Pred,Mod), !,
+	'$predicate_property'(Pred,Mod,Mod,Prop).
+'$predicate_property2'(Pred,Prop,Mod) :-
+    '$get_undefined_pred'(Pred, Mod, NPred, M),
+	(
+	 Prop = imported_from(M)
+	;
+	 '$predicate_property'(NPred,M,M,Prop),
+	 Prop \= exported
+	).
+
+'$generate_all_preds_from_mod'(Pred, M, M) :-
+	'$current_predicate'(_Na,M,Pred,_).
+'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
+	recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
+	'$pred_exists'(Orig, SourceMod).
+
+'$predicate_property'(P,M,_,built_in) :-
+	'$is_system_predicate'(P,M).
+'$predicate_property'(P,M,_,source) :-
+	'$predicate_flags'(P,M,F,F),
+	F /\ 0x00400000 =\= 0.
+'$predicate_property'(P,M,_,tabled) :-
+	'$predicate_flags'(P,M,F,F),
+	F /\ 0x00000040 =\= 0.
+'$predicate_property'(P,M,_,dynamic) :-
+	'$is_dynamic'(P,M).
+'$predicate_property'(P,M,_,static) :-
+	\+ '$is_dynamic'(P,M),
+	\+ '$undefined'(P,M).
+'$predicate_property'(P,M,_,meta_predicate(Q)) :-
+	functor(P,Na,Ar),
+	prolog:'$meta_predicate'(Na,M,Ar,Q).
+'$predicate_property'(P,M,_,multifile) :-
+	'$is_multifile'(P,M).
+'$predicate_property'(P,M,_,public) :-
+	'$is_public'(P,M).
+'$predicate_property'(P,M,_,thread_local) :-
+	'$is_thread_local'(P,M).
+'$predicate_property'(P,M,M,exported) :-
+	functor(P,N,A),
+	once(recorded('$module','$module'(_TFN,M,_S,Publics,_L),_)),
+	lists:memberchk(N/A,Publics).
+'$predicate_property'(P,Mod,_,number_of_clauses(NCl)) :-
+	'$number_of_clauses'(P,Mod,NCl).
+'$predicate_property'(P,Mod,_,file(F)) :-
+	'$owner_file'(P,Mod,F).
+
+
+/**
+  @pred  predicate_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
+
+Given predicate  _P_,  _NCls_ is the number of clauses for
+ _P_,  _Sz_ is the amount of space taken to store those clauses
+(in bytes), and  _IndexSz_ is the amount of space required to store
+indices to those clauses (in bytes).
+*/
+predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
+	'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
+predicate_statistics(P0,NCls,Sz,ISz) :-
+	strip_module(P0, M, P),
+	'$predicate_statistics'(P,M,NCls,Sz,ISz).
+
+'$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !,
+	'$predicate_statistics'(P,M,NCls,Sz,ISz).
+'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
+	'$is_log_updatable'(P, M), !,
+	'$lu_statistics'(P,NCls,Sz,ISz,M).
+'$predicate_statistics'(P,M,_,_,_) :-
+	'$is_system_predicate'(P,M), !, fail.
+'$predicate_statistics'(P,M,_,_,_) :-
+	'$undefined'(P,M), !, fail.
+'$predicate_statistics'(P,M,NCls,Sz,ISz) :-
+	'$static_pred_statistics'(P,M,NCls,Sz,ISz).
+
+/** @pred  predicate_erased_statistics( _P_, _NCls_, _Sz_, _IndexSz_)
+
+
+Given predicate  _P_,  _NCls_ is the number of erased clauses for
+ _P_ that could not be discarded yet,  _Sz_ is the amount of space
+taken to store those clauses (in bytes), and  _IndexSz_ is the amount
+of space required to store indices to those clauses (in bytes).
+
+ */
+predicate_erased_statistics(P,NCls,Sz,ISz) :-
+        var(P), !,
+	current_predicate(_,P),
+	predicate_erased_statistics(P,NCls,Sz,ISz).
+predicate_erased_statistics(P0,NCls,Sz,ISz) :-
+	strip_module(P0,M,P),
+	'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
+
+/** @pred  current_predicate( _A_, _P_)
+
+Defines the relation:  _P_ is a currently defined predicate whose name is the atom  _A_.
+*/
+current_predicate(A,T0) :-
+	'$yap_strip_module'(T0, M, T),
+	(nonvar(T) -> functor(T, A, _) ; true ),
+	(
+	 '$current_predicate'(A,M, T, user)
+    ;
+	 '$imported_predicate'(T, M, T1, M1),
+	 functor(T1, A, _),
+	 \+ '$is_system_predicate'(T1,M1)
+    ).
+
+/** @pred  system_predicate( ?_P_ )
+
+Defines the relation:  indicator _P_ refers to a currently defined system predicate.
+*/
+system_predicate(P0) :-
+	'$yap_strip_module'(P0, M, 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),
+     '$is_system_predicate'( T, M)
+    ;
+      ground(P), P = A//Arity2
+    ->
+     Arity is Arity2+2,
+     functor(T, A, Arity),
+     '$current_predicate'(A, M, T, system),
+     '$is_system_predicate'( T, M)
+    ;
+     P = A/Arity
+    ->
+     '$current_predicate'(A, M, T, system),
+     '$is_system_predicate'( T,  M),
+     functor(T, A, Arity)
+    ;
+     P = A//Arity2
+    ->
+     '$current_predicate'(A, M, T, system),
+     '$is_system_predicate'( T,  M),
+     functor(T, A, Arity),
+     Arity >= 2,
+     Arity2 is Arity-2
+    ;
+    '$do_error'(type_error(predicate_indicator,P),
+                system_predicate(P0))
+    ).
+
+/** @pred  system_predicate( ?A, ?P )
+
+  Succeeds if _A_ is the name of the system predicate _P_. It can be used to test and to enumerate all system predicates.
+
+  YAP also supports the ISO standard built-in system_predicate/1, that
+  provides similar functionality and is compatible with most other Prolog
+  systems.
+
+*/
+system_predicate(A, P0) :-
+	'$yap_strip_module'(P0, M, P),
+    (
+      nonvar(P)
+    ->
+     '$current_predicate'(A, M, P, system),
+     '$is_system_predicate'( P,  M)
+    ;
+     '$current_predicate'(A, M, P, system)
+    ).
+
+
+/**
+  @pred  current_predicate( F ) is iso
+
+  True if _F_ is the predicate indicator for a currently defined user or
+  library predicate.The indicator  _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
+  where the atom _Mod_ is the module of the predicate,
+ _Na_ is the name of the predicate, and  _Ar_ its arity.
+*/
+current_predicate(F0) :-
+	'$yap_strip_module'(F0, M, F),
+	must_bind_to_type( predicate_indicator, F ),
+	'$c_i_predicate'( F, M ).
+
+'$c_i_predicate'( A/N, M ) :-
+	!,
+	(
+	 ground(A/N)
+	->
+	 atom(A), integer(N),
+	 functor(S, A, N),
+	 current_predicate(A, M:S)
+	;
+	 current_predicate(A, M:S),
+	 functor(S, A, N)
+	 ).
+'$c_i_predicate'( A//N, M ) :-
+	(
+	 ground(A)
+	->
+	 atom(A), integer(N),
+	 N2 is N+2,
+	 functor(S, A, N2),
+	 current_predicate(A, M:S)
+	;
+	 current_predicate(A, M:S),
+	 functor(S, A, N2),
+	 N is N2-2
+	).
+
+/** @pred  current_key(? _A_,? _K_)
+
+
+Defines the relation:  _K_ is a currently defined database key whose
+name is the atom  _A_. It can be used to generate all the keys for
+  the internal data-base.
+*/
+current_key(A,K) :-
+	'$current_predicate'(A,idb,K,user).
+
+% do nothing for now.
+'$noprofile'(_, _).
+
+'$ifunctor'(Pred,Na,Ar) :-
+	(Ar > 0 ->
+	    functor(Pred, Na, Ar)
+	;
+	     Pred = Na
+	 ).
+
+
+/** @pred  compile_predicates(: _ListOfNameArity_)
+
+
+
+Compile a list of specified dynamic predicates (see dynamic/1 and
+assert/1 into normal static predicates. This call tells the
+Prolog environment the definition will not change anymore and further
+calls to assert/1 or retract/1 on the named predicates
+raise a permission error. This predicate is designed to deal with parts
+of the program that is generated at runtime but does not change during
+the remainder of the program execution.
+ */
+compile_predicates(Ps) :-
+	'$current_module'(Mod),
+	'$compile_predicates'(Ps, Mod, compile_predicates(Ps)).
+
+'$compile_predicates'(V, _, Call) :-
+	var(V), !,
+	'$do_error'(instantiation_error,Call).
+'$compile_predicates'(M:Ps, _, Call) :-
+	'$compile_predicates'(Ps, M, Call).
+'$compile_predicates'([], _, _).
+'$compile_predicates'([P|Ps], M, Call) :-
+	'$compile_predicate'(P, M, Call),
+	'$compile_predicates'(Ps, M, Call).
+
+'$compile_predicate'(P, _M, Call) :-
+	var(P), !,
+	'$do_error'(instantiation_error,Call).
+'$compile_predicate'(M:P, _, Call) :-
+	'$compile_predicate'(P, M, Call).
+'$compile_predicate'(Na/Ar, Mod, _Call) :-
+	functor(G, Na, Ar),
+	findall([G|B],clause(Mod:G,B),Cls),
+	abolish(Mod:Na,Ar),
+	'$add_all'(Cls, Mod).
+
+'$add_all'([], _).
+'$add_all'([[G|B]|Cls], Mod) :-
+	assert_static(Mod:(G:-B)),
+	'$add_all'(Cls, Mod).
+
+
+clause_property(ClauseRef, file(FileName)) :-
+	( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
+	-> true
+	;
+	instance_property(ClauseRef, 2, FileName) ).
+clause_property(ClauseRef, source(FileName)) :-
+	( recorded('$mf','$mf_clause'(FileName,_Name,_Arity,_Module,ClauseRef),_R)
+	-> true
+	;
+	instance_property(ClauseRef, 2, FileName) ).
+clause_property(ClauseRef, line_count(LineNumber)) :-
+	instance_property(ClauseRef, 4, LineNumber),
+	LineNumber > 0.
+clause_property(ClauseRef, fact) :-
+	instance_property(ClauseRef, 3, true).
+clause_property(ClauseRef, erased) :-
+	instance_property(ClauseRef, 0, true).
+clause_property(ClauseRef, predicate(PredicateIndicator)) :-
+	instance_property(ClauseRef, 1, PredicateIndicator).
+
+'$set_predicate_attribute'(M:N/Ar, Flag, V) :-
+	functor(P, N, Ar),
+	'$set_flag'(P, M, Flag, V).
+
+%% '$set_flag'(P, M, trace, off) :-
+% set a predicate flag
+%
+'$set_flag'(P, M, trace, off) :-
+	'$predicate_flags'(P,M,F,F),
+  FN is F \/ 0x400000000,
+	'$predicate_flags'(P,M,F,FN).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/profile.yap

@@ -0,0 +1,262 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		profile.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Some profiling predicates available in yap		 *
+*									 *
+*************************************************************************/
+
+%% @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
+@{
+
+The count profiler works by incrementing counters at procedure entry or
+backtracking. It provides exact information:
+
++ Profiling works for both static and dynamic predicates.
++ Currently only information on entries and retries to a predicate
+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/0 shows all procedures, irrespective of module, and
+the procedure list_profile/1 shows the procedures being used in
+a specific module.
+
+~~~~~
+list_profile :-
+        % get number of calls for each profiled procedure
+        setof(D-[M:P|D1],(current_module(M),profile_data(M:P,calls,D),profile_data(M:P,retries,D1)),LP),
+        % output so that the most often called
+        % predicates will come last:
+        write_profile_data(LP).
+
+list_profile(Module) :-
+        % get number of calls for each profiled procedure
+        setof(D-[Module:P|D1],(profile_data(Module:P,calls,D),profile_data(Module:P,retries,D1)),LP),
+        % output so that the most often called
+        % predicates will come last:
+        write_profile_data(LP).
+
+write_profile_data([]).
+write_profile_data([D-[M:P|R]|SLP]) :-
+        % swap the two calls if you want the most often
+        %  called predicates first.
+        format('~a:~w: ~32+~t~d~12+~t~d~12+~n', [M,P,D,R]),
+        write_profile_data(SLP).
+~~~~~
+
+
+These are  the current predicates to access and clear profiling data:
+
+
+ 
+*/
+
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+
+% hook predicate, taken from SWI-Prolog, for converting possibly explicitly-
+% qualified callable terms into an atom that can be used as a label for
+% 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_) 
+
+
+Give current profile data on  _Parameter_ for a predicate described
+by the predicate indicator  _Na/Ar_. If any of  _Na/Ar_ or
+ _Parameter_ are unbound, backtrack through all profiled predicates
+or stored parameters. Current parameters are:
+
++ calls
+Number of times a procedure was called.
+
++ retries
+Number of times a call to the procedure was backtracked to and retried.
+
+
++ profile_reset 
+
+
+Reset all profiling information.
+
+
+
+
+ */
+:- meta_predicate profile_data(:,+,-).
+
+profile_data(M:D, Parm, Data) :-!,
+	(
+	  var(M) ->
+	  '$do_error'(instantiation_error,profile_data(M:D, Parm, Data))
+	;
+	  '$profile_data'(D, Parm, Data, M)
+	).
+profile_data(P, Parm, Data) :-
+	'$current_module'(M),
+	'$profile_data'(P, Parm, Data, M).
+
+'$profile_data'(P, Parm, Data,M) :- var(P), !,
+	'$profile_data_for_var'(P, Parm, Data,M).
+'$profile_data'(M:P, Parm, Data, _) :-  !,
+	'$profile_data'(P, Parm, Data, M).
+'$profile_data'(P, Parm, Data, M) :-
+	'$profile_data2'(P, Parm, Data, M).
+
+'$profile_data2'(Na/Ar,Parm,Data, M) :-
+	functor(P, Na, Ar),
+	'$profile_info'(M, P, Stats),
+	'$profile_say'(Stats, Parm, Data).
+
+'$profile_data_for_var'(Name/Arity, Parm, Data, M) :-
+	functor(P,Name,Arity),
+	'$current_predicate'(Name,M,P,_),
+	\+ '$hidden'(Name), % don't show hidden predicates.
+	'$profile_info'(M, P, Stats),
+	'$profile_say'(Stats, Parm, Data).
+
+'$profile_say'('$profile'(Entries, _, _), calls, Entries).
+'$profile_say'('$profile'(_, _, Backtracks), retries, Backtracks).
+
+profile_reset :-
+	current_module(M),
+	'$current_predicate'(_Na,M,P,_),
+	'$profile_reset'(M, P),
+	fail.
+profile_reset.
+
+/** @pred  showprofres 
+
+
+Show profiling info.
+
+ 
+*/
+showprofres :-
+	showprofres(-1).
+
+/** @pred  showprofres( _N_)
+
+Show profiling info for the top-most  _N_ predicates.
+
+
+
+The showprofres/0 and `showprofres/1` predicates call a user-defined multifile hook predicate, `user:prolog_predicate_name/2`, that can be used for converting a possibly explicitly-qualified callable term into an atom that will used when printing the profiling information.
+
+
+ */
+showprofres(A) :-
+	'$offline_showprofres',
+	('$profison' -> profoff, Stop = true ; Stop = false),
+	'$profglobs'(Tot,GCs,HGrows,SGrows,Mallocs,_Indexing,ProfOns),
+	% root node has no useful info.
+	'$get_all_profinfo'(0,[],ProfInfo0,0,_TotCode),
+	msort(ProfInfo0,ProfInfo),
+	'$get_ppreds'(ProfInfo,Preds0),
+	'$add_extras_prof'(GCs, HGrows, SGrows, Mallocs, Preds0, PredsI),
+	keysort(PredsI,Preds),
+	'$sum_alls'(Preds,0,Tot0),
+	Accounted is -Tot0,
+	(ProfOns == 0 ->
+	    format(user_error,'~d ticks, ~d accounted for~n',[Tot,Accounted])
+	;
+	    format(user_error,'~d ticks, ~d accounted for (~d overhead)~n',[Tot,Accounted,ProfOns])
+	),
+%	format(user_error,'     ~d ticks in indexing code~n',[Indexing]),
+	A1 is A+1,
+	'$display_preds'(Preds, Tot, 0, 1, A1),
+	 (Stop = true -> profon ; true).
+
+/*
+'$check_duplicates'([]).
+'$check_duplicates'([A,A|ProfInfo]) :- !,
+	write(A),nl,
+	'$check_duplicates'(ProfInfo).
+'$check_duplicates'([_|ProfInfo]) :-
+	'$check_duplicates'(ProfInfo).
+*/
+
+
+'$get_all_profinfo'([],L,L,Tot,Tot) :- !.
+'$get_all_profinfo'(Node,L0,Lf,Tot0,Totf) :-
+	'$profnode'(Node,Clause,PredId,Count,Left,Right),
+	Tot1 is Tot0+Count,
+	'$get_all_profinfo'(Left,L0,Li,Tot1,Tot2),
+	'$get_all_profinfo'(Right,[gprof(PredId,Clause,Count)|Li],Lf,Tot2,Totf).
+
+'$get_ppreds'([],[]).
+'$get_ppreds'([gprof(0,_,0)|Cls],Ps) :- !,
+	'$get_ppreds'(Cls,Ps).
+'$get_ppreds'([gprof(0,_,Count)|_],_) :- !,
+	'$do_error'('SYSTEM_ERROR_INTERNAL',showprofres(gprof(0,_,Count))).
+'$get_ppreds'([gprof(PProfInfo,_,Count0)|Cls],[Sum-(Mod:Name/Arity)|Ps]) :-
+	'$get_more_ppreds'(Cls,PProfInfo,Count0,NCls,Sum),
+	'$get_pred_pinfo'(PProfInfo,Mod,Name,Arity),
+	'$get_ppreds'(NCls,Ps).
+
+'$get_more_ppreds'([gprof(PProfInfo,_,Count)|Cls],PProfInfo,Count0,NCls,Sum)
+:- !,
+	Count1 is Count+Count0,
+	'$get_more_ppreds'(Cls,PProfInfo,Count1,NCls,Sum).
+'$get_more_ppreds'(Cls, _, Sum, Cls, NSum) :- NSum is -Sum.
+
+'$display_preds'(_, _, _, N, N) :- !.
+'$display_preds'([], _, _, _, _).
+'$display_preds'([0-_|_], _Tot, _SoFar, _I, _N) :- !.
+'$display_preds'([NSum-P|Ps], Tot, SoFar, I, N) :-
+	Sum is -NSum,
+	Perc is (100*Sum)/Tot,
+	Next is SoFar+Sum,
+	NextP is (100*Next)/Tot,
+	(	(	P = M:F/A ->
+			G = M:H
+		;	P = F/A,
+			G = H
+		),
+		functor(H, F, A),
+		user:prolog_predicate_name(G, PL) ->
+		true
+	;	PL = P
+	),
+	format(user_error,'~|~t~d.~7+ ~|~w:~t~d~50+ (~|~t~2f~6+%)  |~|~t~2f~6+%|~n',[I,PL,Sum,Perc,NextP]),
+	I1 is I+1,
+	'$display_preds'(Ps,Tot,Next,I1, N).
+
+'$sum_alls'([],Tot,Tot).
+'$sum_alls'([C-_|Preds],Tot0,Tot) :-
+	TotI is C+Tot0,
+	'$sum_alls'(Preds,TotI,Tot).
+
+
+'$add_extras_prof'(GCs, HGrows, SGrows, Mallocs, Preds0, PredsI) :-
+	'$add_extra_prof'(GCs, 'Garbage Collections',Preds0,Preds1),
+	'$add_extra_prof'(HGrows, 'Code Expansion',Preds1,Preds2),
+	'$add_extra_prof'(SGrows, 'Stack Expansion',Preds2,Preds3),
+	'$add_extra_prof'(Mallocs, 'Heap Allocation',Preds3,PredsI).
+
+'$add_extra_prof'(0, _,Preds, Preds) :- !.
+'$add_extra_prof'(Ticks, Name, Preds, [NTicks-Name|Preds]) :-
+	NTicks is -Ticks.
+
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/protect.yap

@@ -0,0 +1,79 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		protect.yap						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	protecting the system functions				 *
+*									 *
+*************************************************************************/
+
+:- system_module( '$_protect', [], ['$protect'/0]).
+/**
+ * @file protect.yap
+ * @addgroup ProtectCore Freeze System Configuration
+ * @ingroup CoreUtilities
+ *
+ * This protects current code from further changes
+ *  and also makes it impossible for some predicates to be seen
+ * in user-space.
+ *
+ * Algorithm:
+ *  - fix system modules
+ *  - fix system predicates
+ *  - hide atoms with `$`
+ */
+ 
+
+'$protect' :-
+    '$all_current_modules'(M),
+    ( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ),
+    new_system_module( M ),    
+    fail.
+'$protect' :-
+	'$current_predicate'(Name,M,P,_),
+    '$is_system_module'(M),
+    functor(P,Name,Arity),
+    '$new_system_predicate'(Name,Arity,M),
+    sub_atom(Name,0,1,_, '$'),
+    functor(P,Name,Arity),
+    '$hide_predicate'(P,M),
+    fail.
+'$protect' :-
+    current_atom(Name),
+    sub_atom(Name,0,1,_, '$'),
+    \+ '$visible'(Name),
+    hide_atom(Name),
+    fail.
+'$protect'.
+
+
+% hide all atoms who start by '$'
+'$visible'('$').			/* not $VAR */
+'$visible'('$VAR').			/* not $VAR */
+'$visible'('$dbref').			/* not stream position */
+'$visible'('$stream').			/* not $STREAM */
+'$visible'('$stream_position').		/* not stream position */
+'$visible'('$hacks').
+'$visible'('$source_location').
+'$visible'('$messages').
+'$visible'('$push_input_context').
+'$visible'('$pop_input_context').
+'$visible'('$set_source_module').
+'$visible'('$declare_module').
+'$visible'('$store_clause').
+'$visible'('$skip_list').
+'$visible'('$win_insert_menu_item').
+'$visible'('$set_predicate_attribute').
+'$visible'('$parse_quasi_quotations').
+'$visible'('$quasi_quotation').
+'$visible'('$qq_open').
+'$visible'('$live').
+'$visible'('$init_prolog').

packages/python/swig/yap4py/prolog/pl/qly.yap

@@ -0,0 +1,796 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2011	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		qly.yap							 *
+* Last rev:								 *
+* mods:									 *
+* comments:	fast save/restore					 *
+*									 *
+*************************************************************************/
+
+%% @file qly.yap
+
+/**
+@defgroup QLY Creating and Using a saved state
+@ingroup YAPConsulting
+@{
+*/
+
+:- system_module( '$_qly', [qload_module/1,
+        qsave_file/1,
+        qsave_module/1,
+        qsave_program/1,
+        qsave_program/2,
+        restore/1,
+        save_program/1,
+        save_program/2], ['$init_state'/0]).
+
+:- use_system_module( '$_absf', ['$system_library_directories'/2]).
+
+:- use_system_module( '$_boot', ['$system_catch'/4]).
+
+:- use_system_module( '$_consult', ['$do_startup_reconsult'/1]).
+
+:- use_system_module( '$_control', ['$run_atom_goal'/1]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+:- use_system_module( '$_preds', ['$init_preds'/0]).
+
+:- use_system_module( '$_protect', ['$protect'/0]).
+
+:- use_system_module( '$_threads', ['$reinit_thread0'/0]).
+
+:- use_system_module( '$_yio', ['$extend_file_search_path'/1]).
+
+/**
+YAP can save and read images of its current state to files, known as
+saved states. It is possible to save the entire state or just a module
+or a file. Notice that saved states in YAP depend on the architecture
+where they were made, and may also depend on the version of YAP being
+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_)
+Saves the current state of the data-base in file _F_ .
+
+The result is a resource archive containing a saved state that
+expresses all Prolog data from the running program and all
+user-defined resources. Depending on the stand_alone option, the
+resource is headed by the emulator, a Unix shell script or nothing.
+
+**/
+save_program(File) :-
+	qsave_program(File).
+
+/** @pred save_program(+ _F_, : _G_)
+
+Saves an image of the current state of the YAP database in file
+ _F_, and guarantee that execution of the restored code will start by
+trying goal  _G_.
+**/
+qsave_program(File) :-
+	'$save_program_status'([], qsave_program(File)),
+	open(File, write, S, [type(binary)]),
+	'$qsave_program'(S),
+	close(S).
+
+/** @pred qsave_program(+ _F_, Opts)
+
+Saves an image of the current state of the YAP database in file
+ _F_, currently the options in _Opts_ are ignored:
+
+   + stack(+ _KBytes_)
+     Limit for the local and global stack.
+
+   + trail(+ _KBytes_)
+     Limit for the trail stack.
+
+   + goal(: _Callable_)
+     Initialization goal for the new executable (see `-g`).
+
+   + init_file(+ _Atom_)
+     Default initialization file for the new executable. See `-f`.
+
+*/
+qsave_program(File, Opts) :-
+	'$save_program_status'(Opts, qsave_program(File,Opts)),
+	open(File, write, S, [type(binary)]),
+	'$qsave_program'(S),
+	% make sure we're not going to bootstrap from this file.
+	close(S).
+
+/** @pred save_program(+ _F_, : _G_)
+
+Saves an image of the current state of the YAP database in file
+ _F_, and guarantee that execution of the restored code will start by
+trying goal  _G_.
+**/
+save_program(_File, Goal) :-
+	recorda('$restore_goal', Goal ,_R),
+	fail.
+save_program(File, _Goal) :-
+        qsave_program(File).
+
+/** @pred qend_program
+
+  Saves an image of the current state of the YAP database in default
+  filee, usually `startup.yss`.
+  **/
+qend_program :-
+	module(user),
+	qsave_program('startup.yss'),
+	halt(0).
+
+'$save_program_status'(Flags, G) :-
+    findall(F-V, '$x_yap_flag'(F,V),L),
+    recordz('$program_state',L,_),
+    '$cvt_qsave_flags'(Flags, G),
+    fail.
+'$save_program_status'(_Flags, _G).
+
+'$cvt_qsave_flags'(Flags, G) :-
+    nonvar(Flags),
+    strip_module(Flags, M, LFlags),
+    '$skip_list'(_Len, LFlags, []),
+    '$cvt_qsave_lflags'(LFlags, G, M).
+'$cvt_qsave_flags'(Flags, G,_OFlags) :-
+    var(Flags),
+    '$do_error'(instantiation_error,G).
+'$cvt_qsave_flags'(Flags, G,_OFlags) :-
+    '$do_error'(type_error(list,Flags),G).
+
+'$cvt_qsave_lflags'([], _, _).
+'$cvt_qsave_lflags'([Flag|Flags], G, M) :-
+    '$cvt_qsave_flag'(Flag, G, M),
+    '$cvt_qsave_lflags'(Flags, G, M).
+
+'$cvt_qsave_flag'(Flag, G, _) :-
+    var(Flag), !,
+    '$do_error'(instantiation_error,G).
+'$cvt_qsave_flag'(local(B), G, _) :- !,
+    ( number(B) ->
+      (
+       B > 0 -> recordz('$restore_flag',local(B),_) ;
+       B =:= 0 -> true ;
+       '$do_error'(domain_error(not_less_than_zero,B),G))
+    ;
+      '$do_error'(type_error(integer,B),G)
+      ).
+'$cvt_qsave_flag'(global(B), G, _) :- !,
+    ( number(B) ->
+      (
+       B > 0 -> recordz('$restore_flag',global(B),_) ;
+       B =:= 0 -> true ;
+       '$do_error'(domain_error(not_less_than_zero,B),G))
+    ;
+      '$do_error'(type_error(integer,B),G)
+    ).
+'$cvt_qsave_flag'(stack(B), G, _) :- !,
+    ( number(B) ->
+      (
+       B > 0 -> recordz('$restore_flag',stack(B),_) ;
+       B =:= 0 -> true ;
+       '$do_error'(domain_error(not_less_than_zero,B),G))
+    ;
+      '$do_error'(type_error(integer,B),G)
+    ).
+'$cvt_qsave_flag'(trail(B), G, _) :- !,
+    ( number(B) ->
+      (
+       B > 0 -> recordz('$restore_flag',trail(B),_) ;
+       B =:= 0 -> true ;
+       '$do_error'(domain_error(not_less_than_zero,B),G))
+    ;
+      '$do_error'(type_error(integer,B),G)
+    ).
+'$cvt_qsave_flag'(goal(B), G, M) :- !,
+    ( callable(B) ->
+      strip_module(M:B, M1, G1),
+      recordz('$restore_flag',goal(M1:G1),_)
+    ;
+       strip_module(M:B, M1, G1),
+     '$do_error'(type_error(callable,G1),G)
+    ).
+'$cvt_qsave_flag'(toplevel(B), G, M) :- !,
+    ( callable(B) ->
+      strip_module(M:B, M1, G1),
+      recordz('$restore_flag',toplevel(M1:G1),_)
+    ;
+       strip_module(M:B, M1, G1),
+     '$do_error'(type_error(callable,G1),G)
+    ).
+'$cvt_qsave_flag'(init_file(B), G, M) :- !,
+    ( atom(B) ->
+      recordz('$restore_flag', init_file(M:B), _)
+    ;
+      '$do_error'(type_error(atom,B),G)
+    ).
+%% '$cvt_qsave_flag'(autoload(_B), G, autoload(_B)).
+%% '$cvt_qsave_flag'(op(_B), G, op(_B)).
+%% '$cvt_qsave_flag'(stand_alone(_B), G, stand_alone(_B)).
+%% '$cvt_qsave_flag'(emulator(_B), G, emulator(_B)).
+%% '$cvt_qsave_flag'(foreign(_B), G, foreign(_B)).
+'$cvt_qsave_flag'(Opt, G, _M) :-
+    '$do_error'(domain_error(qsave_program,Opt), G).
+
+% there is some ordering between flags.
+'$x_yap_flag'(language, V) :-
+	yap_flag(language, V).
+'$x_yap_flag'(M:P, V) :-
+	current_module(M),
+	yap_flag(M:P, V).
+'$x_yap_flag'(X, V) :-
+	prolog_flag_property(X, [access(read_write)]),
+	atom(X),
+	yap_flag(X, V),
+	X \= gc_margin, % different machines will have different needs,
+	X \= argv,
+	X \= os_argv,
+	X \= language,
+    X \= encoding.
+
+'$init_state' :-
+	(
+	    recorded('$program_state', _P, R)
+	 ->
+	     erase(R),
+	     '$do_init_state'
+	 ;
+	 true
+	).
+
+'$do_init_state' :-
+  '$undefp_handler'('$undefp'(_,_), prolog),
+  fail.
+'$do_init_state' :-
+	set_value('$user_module',user),
+	'$protect',
+	fail.
+'$do_init_state' :-
+	compile_expressions,
+	 '$init_preds',
+	 fail.
+'$do_init_state' :-
+	recorded('$program_state',L,R),
+	erase(R),
+	lists:member(F-V,L),
+	catch(yap_flag(F,V),Error,user:'$Error'(Error)),
+	fail.
+'$do_init_state' :-
+	'$reinit_thread0',
+	 fail.
+'$do_init_state' :-
+	'$current_module'(prolog),
+	module(user),
+	fail.
+'$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'.
+
+%
+% first, recover what we need from the saved state...
+%'
+'$init_from_saved_state_and_args' :-
+	'$init_path_extensions',
+	fail.
+% use if we come from a save_program and we have SWI's shlib
+'$init_from_saved_state_and_args' :-
+	current_prolog_flag(hwnd, _HWND),
+	load_files(library(win_menu), [silent(true)]),
+	fail.
+'$init_from_saved_state_and_args' :-
+	recorded('$reload_foreign_libraries',_G,R),
+	erase(R),
+	shlib:reload_foreign_libraries,
+	fail.
+% this should be done before -l kicks in.
+'$init_from_saved_state_and_args' :-
+	current_prolog_flag(fast_boot, false),
+	  ( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
+	  ( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
+	  ( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ),
+	  fail.
+% use if we come from a save_program and we have a goal to execute
+'$init_from_saved_state_and_args' :-
+	get_value('$consult_on_boot',X), X \= [],
+	set_value('$consult_on_boot',[]),
+	'$do_startup_reconsult'(X),
+	fail.
+'$init_from_saved_state_and_args' :-
+	recorded('$restore_flag', init_file(M:B), R),
+	erase(R),
+	'$do_startup_reconsult'(M:B),
+	fail.
+'$init_from_saved_state_and_args' :-
+	recorded('$restore_flag', unknown(M:B), R),
+	erase(R),
+	yap_flag(M:unknown,B),
+	fail.
+'$init_from_saved_state_and_args' :-
+	'$startup_goals',
+	fail.
+'$init_from_saved_state_and_args' :-
+	recorded('$restore_goal',G,R),
+	erase(R),
+	prompt(_,'| '),
+	catch(once(user:G),Error,user:'$Error'(Error)),
+	fail.
+'$init_from_saved_state_and_args'.
+
+'$init_path_extensions' :-
+	get_value('$extend_file_search_path',P), !,
+	P \= [],
+	set_value('$extend_file_search_path',[]),
+	'$extend_file_search_path'(P).
+'$init_path_extensions'.
+
+% then we can execute the programs.
+'$startup_goals' :-
+    module(user),
+    fail.
+'$startup_goals' :-
+    recorded('$startup_goal',G,_),
+    catch(once(user:G),Error,user:'$Error'(Error)),
+    fail.
+'$startup_goals' :-
+	get_value('$init_goal',GA),
+	GA \= [],
+	set_value('$init_goal',[]),
+	'$run_atom_goal'(GA),
+	fail.
+'$startup_goals' :-
+    recorded('$restore_flag', goal(Module:GA), R),
+    erase(R),
+    catch(once(Module:GA),Error,user:'$Error'(Error)),
+    fail.
+'$startup_goals' :-
+	get_value('$myddas_goal',GA), GA \= [],
+	set_value('$myddas_goal',[]),
+	get_value('$myddas_user',User), User \= [],
+	set_value('$myddas_user',[]),
+	get_value('$myddas_db',Db), Db \= [],
+	set_value('$myddas_db',[]),
+	get_value('$myddas_host',HostT),
+	( HostT \= [] ->
+	  Host = HostT,
+	  set_value('$myddas_host',[])
+	;
+	  Host = localhost
+	),
+	get_value('$myddas_pass',PassT),
+	( PassT \= [] ->
+	  Pass = PassT,
+	  set_value('$myddas_pass',[])
+	;
+	  Pass = ''
+	),
+	use_module(library(myddas)),
+	call(db_open(mysql,myddas,Host/Db,User,Pass)),
+	'$myddas_import_all',
+	fail.
+'$startup_goals'.
+
+ %
+ % MYDDAS: Import all the tables from one database
+ %
+
+ '$myddas_import_all':-
+	 call(db_my_show_tables(myddas,table(Table))),
+	 call(db_import(myddas,Table,Table)),
+	 fail.
+ '$myddas_import_all'.
+
+qsave_file(F0) :-
+    ensure_loaded(  F0 ),
+    absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
+    absolute_file_name( F0, State, [expand(true),file_type(qly)]),
+    '$qsave_file_'(File, State).
+
+/** @pred qsave_file(+ _File_, +_State_)
+
+Saves an image of all the information compiled by the system from file _F_ to _State_.
+This includes modules and predicates eventually including multi-predicates.
+**/
+qsave_file(F0, State) :-
+    ensure_loaded(  F0 ),
+    absolute_file_name( F0, File, [expand(true),file_type(prolog),access(read),file_errors(fail),solutions(first)]),
+    '$qsave_file_'(File, State).
+
+'$qsave_file_'(File, UserF, _State) :-
+    ( File == user_input -> Age = 0 ; time_file64(File, Age) ),
+    '$current_module'(M),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, Age, M) ) ),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
+    fail.
+'$qsave_file_'(File, UserF, _State) :-
+    recorded('$lf_loaded','$lf_loaded'( File, M, Reconsult, UserFile, OldF, Line, Opts), _),
+    assert(user:'$file_property'( '$lf_loaded'( UserF, M, Reconsult, UserFile, OldF, Line, Opts) ) ),
+    '$set_owner_file'( '$file_property'( _ ), user, File ),
+    fail.
+'$qsave_file_'(File, _UserF, _State) :-
+    recorded('$directive',directive( File, M:G, Mode,  VL, Pos ), _),
+    assert(user:'$file_property'( directive( M:G, Mode,  VL, Pos ) ) ),
+    '$set_owner_file'('$file_property'( _ ), user, File ),
+    fail.
+'$qsave_file_'(File, _UserF, _State) :-
+    '$fetch_multi_files_file'(File, MultiFiles),
+    assert(user:'$file_property'( multifile(MultiFiles  ) ) ),
+    '$set_owner_file'('$file_property'( _ ), user, File ),
+    fail.
+'$qsave_file_'( File, _UserF, State ) :-
+    (
+	is_stream( State )
+    ->
+	'$qsave_file_preds'(State, File)
+	;
+	open(State, write, S, [type(binary)]),
+        '$qsave_file_preds'(S, File),
+        close(S)
+    ),
+    abolish(user:'$file_property'/1).
+
+'$fetch_multi_files_file'(File, Multi_Files) :-
+	setof(Info, '$fetch_multi_file_module'(File, Info), Multi_Files).
+
+'$fetch_multi_file_file'(FileName, (M:G :- Body)) :-
+	recorded('$multifile_defs','$defined'(FileName,Name,Arity,M), _),
+	functor(G, Name, Arity ),
+        clause(M:G, Body, ClauseRef),
+	clause_property(ClauseRef, file(FileName) ).
+
+
+/** @pred qsave_module(+ _Module_, +_State_)
+Saves an image of all the information compiled by the systemm on module _F_ to _State_.
+**/
+
+qsave_module(Mod, OF) :-
+	recorded('$module', '$module'(_F,Mod,Source,Exps,L), _),
+	'$fetch_parents_module'(Mod, Parents),
+	'$fetch_imports_module'(Mod, Imps),
+	'$fetch_multi_files_module'(Mod, MFs),
+	'$fetch_meta_predicates_module'(Mod, Metas),
+	'$fetch_module_transparents_module'(Mod, ModTransps),
+	'$fetch_term_expansions_module'(Mod, TEs),
+	'$fetch_foreigns_module'(Mod, Foreigns),
+	asserta(Mod:'@mod_info'(Source, Exps, MFs, L, Parents, Imps, Metas, ModTransps, Foreigns, TEs)),
+	open(OF, write, S, [type(binary)]),
+	'$qsave_module_preds'(S, Mod),
+	close(S),
+	abolish(Mod:'@mod_info'/10),
+	fail.
+qsave_module(_, _).
+
+/** @pred qsave_module(+ Module x)
+
+Saves an image of all the information compiled by the systemm on
+module _F_ to a file _State.qly_ in the current directory.
+
+**/
+
+qsave_module(Mod) :-
+	atom_concat(Mod,'.qly',OF),
+	qsave_module(Mod, OF).
+
+/**
+  @pred restore(+ _F_)
+Restores a previously saved state of YAP from file  _F_.
+
+*/
+restore(File) :-
+	open(File, read, S, [type(binary)]),
+	'$qload_program'(S),
+	close(S).
+
+/**
+@pred qload_module(+ _M_)
+
+Restores a previously save image of module  _M_. This built-in searches
+for a file M.qly or M according to the rules for qly files.
+
+The q_load_module/1 built-in tries to reload any modules it imports
+from and any foreign files that had been loaded with the original
+module. It tries first reloading from qly images, but if they are not
+available it tries reconsulting the source file.
+
+*/
+qload_module(Mod) :-
+    ( current_prolog_flag(verbose_load, false)
+      ->
+	Verbosity = silent
+	;
+	Verbosity = informational
+    ),
+    StartMsg = loading_module,
+    EndMsg = module_loaded,
+    '$current_module'(SourceModule, Mod),
+    H0 is heapused, '$cputime'(T0,_),
+    absolute_file_name( Mod, File, [expand(true),file_type(qly)]),
+    print_message(Verbosity, loading(StartMsg, File)),
+    file_directory_name( File, Dir),
+    working_directory(OldD, Dir),
+    '$qload_module'(Mod, File, SourceModule ),
+    H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
+    print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
+    '$current_module'(_, SourceModule),
+    working_directory(_, OldD).
+
+'$qload_module'(Mod, S, SourceModule) :-
+    is_stream( S ), !,
+    '$q_header'( S, Type ),
+    stream_property( S, file_name( File )),
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	  '$qload_file'(S, File)
+    ).
+'$qload_module'(Mod, File, SourceModule) :-
+    open(File, read, S, [type(binary)]),
+    %check verifies if a saved state;
+    '$q_header'( S, Type ), !,
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	  '$qload_file'(S, File)
+    ),
+    !,
+    close(S).
+
+'$qload_module'(_S, Mod, _File, _SourceModule) :-
+    unload_module( Mod ), fail.
+'$qload_module'(S, _Mod, _File, _SourceModule) :-
+	'$qload_module_preds'(S), fail.
+
+'$qload_module'(_S, Mod, File, SourceModule) :-
+    Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs),
+    abolish(Mod:'@mod_info'/10),
+    recorda('$module', '$module'(File, Mod, F, Exps, Line), _),
+    '$install_parents_module'(Mod, Parents),
+    '$install_imports_module'(Mod, Imps, []),
+    '$install_multi_files_module'(Mod, MFs),
+    '$install_meta_predicates_module'(Mod, Metas),
+    '$install_foreigns_module'(Mod, Foreigns),
+    '$install_module_transparents_module'(Mod, ModTransps),
+    '$install_term_expansions_module'(Mod, TEs),
+    % last, export everything to the host: if the loading crashed you didn't actually do
+    % no evil.
+    '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module),
+    '$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now
+
+'$fetch_imports_module'(Mod, Imports) :-
+	findall(Info, '$fetch_import_module'(Mod, Info), Imports).
+
+% detect an import that is local to the module.
+'$fetch_import_module'(Mod, '$impcort'(Mod0,Mod,G0,G,N,K) - S) :-
+	recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _),
+	( recorded('$module','$module'(_, Mod0, S, _, _), _) -> true ; S = user_input ).
+
+'$fetch_parents_module'(Mod, Parents) :-
+	findall(Parent, prolog:'$parent_module'(Mod,Parent), Parents).
+
+'$fetch_module_transparents_module'(Mod, Module_Transparents) :-
+	findall(Info, '$fetch_module_transparent_module'(Mod, Info), Module_Transparents).
+
+% detect an module_transparenterator that is local to the module.
+'$fetch_module_transparent_module'(Mod, '$module_transparent'(F,Mod,N,P)) :-
+	prolog:'$module_transparent'(F,Mod0,N,P), Mod0 == Mod.
+
+'$fetch_meta_predicates_module'(Mod, Meta_Predicates) :-
+	findall(Info, '$fetch_meta_predicate_module'(Mod, Info), Meta_Predicates).
+
+% detect a meta_predicate that is local to the module.
+'$fetch_meta_predicate_module'(Mod, '$meta_predicate'(F,Mod,N,P)) :-
+	prolog:'$meta_predicate'(F,M,N,P), M==Mod.
+
+'$fetch_multi_files_module'(Mod, Multi_Files) :-
+	findall(Info, '$fetch_multi_file_module'(Mod, Info), Multi_Files).
+
+% detect an multi_file that is local to the module.
+'$fetch_multi_file_module'(Mod, '$defined'(FileName,Name,Arity,Mod)) :-
+	recorded('$multifile_defs','$defined'(FileName,Name,Arity,Mod), _).
+'$fetch_multi_file_module'(Mod, '$mf_clause'(FileName,_Name,_Arity,Mod,Clause), _) :-
+    recorded('$mf','$mf_clause'(FileName,_Name,_Arity,Mod,ClauseRef), _),
+    instance(ClauseRef, Clause ).
+
+'$fetch_term_expansions_module'(Mod, TEs) :-
+	findall(Info, '$fetch_term_expansion_module'(Mod, Info), TEs).
+
+% detect an term_expansionerator that is local to the module.
+'$fetch_term_expansion_module'(Mod, ( user:term_expansion(G, GI) :- Bd )) :-
+	clause( user:term_expansion(G, GI), Bd, _),
+	strip_module(G, Mod, _).
+% detect an term_expansionerator that is local to the module.
+'$fetch_term_expansion_module'(Mod, ( system:term_expansion(G, GI) :- Bd )) :-
+	clause( system:term_expansion(G, GI), Bd, _),
+	strip_module(G, Mod, _).
+% detect an term_expansionerator that is local to the module.
+'$fetch_term_expansion_module'(Mod, ( user:goal_expansion(G, CurMod, GI) :- Bd )) :-
+	clause( user:goal_expansion(G, CurMod, GI), Bd, _),
+	Mod == CurMod.
+% detect an term_expansionerator that is local to the module.
+'$fetch_term_expansion_module'(Mod, ( user:goal_expansion(G, GI) :- Bd )) :-
+	clause( user:goal_expansion(G, GI), Bd, _),
+	strip_module(G, Mod, _).
+% detect an term_expansionerator that is local to the module.
+'$fetch_term_expansion_module'(Mod, ( system:goal_expansion(G, GI) :- Bd )) :-
+	clause( system:goal_expansion(G, GI), Bd, _),
+	strip_module(G, Mod, _).
+
+'$fetch_foreigns_module'(Mod, Foreigns) :-
+	findall(Info, '$fetch_foreign_module'(Mod, Info), Foreigns).
+
+% detect an term_expansionerator that is local to the module.
+'$fetch_foreign_module'(Mod,Foreign) :-
+	recorded( '$foreign', Mod:Foreign, _).
+
+'$install_term_expansions_module'(_, []).
+'$install_term_expansions_module'(Mod, [TE|TEs]) :-
+    assert(TE),
+    '$install_term_expansions_module'(Mod, TEs).
+
+'$install_imports_module'(_, [], Fs0) :-
+    sort(Fs0, Fs),
+    '$restore_load_files'(Fs).
+'$install_imports_module'(Mod, [Import-F|Imports], Fs0) :-
+	recordz('$import', Import, _),
+	arg(1, Import, M),
+	'$install_imports_module'(Mod, Imports, [M-F|Fs0]).
+
+'$restore_load_files'([]).
+'$restore_load_files'([M-F0|Fs]) :-
+    (
+	absolute_file_name( M,_File, [expand(true),file_type(qly),access(read),file_errors(fail)])
+    ->
+        qload_module(M)
+    ;
+	use_module(M, F0, _)
+    ),
+    '$restore_load_files'(Fs).
+
+'$install_parents_module'(_, []).
+'$install_parents_module'(Mod, [Parent|Parents]) :-
+	assert(prolog:Parent),
+	'$install_parents_module'(Mod, Parents).
+
+'$install_module_transparents_module'(_, []).
+'$install_module_transparents_module'(Mod, [Module_Transparent|Module_Transparents]) :-
+	assert(prolog:Module_Transparent),
+	'$install_module_transparents_module'(Mod, Module_Transparents).
+
+'$install_meta_predicates_module'(_, []).
+'$install_meta_predicates_module'(Mod, [Meta_Predicate|Meta_Predicates]) :-
+	assert(prolog:Meta_Predicate),
+	'$install_meta_predicates_module'(Mod, Meta_Predicates).
+
+'$install_multi_files_module'(_, []).
+'$install_multi_files_module'(Mod, [Multi_File|Multi_Files]) :-
+	recordz('$multifile_defs',Multi_File, _),
+	'$install_multi_files_module'(Mod, Multi_Files).
+
+'$install_foreigns_module'(_, []).
+'$install_foreigns_module'(Mod, [Foreign|Foreigns]) :-
+	'$do_foreign'(Foreign, Foreigns),
+	'$install_foreigns_module'(Mod, Foreigns).
+
+'$do_foreign'('$foreign'(Objs,Libs,Entry), _) :-
+    load_foreign_files(Objs,Libs,Entry).
+'$do_foreign'('$swi_foreign'(File, Opts, Handle), More) :-
+    open_shared_object(File, Opts, Handle, NewHandle),
+    '$init_foreigns'(More, NewHandle).
+'$do_foreign'('$swi_foreign'(_,_), _More).
+
+'$init_foreigns'([], _Handle, _NewHandle).
+'$init_foreigns'(['$swi_foreign'( Handle, Function )|More], Handle, NewHandle) :-
+    !,
+    call_shared_object_function( NewHandle, Function),
+    '$init_foreigns'(More, Handle, NewHandle).
+'$init_foreigns'([_|More], Handle, NewHandle) :-
+    '$init_foreigns'(More, Handle, NewHandle).
+
+/**
+@pred qload_file(+ _F_)
+
+Restores a previously saved state of YAP contaianing a qly file  _F_.
+
+*/
+qload_file( F0 ) :-
+    ( current_prolog_flag(verbose_load, false)
+      ->
+	Verbosity = silent
+	;
+	Verbosity = informational
+    ),
+    StartMsg = loading_module,
+    EndMsg = module_loaded,
+    '$current_module'( SourceModule ),
+    H0 is heapused,
+    '$cputime'(T0,_),
+    ( is_stream( F0 )
+      ->
+      stream_property(F0, file_name(File) ),
+      File = FilePl,
+      S = File
+    ;
+      absolute_file_name( F0, File, [expand(true),file_type(qly)]),
+      absolute_file_name( F0, FilePl, [expand(true),file_type(prolog)]),
+      unload_file( FilePl ),
+      open(File, read, S, [type(binary)])
+    ),
+    print_message(Verbosity, loading(StartMsg, File)),
+    file_directory_name(File, DirName),
+    working_directory(OldD, DirName),
+    '$q_header'( S, Type ),
+    ( Type == module ->
+	  '$qload_module'(S , Mod, File, SourceModule)
+    ;
+      Type == file ->
+	'$lf_option'(last_opt, LastOpt),
+	functor( TOpts, opt, LastOpt ),
+	'$lf_default_opts'(1, LastOpt, TOpts),
+	  '$qload_file'(S, SourceModule, File, FilePl, F0, all, TOpts)
+    ),
+    close(S),
+    working_directory( _, OldD),
+    H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
+    '$current_module'(Mod, Mod ),
+    print_message(Verbosity, loaded(EndMsg, File, Mod, T, H)),
+    '$exec_initialization_goals'.
+
+'$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :-
+    recorded('$source_file','$source_file'( FilePl, _Age, SourceModule), _),
+   !.
+'$qload_file'(_S, SourceModule, _F, FilePl, _F0, _ImportList, _TOpts) :-
+    ( FilePl == user_input -> Age = 0 ; time_file64(FilePl, Age) ),
+    recordaifnot('$source_file','$source_file'( FilePl, Age, SourceModule), _),
+    fail.
+'$qload_file'(S, _SourceModule, _File, _FilePl, _F0, _ImportList, _TOpts) :-
+    '$qload_file_preds'(S),
+    fail.
+'$qload_file'(_S, SourceModule, F, _FilePl, _F0, _ImportList, _TOpts) :-
+    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) :-
+    b_setval('$user_source_file', F0 ),
+    '$ql_process_directives'( FilePl ),
+    fail.
+'$qload_file'(_S, SourceModule, _File,  FilePl, _F0, ImportList, TOpts) :-
+    '$import_to_current_module'(FilePl, SourceModule, ImportList, _, TOpts).
+
+'$ql_process_directives'( FilePl ) :-
+    user:'$file_property'( '$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts) ),
+    recorda('$lf_loaded','$lf_loaded'( FilePl, M, Reconsult, UserFile, OldF, Line, Opts), _),
+    fail.
+'$ql_process_directives'( _FilePl ) :-
+    user:'$file_property'( multifile( List ) ),
+    lists:member( Clause, List ),
+    assert( Clause ),
+    fail.
+'$ql_process_directives'( FilePl ) :-
+    user:'$file_property'( directive( MG, _Mode,  VL, Pos  ) ),
+    '$set_source'( FilePl, Pos ),
+    '$yap_strip_module'(MG, M, G),
+    '$process_directive'(G, reconsult, M, VL, Pos),
+    fail.
+'$ql_process_directives'( _FilePl ) :-
+    abolish(user:'$file_property'/1).
+
+%% @}

packages/python/swig/yap4py/prolog/pl/save.yap

@@ -0,0 +1,86 @@
+ /*************************************************************************
+ *									 *
+ *	 YAP Prolog 							 *
+ *									 *
+ *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+ *									 *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2010	 *
+ *									 *
+ **************************************************************************
+ *									 *
+ * File:		save.yap					 *
+ * Last rev:	11/29/10						 *
+ * mods:								 *
+ * comments:	Some utility predicates to support save/restore in yap	 *
+ *									 *
+ *************************************************************************/
+
+:- system_module( '$_save', [], []).
+
+%%% Saving and restoring a computation
+/*
+save(A) :- save(A,_).
+
+save(A,_) :- var(A), !,
+	'$do_error'(instantiation_error,save(A)).
+save(A,OUT) :- atom(A), !, atom_codes(A,S), '$save'(S,OUT).
+save(S,OUT) :- '$save'(S,OUT).
+
+save_program(A) :- var(A), !,
+	'$do_error'(instantiation_error,save_program(A)).
+save_program(A) :- atom(A), !, 
+	atom_codes(A,S),
+	'$save_program2'(S, true).
+save_program(S) :- '$save_program2'(S, true).
+
+save_program(A, G) :- var(A), !,
+	'$do_error'(instantiation_error, save_program(A,G)).
+save_program(A, G) :- var(G), !,
+	'$do_error'(instantiation_error, save_program(A,G)).
+save_program(A, G) :- \+ callable(G), !,
+	'$do_error'(type_error(callable,G), save_program(A,G)).
+save_program(A, G) :-
+	( atom(A) -> atom_codes(A,S) ; A = S),
+	'$save_program2'(S, G),
+	fail.
+save_program(_,_).
+
+'$save_program2'(S,G) :-
+	(
+	    G == true
+        ->
+	     true
+	 ;
+	     recorda('$restore_goal', G ,R)
+	),
+	(
+	    '$undefined'(reload_foreign_libraries, shlib)
+        ->
+	     true
+	 ;
+	     recorda('$reload_foreign_libraries', true, R1)
+	),
+	'$save_program'(S),
+	(
+	    var(R1)
+        ->
+	     true
+	 ;
+	     erase(R1)
+	),
+	(
+	    var(R)
+        ->
+	     true
+	 ;
+	     erase(R)
+	),
+	fail.
+'$save_program2'(_,_).
+
+restore(A) :- var(A), !,
+	'$do_error'(instantiation_error,restore(A)).
+restore(A) :- atom(A), !, name(A,S), '$restore'(S).
+restore(S) :- '$restore'(S).
+
+*/

packages/python/swig/yap4py/prolog/pl/setof.yap

@@ -0,0 +1,342 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 	%W% %G%
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		setof.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	set predicates						 *
+*									 *
+*************************************************************************/
+
+/**
+ * @file   setof.yap
+ * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
+ * @date   Thu Nov 19 10:45:32 2015
+ * 
+ * @brief  Setof and friends.
+ * 
+ * 
+*/
+
+
+:- system_module( '$_setof', [(^)/2,
+        all/3,
+        bagof/3,
+        findall/3,
+        findall/4,
+        setof/3], []).
+
+/**
+
+@defgroup Sets Collecting Solutions to a Goal
+@ingroup builtins
+
+When there are several solutions to a goal, if the user wants to collect all
+the solutions he may be led to use the data base, because backtracking will
+forget previous solutions.
+
+YAP allows the programmer to choose from several system
+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:
+
+@{
+
+
+
+*/
+
+:- use_system_module( '$_boot', ['$catch'/3]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+% 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).
+
+
+
+/** @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_.
+
+With the following program:
+
+~~~~~
+a(2,1).
+a(1,1).
+a(2,2).
+~~~~~
+the answer to the query
+
+~~~~~
+findall(X,a(X,Y),L).
+~~~~~
+would be:
+
+~~~~~
+X = _32
+Y = _33
+L = [2,1,2];
+no
+~~~~~
+
+
+*/
+
+findall(Template, Generator, Answers) :-
+     must_be_of_type( list_or_partial_list, Answers ),
+     '$findall'(Template, Generator, [], Answers).
+
+
+% If some answers have already been found
+/** @pred  findall( ?Key, +Goal, +InitialSolutions, -Solutions )
+
+Similar to findall/3, but appends all answers to list  _L0_.
+
+
+*/
+findall(Template, Generator, Answers, SoFar) :-
+     must_be_of_type( list_or_partial_list, Answers ),
+     '$findall'(Template, Generator, SoFar, Answers).
+
+% starts by calling the generator,
+% and recording the answers
+'$findall'(Template, Generator, SoFar, Answers) :-
+	nb:nb_queue(Ref),
+	(
+	  '$execute'(Generator),
+	  nb:nb_queue_enqueue(Ref, Template),
+	 fail
+	;
+	 nb:nb_queue_close(Ref, Answers, SoFar)
+	).
+
+
+% findall_with_key is very similar to findall, but uses the SICStus
+% algorithm to guarantee that variables will have the same names.
+%
+'$findall_with_common_vars'(Template, Generator, Answers) :-
+	nb:nb_queue(Ref),
+	(
+	  '$execute'(Generator),
+	  nb:nb_queue_enqueue(Ref, Template),
+	  fail
+	;
+	  nb:nb_queue_close(Ref, Answers, []),
+	  '$collect_with_common_vars'(Answers, _)
+	).
+
+
+'$collect_with_common_vars'([], _).
+'$collect_with_common_vars'([Key-_|Answers], VarList) :-
+	'$variables_in_term'(Key, _, VarList),
+	'$collect_with_common_vars'(Answers, VarList).
+
+% This is the setof predicate
+/** @pred  setof( _X_,+ _P_,- _B_) is iso
+
+
+Similar to `bagof( _T_, _G_, _L_)` but sorts list
+ _L_ and keeping only one copy of each element.  Again, assuming the
+same clauses as in the examples above, the reply to the query
+
+~~~~~
+setof(X,a(X,Y),L).
+~~~~~
+would be:
+
+~~~~~
+X = _32
+Y = 1
+L = [1,2];
+X = _32
+Y = 2
+L = [2];
+no
+~~~~~
+
+
+
+
+ */
+setof(Template, Generator, Set) :-
+    
+	( '$is_list_or_partial_list'(Set) ->
+		true
+	;
+		'$do_error'(type_error(list,Set), setof(Template, Generator, Set))
+	),
+	'$bagof'(Template, Generator, Bag),
+	'$sort'(Bag, Set).
+
+% And this is bagof
+
+% Either we have excess of variables
+% and we need to find the solutions for each instantiation
+% of these variables
+
+/** @pred  bagof( _T_,+ _G_,- _L_) is iso
+
+
+For each set of possible instances of the free variables occurring in
+ _G_ but not in  _T_, generates the list  _L_ of the instances of
+ _T_ satisfying  _G_. Again, assuming the same clauses as in the
+examples above, the reply to the query
+
+~~~~~
+bagof(X,a(X,Y),L).
+
+would be:
+X = _32
+Y = 1
+L = [2,1];
+X = _32
+Y = 2
+L = [2];
+no
+~~~~~
+
+
+*/
+
+bagof(Template, Generator, Bag) :-
+	( '$is_list_or_partial_list'(Bag) ->
+		true
+	;
+		'$do_error'(type_error(list,Bag), bagof(Template, Generator, Bag))
+	),
+	'$bagof'(Template, Generator, Bag).
+
+'$bagof'(Template, Generator, Bag) :-
+	'$free_variables_in_term'(Template^Generator, StrippedGenerator, Key),
+	%format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]),
+	( Key \== '$' ->
+		'$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0),
+		'$keysort'(Bags0, Bags),
+		'$pick'(Bags, Key, Bag)
+	;
+		'$findall'(Template, StrippedGenerator, [], Bag0),
+		Bag0 \== [],
+		Bag = Bag0
+	).
+
+
+% picks a solution attending to the free variables
+'$pick'([K-X|Bags], Key, Bag) :-
+	'$parade'(Bags, K, Bag1, Bags1),
+	'$decide'(Bags1, [X|Bag1], K, Key, Bag).
+
+'$parade'([K-X|L1], Key, [X|B], L) :- K == Key, !,
+	'$parade'(L1, Key, B, L).
+'$parade'(L, _, [], L).
+
+%
+% The first argument to decide gives if solutions still left;
+% The second gives the solution currently found;
+% The third gives the free variables that are supposed to be bound;
+% The fourth gives the free variables being currently used.
+% The fifth  outputs the current solution.
+%
+'$decide'([], Bag, Key0, Key, Bag) :- !,
+	Key0=Key.
+'$decide'(_, Bag, Key, Key, Bag).
+'$decide'(Bags, _, _, Key, Bag) :-
+	'$pick'(Bags, Key, Bag).
+
+% as an alternative to setof you can use the predicate all(Term,Goal,Solutions)
+% But this version of all does not allow for repeated answers
+% if you want them use findall
+/** @pred  all( _T_,+ _G_,- _L_)
+
+
+Similar to `findall( _T_, _G_, _L_)` but eliminate
+repeated elements. Thus, assuming the same clauses as in the above
+example, the reply to the query
+
+~~~~~
+all(X,a(X,Y),L).
+~~~~~
+would be:
+
+~~~~~
+X = _32
+Y = _33
+L = [2,1];
+no
+~~~~~
+
+Note that all/3 will fail if no answers are found.
+
+
+*/
+all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
+all(T,G,S) :-
+	'$init_db_queue'(Ref),
+	( catch(G, Error,'$clean_findall'(Ref,Error) ),
+	  '$execute'(G),
+	  '$db_enqueue'(Ref, T),
+	  fail
+        ;
+	  '$$set'(S,Ref)
+        ).
+
+% $$set does its best to preserve space
+'$$set'(S,R) :-
+       '$$build'(S0,_,R),
+        S0 = [_|_],
+	S = S0.
+
+'$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
+	'$$build2'(Ns,S0,R,X).
+'$$build'([],_,_).
+
+'$$build2'([X|Ns],Hash,R,X) :-
+	'$$new'(Hash,X), !,
+	'$$build'(Ns,Hash,R).
+'$$build2'(Ns,Hash,R,_) :-
+	'$$build'(Ns,Hash,R).
+
+'$$new'(V,El) :- var(V), !, V = n(_,El,_).
+'$$new'(n(R,El0,L),El) :-
+	compare(C,El0,El),
+	'$$new'(C,R,L,El).
+
+'$$new'(=,_,_,_) :- !, fail.
+'$$new'(<,R,_,El) :- '$$new'(R,El).
+'$$new'(>,_,L,El) :- '$$new'(L,El).
+
+
+'$$produce'([T1 same X1|Tn],S,X) :- '$$split'(Tn,T1,X1,S1,S2),
+	( S=[T1|S1], X=X1;
+	  !, produce(S2,S,X) ).
+
+'$$split'([],_,_,[],[]).
+'$$split'([T same X|Tn],T,X,S1,S2) :- '$$split'(Tn,T,X,S1,S2).
+'$$split'([T1 same X|Tn],T,X,[T1|S1],S2) :- '$$split'(Tn,T,X,S1,S2).
+'$$split'([T1|Tn],T,X,S1,[T1|S2]) :- '$$split'(Tn,T,X,S1,S2).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/signals.yap

@@ -0,0 +1,369 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		signals.pl						 *
+* Last rev:								 *
+* mods:									 *
+* comments:	signal handling in YAP					 *
+*									 *
+*************************************************************************/
+
+%%! @addtogroup OS
+%%  @{
+:- system_module( '$_signals', [alarm/3,
+        on_exception/3,
+        on_signal/3,
+        raise_exception/1,
+        read_sig/0], []).
+
+:- use_system_module( '$_boot', ['$meta_call'/2]).
+
+:- use_system_module( '$_debug', ['$do_spy'/4]).
+
+:- use_system_module( '$_threads', ['$thread_gfetch'/1]).
+
+/** @pred  alarm(+ _Seconds_,+ _Callable_,+ _OldAlarm_)
+
+
+Arranges for YAP to be interrupted in  _Seconds_ seconds, or in
+[ _Seconds_| _MicroSeconds_]. When interrupted, YAP will execute
+ _Callable_ and then return to the previous execution. If
+ _Seconds_ is `0`, no new alarm is scheduled. In any event,
+any previously set alarm is canceled.
+
+The variable  _OldAlarm_ unifies with the number of seconds remaining
+until any previously scheduled alarm was due to be delivered, or with
+`0` if there was no previously scheduled alarm.
+
+Note that execution of  _Callable_ will wait if YAP is
+executing built-in predicates, such as Input/Output operations.
+
+The next example shows how  _alarm/3_ can be used to implement a
+simple clock:
+
+~~~~~
+loop :- loop.
+
+ticker :- write('.'), flush_output,
+          get_value(tick, yes),
+          alarm(1,ticker,_).
+
+:- set_value(tick, yes), alarm(1,ticker,_), loop.
+~~~~~
+
+The clock, `ticker`, writes a dot and then checks the flag
+`tick` to see whether it can continue ticking. If so, it calls
+itself again. Note that there is no guarantee that the each dot
+corresponds a second: for instance, if the YAP is waiting for
+user input, `ticker` will wait until the user types the entry in.
+
+The next example shows how alarm/3 can be used to guarantee that
+a certain procedure does not take longer than a certain amount of time:
+
+~~~~~
+loop :- loop.
+
+:-   catch((alarm(10, throw(ball), _),loop),
+        ball,
+        format('Quota exhausted.~n',[])).
+~~~~~
+In this case after `10` seconds our `loop` is interrupted,
+`ball` is thrown,  and the handler writes `Quota exhausted`.
+Execution then continues from the handler.
+
+Note that in this case `loop/0` always executes until the alarm is
+sent. Often, the code you are executing succeeds or fails before the
+alarm is actually delivered. In this case, you probably want to disable
+the alarm when you leave the procedure. The next procedure does exactly so:
+
+~~~~~
+once_with_alarm(Time,Goal,DoOnAlarm) :-
+   catch(execute_once_with_alarm(Time, Goal), alarm, DoOnAlarm).
+
+execute_once_with_alarm(Time, Goal) :-
+        alarm(Time, alarm, _),
+        ( call(Goal) -> alarm(0, alarm, _) ; alarm(0, alarm, _), fail).
+~~~~~
+
+The procedure `once_with_alarm/3` has three arguments:
+the  _Time_ to wait before the alarm is
+sent; the  _Goal_ to execute; and the goal  _DoOnAlarm_ to execute
+if the alarm is sent. It uses catch/3 to handle the case the
+`alarm` is sent. Then it starts the alarm, calls the goal
+ _Goal_, and disables the alarm on success or failure.
+
+
+*/
+/** @pred  on_signal(+ _Signal_,? _OldAction_,+ _Callable_)
+
+
+Set the interrupt handler for soft interrupt  _Signal_ to be
+ _Callable_.  _OldAction_ is unified with the previous handler.
+
+Only a subset of the software interrupts (signals) can have their
+handlers manipulated through on_signal/3.
+Their POSIX names, YAP names and default behavior is given below.
+The "YAP name" of the signal is the atom that is associated with
+each signal, and should be used as the first argument to
+on_signal/3. It is chosen so that it matches the signal's POSIX
+name.
+
+on_signal/3 succeeds, unless when called with an invalid
+signal name or one that is not supported on this platform. No checks
+are made on the handler provided by the user.
+
++ sig_up (Hangup)
+SIGHUP in Unix/Linux; Reconsult the initialization files
+~/.yaprc, ~/.prologrc and ~/prolog.ini.
++ sig_usr1 and sig_usr2 (User signals)
+SIGUSR1 and SIGUSR2 in Unix/Linux; Print a message and halt.
+
+
+A special case is made, where if  _Callable_ is bound to
+`default`, then the default handler is restored for that signal.
+
+A call in the form `on_signal( _S_, _H_, _H_)` can be used
+to retrieve a signal's current handler without changing it.
+
+It must be noted that although a signal can be received at all times,
+the handler is not executed while YAP is waiting for a query at the
+prompt. The signal will be, however, registered and dealt with as soon
+as the user makes a query.
+
+Please also note, that neither POSIX Operating Systems nor YAP guarantee
+that the order of delivery and handling is going to correspond with the
+order of dispatch.
+*/
+:- meta_predicate on_signal(+,?,:), alarm(+,:,-).
+
+'$creep'(G) :-
+	% get the first signal from the mask
+	'$first_signal'(Sig), !,
+	% process it
+	'$do_signal'(Sig, G).
+'$creep'([M|G]) :-
+	% noise, just go on with our life.
+	'$execute'(M:G).
+
+'$do_signal'(sig_wake_up, G) :-
+ 	'$awoken_goals'(LG),
+	% if more signals alive, set creep flag
+	'$continue_signals',
+	'$wake_up_goal'(G, LG).
+% never creep on entering system mode!!!
+% don't creep on meta-call.
+'$do_signal'(sig_creep, MG) :-
+	 '$start_creep'(MG, creep).
+'$do_signal'(sig_iti, [M|G]) :-
+	'$thread_gfetch'(Goal),
+	% if more signals alive, set creep flag
+	'$continue_signals',
+	'$current_module'(M0),
+	'$execute0'(Goal,M0),
+	'$execute'(M:G).
+'$do_signal'(sig_trace, [M|G]) :-
+	'$continue_signals',
+	trace,
+	'$execute'(M:G).
+'$do_signal'(sig_debug, [M|G]) :-
+	'$continue_signals',
+	debug,
+	'$execute'(M:G).
+'$do_signal'(sig_break, [M|G]) :-
+	'$continue_signals',
+	break,
+	'$execute0'(G,M).
+'$do_signal'(sig_statistics, [M|G]) :-
+	'$continue_signals',
+	statistics,
+	'$execute0'(G,M).
+% the next one should never be called...
+'$do_signal'(fail, [_|_]) :-
+	fail.
+'$do_signal'(sig_stack_dump, [M|G]) :-
+	'$continue_signals',
+	'$hacks':'$stack_dump',
+	'$execute0'(G,M).
+'$do_signal'(sig_fpe,G) :-
+    '$signal_handler'(sig_fpe, G).
+'$do_signal'(sig_alarm, G) :-
+	'$signal_handler'(sig_alarm, G).
+'$do_signal'(sig_vtalarm, G) :-
+	'$signal_handler'(sig_vtalarm, G).
+'$do_signal'(sig_hup, G) :-
+	'$signal_handler'(sig_hup, G).
+'$do_signal'(sig_usr1, G) :-
+	'$signal_handler'(sig_usr1, G).
+'$do_signal'(sig_usr2, G) :-
+	'$signal_handler'(sig_usr2, G).
+'$do_signal'(sig_pipe, G) :-
+	'$signal_handler'(sig_pipe, G).
+
+'$signal_handler'(Sig, [M|G]) :-
+	'$signal_do'(Sig, Goal),
+	% if more signals alive, set creep flag
+	'$continue_signals',
+	'$current_module'(M0),
+	'$execute0'((Goal,M:G),M0).
+
+% we may be creeping outside and coming back to system mode.
+'$start_creep'([_M|G], _) :-
+         nonvar(G),
+         G = '$$cut_by'(CP),
+         !,
+	'$$cut_by'(CP).
+'$start_creep'([M|G], _) :-
+	'$is_no_trace'(G, M), !,
+	(
+	'$$save_by'(CP),
+	 '$no_creep_call'(G,M),
+	 '$$save_by'(CP2),
+	 '$disable_debugging',
+	 (CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
+	 '$enable_debugging'
+	;
+	'$disable_debugging',
+	fail
+	).
+'$start_creep'([Mod|G], WhereFrom) :-
+	CP is '$last_choice_pt',
+	'$do_spy'(G, Mod, CP, WhereFrom).
+
+'$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !,
+        '$enable_debugging',
+	'$execute_clause'(G,Mod,Ref,CP).
+'$no_creep_call'('$execute_nonstop'(G, M),_) :- !,
+	 '$enable_debugging',
+	'$execute_nonstop'(G, M).
+'$no_creep_call'(G, M) :-
+	 '$enable_debugging',
+	'$execute_nonstop'(G, M).
+
+
+
+'$execute_goal'(G, Mod) :-
+	(
+	 '$is_metapredicate'(G, Mod)
+	->
+	'$meta_call'(G,Mod)
+	;
+	'$execute_nonstop'(G,Mod)
+	).
+
+
+'$signal_do'(Sig, Goal) :-
+	recorded('$signal_handler', action(Sig,Goal), _), !.
+'$signal_do'(Sig, Goal) :-
+	'$signal_def'(Sig, Goal).
+
+% reconsult init files.
+'$signal_def'(sig_hup, (( exists('~/.yaprc') -> [-'~/.yaprc'] ; true ),
+		      ( exists('~/.prologrc') -> [-'~/.prologrc'] ; true ),
+		      ( exists('~/prolog.ini') -> [-'~/prolog.ini'] ; true ))).
+% die on signal default.
+'$signal_def'(sig_usr1, throw(error(signal(usr1,[]),true))).
+'$signal_def'(sig_usr2, throw(error(signal(usr2,[]),true))).
+'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))).
+'$signal_def'(sig_fpe, throw(error(signal(fpe,[]),true))).
+% ignore sig_alarm by default
+'$signal_def'(sig_alarm, true).
+
+
+'$signal'(sig_hup).
+'$signal'(sig_usr1).
+'$signal'(sig_usr2).
+'$signal'(sig_pipe).
+'$signal'(sig_alarm).
+'$signal'(sig_vtalarm).
+'$signal'(sig_fpe).
+
+on_signal(Signal,OldAction,NewAction) :-
+	var(Signal), !,
+	(nonvar(OldAction) -> throw(error(instantiation_error,on_signal/3)) ; true),
+        '$signal'(Signal),
+	on_signal(Signal, OldAction, NewAction).
+on_signal(Signal,OldAction,default) :-
+	'$reset_signal'(Signal, OldAction).
+on_signal(_Signal,_OldAction,Action) :-
+	var(Action), !,
+	throw(error('SYSTEM_ERROR_INTERNAL','Somehow the meta_predicate declarations of on_signal are subverted!')).
+on_signal(Signal,OldAction,Action) :-
+	Action = (_:Goal),
+	var(Goal), !,
+	'$check_signal'(Signal, OldAction),
+	Goal = OldAction.
+on_signal(Signal,OldAction,Action) :-
+	'$reset_signal'(Signal, OldAction),
+        % 13211-2 speaks only about callable
+	( Action = M:Goal -> true ; throw(error(type_error(callable,Action),on_signal/3)) ),
+	% the following disagrees with 13211-2:6.7.1.4 which disagrees with 13211-1:7.12.2a
+	% but the following agrees with 13211-1:7.12.2a
+	( nonvar(M) -> true ; throw(error(instantiation_error,on_signal/3)) ),
+	( atom(M) -> true ; throw(error(type_error(callable,Action),on_signal/3)) ),
+	( nonvar(Goal) -> true ; throw(error(instantiation_error,on_signal/3)) ),
+	recordz('$signal_handler', action(Signal,Action), _).
+
+'$reset_signal'(Signal, OldAction) :-
+	recorded('$signal_handler', action(Signal,OldAction), Ref), !,
+	erase(Ref).
+'$reset_signal'(_, default).
+
+'$check_signal'(Signal, OldAction) :-
+	recorded('$signal_handler', action(Signal,OldAction), _), !.
+'$check_signal'(_, default).
+
+
+alarm(Interval, Goal, Left) :-
+	Interval == 0, !,
+	'$alarm'(0, 0, Left0, _),
+	on_signal(sig_alarm, _, Goal),
+	Left = Left0.
+alarm(Interval, Goal, Left) :-
+	integer(Interval), !,
+	on_signal(sig_alarm, _, Goal),	'$alarm'(Interval, 0, Left, _).
+alarm(Number, Goal, Left) :-
+	float(Number), !,
+	Secs is integer(Number),
+	USecs is integer((Number-Secs)*1000000) mod 1000000,
+	on_signal(sig_alarm, _, Goal),
+	'$alarm'(Secs, USecs, Left, _).
+alarm([Interval|USecs], Goal, [Left|LUSecs]) :-
+	on_signal(sig_alarm, _, Goal),
+	'$alarm'(Interval, USecs, Left, LUSecs).
+
+raise_exception(Ball) :- throw(Ball).
+
+on_exception(Pat, G, H) :- catch(G, Pat, H).
+
+read_sig :-
+	recorded('$signal_handler',X,_),
+	writeq(X),nl,
+	fail.
+read_sig.
+
+%
+% make thes predicates non-traceable.
+
+:- '$set_no_trace'(current_choicepoint(_DCP), yap_hacks).
+:- '$set_no_trace'('$current_choice_point'(_DCP), _).
+:- '$set_no_trace'('$$cut_by'(_DCP), prolog).
+:- '$set_no_trace'(true, yap_hacks).
+:- '$set_no_trace'(true, prolog).
+:- '$set_no_trace'('$call'(_,_,_,_), prolog).
+:- '$set_no_trace'('$execute_nonstop'(_,_), prolog).
+:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog).
+:- '$set_no_trace'('$restore_regs'(_,_), prolog).
+:- '$set_no_trace'('$undefp0'(_,_), prolog).
+:- '$set_no_trace'('$Error'(_), prolog).
+:- '$set_no_trace'('$LoopError'(_,_), prolog).
+:- '$set_no_trace'('$TraceError'(_,_,_,_,_), prolog).
+:- '$set_no_trace'('$run_catch'(_,_), prolog).
+
+%%! @}

packages/python/swig/yap4py/prolog/pl/sort.yap

@@ -0,0 +1,166 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		sort.pl							 *
+* Last rev:								 *
+* mods:									 *
+* comments:	sorting in Prolog					 *
+*									 *
+*************************************************************************/
+:- system_module( '$_sort', [keysort/2,
+        length/2,
+        msort/2,
+        predmerge/4,
+        predmerge/7,
+        predsort/3,
+        predsort/5,
+        sort/2,
+        sort2/4], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+/** @addtogroup Comparing_Terms
+*/
+
+
+/*  The three sorting routines are all variations of merge-sort, done by
+    bisecting the list, sorting the nearly equal halves, and merging the
+    results.   The half-lists aren't actually constructed, the number of
+    elements is counted instead (which is why 'length' is in this file).
+
+*/
+
+/** @pred  sort(+ _L_,- _S_) is iso
+
+
+Unifies  _S_ with the list obtained by sorting  _L_ and  merging
+identical (in the sense of `==`) elements.
+
+
+*/
+sort(L,O) :-
+	'$skip_list'(NL,L,RL),
+	( RL == [] -> true ;
+	  var(RL) -> '$do_error'(instantiation_error,sort(L,O)) ;
+	 '$do_error'(type_error(list,L),sort(L,O))
+	),
+	(
+         nonvar(O)
+        ->
+	 (
+	   O == []
+         ->
+           L == []
+	 ;
+	   '$skip_list'(NO,O,RO),
+	   ( RO == [] -> NO =< NL ;
+	     var(RO) -> NO =< NL ;
+	     '$do_error'(type_error(list,O),sort(L,O))
+	   )
+         )
+        ; true
+	),
+	'$sort'(L,O).
+
+msort(L,O) :-
+	'$msort'(L,O).
+
+/** @pred  keysort(+ _L_, _S_) is iso
+
+
+Assuming L is a list of the form ` _Key_- _Value_`,
+`keysort(+ _L_, _S_)` unifies  _S_ with the list obtained
+from  _L_, by sorting its elements according to the value of
+ _Key_.
+
+~~~~~{.prolog}
+?- keysort([3-a,1-b,2-c,1-a,1-b],S).
+~~~~~
+would return:
+
+~~~~~{.prolog}
+S = [1-b,1-a,1-b,2-c,3-a]
+~~~~~
+
+
+*/
+keysort(L,O) :-
+	'$skip_list'(NL,L,RL),
+	( RL == [] -> true ;
+	  var(RL) -> '$do_error'(instantiation_error,sort(L,O)) ;
+	  '$do_error'(type_error(list,L),sort(L,O))
+	),
+	(
+	 nonvar(O)
+	->
+	 '$skip_list'(NO,O,RO),
+   	 ( RO == [] -> NO =:= NL ;
+	   var(RO) -> NO =< NL ;
+	   '$do_error'(type_error(list,O),sort(L,O))
+	 )
+	; true
+	),
+	'$keysort'(L,O).
+
+:- meta_predicate prolog:predsort(3,+,-).
+
+%%	predsort(:Compare, +List, -Sorted) is det.
+%
+%	 Sorts similar to sort/2, but determines  the order of two terms
+%	 by calling Compare(-Delta, +E1,  +E2).   This  call  must unify
+%	 Delta with one of <, > or =. If built-in predicate compare/3 is
+%	 used, the result is the same as sort/2. See also keysort/2.
+
+/** @pred  predsort(+ _Pred_, + _List_, - _Sorted_)
+
+
+Sorts similar to sort/2, but determines the order of two terms by
+calling  _Pred_(- _Delta_, + _E1_, + _E2_) . This call must
+unify  _Delta_ with one of `<`, `>` or `=`. If
+built-in predicate compare/3 is used, the result is the same as
+sort/2.
+
+
+*/
+predsort(P, L, R) :-
+	length(L, N),
+	predsort(P, N, L, _, R1), !,
+	R = R1.
+
+predsort(P, 2, [X1, X2|L], L, R) :- !,
+	call(P, Delta, X1, X2),
+	sort2(Delta, X1, X2, R).
+predsort(_, 1, [X|L], L, [X]) :- !.
+predsort(_, 0, L, L, []) :- !.
+predsort(P, N, L1, L3, R) :-
+	N1 is N // 2,
+	plus(N1, N2, N),
+	predsort(P, N1, L1, L2, R1),
+	predsort(P, N2, L2, L3, R2),
+	predmerge(P, R1, R2, R).
+
+sort2(<, X1, X2, [X1, X2]).
+sort2(=, X1, _,  [X1]).
+sort2(>, X1, X2, [X2, X1]).
+
+predmerge(_, [], R, R) :- !.
+predmerge(_, R, [], R) :- !.
+predmerge(P, [H1|T1], [H2|T2], Result) :-
+	call(P, Delta, H1, H2),
+	predmerge(Delta, P, H1, H2, T1, T2, Result).
+
+predmerge(>, P, H1, H2, T1, T2, [H2|R]) :-
+	predmerge(P, [H1|T1], T2, R).
+predmerge(=, P, H1, _, T1, T2, [H1|R]) :-
+	predmerge(P, T1, T2, R).
+predmerge(<, P, H1, H2, T1, T2, [H1|R]) :-
+	predmerge(P, T1, [H2|T2], R).
+
+%%! @}

packages/python/swig/yap4py/prolog/pl/spy.yap

@@ -0,0 +1,395 @@
+:- system_module( '$_debug', [debug/0,
+        debugging/0,
+        leash/1,
+        nodebug/0,
+        (nospy)/1,
+        nospyall/0,
+        notrace/0,
+        (spy)/1,
+        trace/0], [
+        '$init_debugger'/0]).
+
+:- use_system_module( '$_boot', ['$find_goal_definition'/4,
+        '$system_catch'/4]).
+
+:- use_system_module( '$_errors', ['$Error'/1,
+        '$do_error'/2]).
+
+:- use_system_module( '$_init', ['$system_module'/1]).
+
+:- use_system_module( '$_modules', ['$meta_expansion'/6]).
+
+:- use_system_module( '$_preds', ['$clause'/4]).
+
+/*-----------------------------------------------------------------------------
+
+			Debugging / creating spy points
+
+-----------------------------------------------------------------------------*/
+
+/** @defgroup Deb_Preds Debugging Predicates
+@ingroup builtins
+
+@{
+The
+ following predicates are available to control the debugging of
+programs:
+
++ debug
+
+    Switches the debugger on.
+
++ debuggi=
+r
+
+g
+
+
+    Outputs status information about the debugger which includes the leash
+mode and the existing spy-points, when the debugger is on.
+
++ nodebug
+
+
+    Switches the debugger off.
+
+
+*/
+
+
+:- op(900,fx,[spy,nospy]).
+
+'$init_debugger' :-
+        '__NB_getval__'('$trace', _, fail), !.
+'$init_debugger' :-
+	'$debugger_input',
+	'__NB_setval__'('$trace',off),
+	'__NB_setval__'('$if_skip_mode',no_skip),
+	'__NB_setval__'('$spy_glist',[]),
+	'__NB_setval__'('$spy_gn',1),
+	'__NB_setval__'('$debug_run',off),
+	'__NB_setval__'('$debug_jump',false).
+
+
+ % First part : setting and reseting spy points
+
+ % $suspy does most of the work
+ '$suspy'(V,S,M) :- var(V) , !,
+	 '$do_error'(instantiation_error,M:spy(V,S)).
+ '$suspy'((M:S),P,_) :- !,
+     '$suspy'(S,P,M).
+ '$suspy'([],_,_) :- !.
+ '$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
+ '$suspy'(F/N,S,M) :- !,
+	 functor(T,F,N),
+	 '$do_suspy'(S, F, N, T, M).
+ '$suspy'(A,S,M) :- atom(A), !,
+	 '$suspy_predicates_by_name'(A,S,M).
+ '$suspy'(P,spy,M) :- !,
+	  '$do_error'(domain_error(predicate_spec,P),spy(M:P)).
+ '$suspy'(P,nospy,M) :-
+	  '$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
+
+ '$suspy_predicates_by_name'(A,S,M) :-
+	 % just check one such predicate exists
+	 (
+	   current_predicate(A,M:_)
+	 ->
+	  M = EM,
+	  A = NA
+	 ;
+	  recorded('$import','$import'(EM,M,GA,_,A,_),_),
+	  functor(GA,NA,_)
+	 ),
+	 !,
+	 '$do_suspy_predicates_by_name'(NA,S,EM).
+'$suspy_predicates_by_name'(A,spy,M) :- !,
+	 print_message(warning,no_match(spy(M:A))).
+'$suspy_predicates_by_name'(A,nospy,M) :-
+	 print_message(warning,no_match(nospy(M:A))).
+
+'$do_suspy_predicates_by_name'(A,S,M) :-
+	 current_predicate(A,M:T),
+	 functor(T,A,N),
+	 '$do_suspy'(S, A, N, T, M).
+'$do_suspy_predicates_by_name'(A, S, M) :-
+	 recorded('$import','$import'(EM,M,_,T,A,N),_),
+	 '$do_suspy'(S, A, N, T, EM).
+
+
+ %
+ % protect against evil arguments.
+ %
+ '$do_suspy'(S, F, N, T, M) :-
+	 recorded('$import','$import'(EM,M,T0,_,F,N),_), !,
+	 functor(T0, F0, N0),
+	 '$do_suspy'(S, F0, N0, T, EM).
+ '$do_suspy'(S, F, N, T, M) :-
+	  '$undefined'(T,M), !,
+	  ( S = spy ->
+	      print_message(warning,no_match(spy(M:F/N)))
+	  ;
+	      print_message(warning,no_match(nospy(M:F/N)))
+	  ).
+ '$do_suspy'(S, F, N, T, M) :-
+	  '$system_predicate'(T,M),
+	  '$predicate_flags'(T,M,F,F),
+	  F /\ 0x118dd080 =\= 0,
+	  ( S = spy ->
+	      '$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
+	  ;
+	      '$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
+	  ).
+ '$do_suspy'(S, F, N, T, M) :-
+	  '$undefined'(T,M), !,
+	  ( S = spy ->
+	      print_message(warning,no_match(spy(M:F/N)))
+	  ;
+	      print_message(warning,no_match(nospy(M:F/N)))
+	  ).
+ '$do_suspy'(S,F,N,T,M) :-
+	 '$suspy2'(S,F,N,T,M).
+
+ '$suspy2'(spy,F,N,T,M) :-
+	 recorded('$spy','$spy'(T,M),_), !,
+	 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
+ '$suspy2'(spy,F,N,T,M) :- !,
+	 recorda('$spy','$spy'(T,M),_),
+	 '$set_spy'(T,M),
+	 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
+ '$suspy2'(nospy,F,N,T,M) :-
+	 recorded('$spy','$spy'(T,M),R), !,
+	 erase(R),
+	 '$rm_spy'(T,M),
+	 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
+ '$suspy2'(nospy,F,N,_,M) :-
+	 print_message(informational,breakp(no,breakpoint_for,M:F/N)).
+
+ '$pred_being_spied'(G, M) :-
+	 recorded('$spy','$spy'(G,M),_), !.
+
+/**
+@pred spy( + _P_ ).
+
+Sets spy-points on all the predicates represented by
+ _P_.  _P_ can either be a single specification or a list of
+specifications. Each one must be of the form  _Name/Arity_
+or  _Name_. In the last case all predicates with the name
+ _Name_ will be spied. As in C-Prolog, system predicates and
+predicates written in C, cannot be spied.
+
+
+*/
+ spy Spec :-
+	 '$init_debugger',
+	 prolog:debug_action_hook(spy(Spec)), !.
+ spy L :-
+	 '$current_module'(M),
+	 '$suspy'(L, spy, M), fail.
+ spy _ :- debug.
+
+/** @pred nospy( + _P_ )
+
+
+Removes spy-points from all predicates specified by  _P_.
+The possible forms for  _P_ are the same as in `spy P`.
+
+
+*/
+ nospy Spec :-
+	 '$init_debugger',
+	 prolog:debug_action_hook(nospy(Spec)), !.
+ nospy L :-
+	 '$current_module'(M),
+	 '$suspy'(L, nospy, M), fail.
+nospy _.
+
+/** @pred nospyall
+
+Removes all existing spy-points.
+*/
+nospyall :-
+	 '$init_debugger',
+	 prolog:debug_action_hook(nospyall), !.
+nospyall :-
+	 recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
+nospyall.
+
+ % debug mode -> debug flag = 1
+
+debug :-
+	 '$init_debugger',
+	 ( '__NB_getval__'('$spy_gn',_, fail) -> true ; '__NB_setval__'('$spy_gn',1) ),
+	 '$start_debugging'(on),
+	 print_message(informational,debug(debug)).
+
+'$start_debugging'(Mode) :-
+	 (Mode == on ->
+	  set_prolog_flag(debug, true)
+	 ;
+	  set_prolog_flag(debug, false)
+	 ),
+	 '__NB_setval__'('$debug_run',off),
+	 '__NB_setval__'('$debug_jump',false).
+
+nodebug :-
+	 '$init_debugger',
+	 set_prolog_flag(debug, false),
+	 '__NB_setval__'('$trace',off),
+	 print_message(informational,debug(off)).
+
+%
+% remove any debugging info after an abort.
+%
+
+
+/** @pred trace
+
+
+Switches on the debugger and enters tracing mode.
+
+
+*/
+trace :-
+	 '$init_debugger',
+     fail.
+trace :-
+	'__NB_setval__'('$trace',on),
+	'$start_debugging'(on),
+	print_message(informational,debug(trace)),
+	'$creep'.
+
+/** @pred notrace
+
+
+Ends tracing and exits the debugger. This is the same as
+nodebug/0.
+ */
+notrace :-
+	'$init_debugger',
+	nodebug.
+
+/*-----------------------------------------------------------------------------
+
+				leash
+
+-----------------------------------------------------------------------------*/
+
+
+/** @pred leash(+ _M_)
+
+
+Sets leashing mode to  _M_.
+The mode can be specified as:
+
++ `full`
+prompt on Call, Exit, Redo and Fail
+
++ `tight`
+prompt on Call, Redo and Fail
+
++ `half`
+prompt on Call and Redo
+
++ `loose`
+prompt on Call
+
++ `off`
+never prompt
+
++ `none`
+never prompt, same as `off`
+
+The initial leashing mode is `full`.
+
+The user may also specify directly the debugger ports
+where he wants to be prompted. If the argument for leash
+is a number  _N_, each of lower four bits of the number is used to
+control prompting at one the ports of the box model. The debugger will
+prompt according to the following conditions:
+
++ if `N/\ 1 =\= 0`  prompt on fail
++ if `N/\ 2 =\= 0` prompt on redo
++ if `N/\ 4 =\= 0` prompt on exit
++ if `N/\ 8 =\= 0` prompt on call
+
+Therefore, `leash(15)` is equivalent to `leash(full)` and
+`leash(0)` is equivalent to `leash(off)`.
+
+Another way of using `leash` is to give it a list with the names of
+the ports where the debugger should stop. For example,
+`leash([call,exit,redo,fail])` is the same as `leash(full)` or
+`leash(15)` and `leash([fail])` might be used instead of
+`leash(1)`.
+
+ @}
+
+*/
+leash(X) :- var(X),
+	'$do_error'(instantiation_error,leash(X)).
+leash(X) :-
+	'$init_debugger',
+	'$leashcode'(X,Code),
+	set_value('$leash',Code),
+	'$show_leash'(informational,Code), !.
+leash(X) :-
+	'$do_error'(type_error(leash_mode,X),leash(X)).
+
+'$show_leash'(Msg,0) :-
+	print_message(Msg,leash([])).
+'$show_leash'(Msg,Code) :-
+	'$check_leash_bit'(Code,0x8,L3,call,LF),
+	'$check_leash_bit'(Code,0x4,L2,exit,L3),
+	'$check_leash_bit'(Code,0x2,L1,redo,L2),
+	'$check_leash_bit'(Code,0x1,[],fail,L1),
+	print_message(Msg,leash(LF)).
+
+'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
+'$check_leash_bit'(_,_,L0,Name,[Name|L0]).
+
+'$leashcode'(full,0xf) :- !.
+'$leashcode'(on,0xf) :- !.
+'$leashcode'(half,0xb) :- !.
+'$leashcode'(loose,0x8) :- !.
+'$leashcode'(off,0x0) :- !.
+'$leashcode'(none,0x0) :- !.
+%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
+'$leashcode'([L|M],Code) :- !,
+	'$list2Code'([L|M],Code).
+'$leashcode'(N,N) :- integer(N), N >= 0, N =< 0xf.
+
+'$list2Code'(V,_) :- var(V), !,
+	'$do_error'(instantiation_error,leash(V)).
+'$list2Code'([],0) :- !.
+'$list2Code'([V|L],_) :- var(V), !,
+	'$do_error'(instantiation_error,leash([V|L])).
+'$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 0x8 + N1.
+'$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 0x4 + N1.
+'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 0x2 + N1.
+'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 0x1 + N1.
+
+/*-----------------------------------------------------------------------------
+
+				debugging
+
+-----------------------------------------------------------------------------*/
+
+debugging :-
+	'$init_debugger',
+	prolog:debug_action_hook(nospyall), !.
+debugging :-
+	( current_prolog_flag(debug, true) ->
+	    print_message(help,debug(debug))
+	    ;
+	    print_message(help,debug(off))
+	),
+	findall(M:(N/A),(recorded('$spy','$spy'(T,M),_),functor(T,N,A)),L),
+	print_message(help,breakpoints(L)),
+	get_value('$leash',Leash),
+	'$show_leash'(help,Leash).
+
+/*
+
+@}
+
+*/

packages/python/swig/yap4py/prolog/pl/statistics.yap

@@ -0,0 +1,358 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		statistics.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	statistics on Prolog status				 *
+*									 *
+*************************************************************************/
+:- system_module( '$_statistics', [key_statistics/3,
+        statistics/0,
+        statistics/2,
+        time/1], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+%%% User interface for statistics
+
+/** @pred  statistics/0 
+
+
+Send to the current user error stream general information on space used and time
+spent by the system.
+
+~~~~~
+?- statistics.
+memory (total)        4784124 bytes
+   program space      3055616 bytes:    1392224 in use,      1663392 free
+                                                             2228132  max
+   stack space        1531904 bytes:        464 in use,      1531440 free
+     global stack:                           96 in use,       616684  max
+      local stack:                          368 in use,       546208  max
+   trail stack         196604 bytes:          8 in use,       196596 free
+
+       0.010 sec. for 5 code, 2 stack, and 1 trail space overflows
+       0.130 sec. for 3 garbage collections which collected 421000 bytes
+       0.000 sec. for 0 atom garbage collections which collected 0 bytes
+       0.880 sec. runtime
+       1.020 sec. cputime
+      25.055 sec. elapsed time
+
+~~~~~
+The example shows how much memory the system spends. Memory is divided
+into Program Space, Stack Space and Trail. In the example we have 3MB
+allocated for program spaces, with less than half being actually
+used. YAP also shows the maximum amount of heap space having been used
+which was over 2MB.
+
+The stack space is divided into two stacks which grow against each
+other. We are in the top level so very little stack is being used. On
+the other hand, the system did use a lot of global and local stack
+during the previous execution (we refer the reader to a WAM tutorial in
+order to understand what are the global and local stacks).
+
+YAP also shows information on how many memory overflows and garbage
+collections the system executed, and statistics on total execution
+time. Cputime includes all running time, runtime excludes garbage
+collection and stack overflow time.
+
+ 
+*/
+statistics :-
+	'$runtime'(Runtime,_), 
+	'$cputime'(CPUtime,_), 
+	'$systime'(SYStime,_), 
+	'$walltime'(Walltime,_), 
+	'$statistics_heap_info'(HpSpa, HpInUse), 
+	'$statistics_heap_max'(HpMax), 
+	'$statistics_trail_info'(TrlSpa, TrlInUse), 
+	'$statistics_trail_max'(TrlMax), 
+	'$statistics_stacks_info'(StkSpa, GlobInU, LocInU), 
+	'$statistics_global_max'(GlobMax), 
+	'$statistics_local_max'(LocMax), 
+	'$inform_heap_overflows'(NOfHO,TotHOTime),
+	'$inform_stack_overflows'(NOfSO,TotSOTime),
+	'$inform_trail_overflows'(NOfTO,TotTOTime),
+	'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
+	'$inform_agc'(NOfAGC,TotAGCTime,TotAGCSize),
+	'$statistics'(Runtime,CPUtime,SYStime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize).
+
+'$statistics'(Runtime,CPUtime,SYStime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
+	TotalMemory is HpSpa+StkSpa+TrlSpa,
+	format(user_error,'memory (total)~t~d bytes~35+~n', [TotalMemory]),
+	format(user_error,'   program space~t~d bytes~35+', [HpSpa]),
+	format(user_error,':~t  ~d in use~19+', [HpInUse]),
+	HpFree is HpSpa-HpInUse,
+	format(user_error,',~t  ~d free~19+~n', [HpFree]),
+	format(user_error,'~t  ~d  max~73+~n', [HpMax]),
+	format(user_error,'   stack space~t~d bytes~35+', [StkSpa]),
+	StackInUse is GlobInU+LocInU,
+	format(user_error,':~t  ~d in use~19+', [StackInUse]),
+	StackFree is StkSpa-StackInUse,
+	format(user_error,',~t  ~d free~19+~n', [StackFree]),
+	format(user_error,'     global stack:~t~35+', []),
+	format(user_error,' ~t  ~d in use~19+', [GlobInU]),
+	format(user_error,',~t  ~d  max~19+~n', [GlobMax]),
+	format(user_error,'      local stack:~t~35+', []),
+	format(user_error,' ~t  ~d in use~19+', [LocInU]),
+	format(user_error,',~t  ~d  max~19+~n', [LocMax]),
+	format(user_error,'   trail stack~t~d bytes~35+', [TrlSpa]),
+	format(user_error,':~t  ~d in use~19+', [TrlInUse]),
+	TrlFree is TrlSpa-TrlInUse,
+	format(user_error,',~t  ~d free~19+~n', [TrlFree]),
+	OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000,
+	format(user_error,'~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n',
+	       [OvfTime,NOfHO,NOfSO,NOfTO]),
+	TotGCTimeF is float(TotGCTime)/1000,
+	format(user_error,'~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n',
+	       [TotGCTimeF,NOfGC,TotGCSize]),
+	TotAGCTimeF is float(TotAGCTime)/1000,
+	format(user_error,'~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n',
+	       [TotAGCTimeF,NOfAGC,TotAGCSize]),
+	RTime is float(Runtime)/1000,
+	format(user_error,'~t~3f~12+ sec. runtime~n', [RTime]),
+	CPUTime is float(CPUtime)/1000,
+	format(user_error,'~t~3f~12+ sec. cputime~n', [CPUTime]),
+	SYSTime is float(SYStime)/1000,
+	format(user_error,'~t~3f~12+ sec. systime~n', [SYSTime]),
+	WallTime is float(Walltime)/1000,
+	format(user_error,'~t~3f~12+ sec. elapsed time~n~n', [WallTime]),
+	fail.
+'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
+
+/** @pred  statistics(? _Param_,- _Info_)
+
+Gives statistical information on the system parameter given by first
+argument:
+
+
+
++ atoms 
+
+`[ _NumberOfAtoms_, _SpaceUsedBy Atoms_]`
+
+
+This gives the total number of atoms `NumberOfAtoms` and how much
+space they require in bytes,  _SpaceUsedBy Atoms_.
+
++ cputime 
+
+`[ _Time since Boot_, _Time From Last Call to Cputime_]`
+
+
+This gives the total cputime in milliseconds spent executing Prolog code,
+garbage collection and stack shifts time included.
+
++ dynamic_code 
+
+`[ _Clause Size_, _Index Size_, _Tree Index Size_, _Choice Point Instructions Size_, _Expansion Nodes Size_, _Index Switch Size_]`
+
+
+Size of static code in YAP in bytes:  _Clause Size_, the number of
+bytes allocated for clauses, plus
+ _Index Size_, the number of bytes spent in the indexing code. The
+indexing code is divided into main tree,  _Tree Index Size_, 
+tables that implement choice-point manipulation,  _Choice xsPoint Instructions Size_, tables that cache clauses for future expansion of the index
+tree,  _Expansion Nodes Size_, and 
+tables such as hash tables that select according to value,   _Index Switch Size_.
+
++ garbage_collection 
+
+`[ _Number of GCs_, _Total Global Recovered_, _Total Time Spent_]`
+
+
+Number of garbage collections, amount of space recovered in kbytes, and
+total time spent doing garbage collection in milliseconds. More detailed
+information is available using `yap_flag(gc_trace,verbose)`.
+
++ global_stack 
+
+`[ _Global Stack Used_, _Execution Stack Free_]`
+
+
+Space in kbytes currently used in the global stack, and space available for
+expansion by the local and global stacks.
+
++ local_stack 
+
+`[ _Local Stack Used_, _Execution Stack Free_]`
+
+
+Space in kbytes currently used in the local stack, and space available for
+expansion by the local and global stacks.
+
++ heap 
+
+`[ _Heap Used_, _Heap Free_]`
+
+
+Total space in kbytes not recoverable
+in backtracking. It includes the program code, internal data base, and,
+atom symbol table.
+
++ program 
+
+`[ _Program Space Used_, _Program Space Free_]`
+
+
+Equivalent to heap.
+
++ runtime 
+
+`[ _Time since Boot_, _Time From Last Call to Runtime_]`
+
+
+This gives the total cputime in milliseconds spent executing Prolog
+code, not including garbage collections and stack shifts. Note that
+until YAP4.1.2 the runtime statistics would return time spent on
+garbage collection and stack shifting.
+
++ stack_shifts 
+
+`[ _Number of Heap Shifts_, _Number of Stack Shifts_, _Number of Trail Shifts_]`
+
+
+Number of times YAP had to
+expand the heap, the stacks, or the trail. More detailed information is
+available using `yap_flag(gc_trace,verbose)`.
+
++ static_code 
+
+`[ _Clause Size_, _Index Size_, _Tree Index Size_, _Expansion Nodes Size_, _Index Switch Size_]`
+
+
+Size of static code in YAP in bytes:  _Clause Size_, the number of
+bytes allocated for clauses, plus
+ _Index Size_, the number of bytes spent in the indexing code. The
+indexing code is divided into a main tree,  _Tree Index Size_, table that cache clauses for future expansion of the index
+tree,  _Expansion Nodes Size_, and and 
+tables such as hash tables that select according to value,   _Index Switch Size_.
+
++ trail 
+
+`[ _Trail Used_, _Trail Free_]`
+
+
+Space in kbytes currently being used and still available for the trail.
+
++ walltime 
+
+`[ _Time since Boot_, _Time From Last Call to Walltime_]`
+
+
+This gives the clock time in milliseconds since starting Prolog.
+
+
+
+ 
+*/
+statistics(runtime,[T,L]) :-
+	'$runtime'(T,L).
+statistics(cputime,[T,L]) :-
+	'$cputime'(T,L).
+statistics(walltime,[T,L]) :-
+	'$walltime'(T,L).
+statistics(threads,NT) :-
+	'$nof_threads'(NT).
+statistics(threads_created,TC) :-
+	'$nof_threads_created'(TC).
+statistics(thread_cputime,TR) :-
+	'$thread_runtime'(TR).
+%statistics(core,[_]).
+%statistics(memory,[_]).
+statistics(heap,[Hp,HpF]) :-
+	'$statistics_heap_info'(HpM, Hp),
+	HpF is HpM-Hp.
+statistics(program,Info) :-
+	statistics(heap,Info).
+statistics(global_stack,[GlobInU,GlobFree]) :-
+	'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
+	GlobFree is StkSpa-GlobInU-LocInU.
+statistics(local_stack,[LocInU,LocFree]) :-
+	'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
+	LocFree is StkSpa-GlobInU-LocInU.
+statistics(trail,[TrlInUse,TrlFree]) :-
+	'$statistics_trail_info'(TrlSpa, TrlInUse),
+	TrlFree is TrlSpa-TrlInUse.
+statistics(garbage_collection,[NOfGC,TotGCSize,TotGCTime]) :-
+	'$inform_gc'(NOfGC,TotGCTime,TotGCSize).
+statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
+	'$inform_heap_overflows'(NOfHO,_),
+	'$inform_stack_overflows'(NOfSO,_),
+	'$inform_trail_overflows'(NOfTO,_).
+statistics(atoms,[NOf,SizeOf]) :-
+	'$statistics_atom_info'(NOf,SizeOf).
+statistics(static_code,[ClauseSize, IndexSize, TreeIndexSize, ExtIndexSize, SWIndexSize]) :-
+	'$statistics_db_size'(ClauseSize, TreeIndexSize, ExtIndexSize, SWIndexSize),
+	IndexSize is TreeIndexSize+ ExtIndexSize+ SWIndexSize.
+statistics(dynamic_code,[ClauseSize,IndexSize, TreeIndexSize, CPIndexSize, ExtIndexSize, SWIndexSize]) :-
+	'$statistics_lu_db_size'(ClauseSize, TreeIndexSize, CPIndexSize, ExtIndexSize, SWIndexSize),
+	IndexSize is TreeIndexSize+CPIndexSize+ ExtIndexSize+ SWIndexSize.
+
+/** @pred  key_statistics(+ _K_,- _Entries_,- _TotalSize_)
+
+Returns several statistics for a key  _K_. Currently, it says how
+many entries we have for that key,  _Entries_, what is the
+total size spent on this key.
+
+ 
+*/
+key_statistics(Key, NOfEntries, TotalSize) :-
+	key_statistics(Key, NOfEntries, ClSize, IndxSize),
+	TotalSize is ClSize+IndxSize.
+
+
+%%	time(:Goal)
+%
+%	Time the execution of Goal.  Possible choice-points of Goal are removed.
+%	Based on the SWI-Prolog definition minus reporting the number of inferences,
+%	which YAP does not currently supports
+
+/** @pred  time(: _Goal_) 
+
+
+Prints the CPU time and the wall time for the execution of  _Goal_.
+Possible choice-points of  _Goal_ are removed. Based on the SWI-Prolog 
+definition (minus reporting the number of inferences, which YAP currently
+does not support).
+
+ 
+*/
+:- meta_predicate time(0).
+
+time(Goal) :-
+	var(Goal),
+	'$do_error'(instantiation_error,time(Goal)).
+time(_:Goal) :-
+	var(Goal),
+	'$do_error'(instantiation_error,time(Goal)).
+time(Goal) :- \+ callable(Goal), !,
+	'$do_error'(type_error(callable,Goal),time(Goal)).
+time(Goal) :-
+	statistics(walltime, _),
+	statistics(cputime, _), 
+	(   catch(Goal, E, true)
+	->  Result = yes
+	;   Result = no
+	),
+	statistics(cputime, [_, Time]),
+	statistics(walltime, [_, Wall]),
+	(   Time =:= 0
+	->  CPU = 'Inf'
+	;   CPU is truncate(Time/Wall*100)
+	),
+	TimeSecs is Time/1000,
+	WallSecs is Wall/1000,
+	format(user_error,'% ~3f CPU in ~3f seconds (~|~t~w~3+% CPU)~n', [TimeSecs, WallSecs, CPU]),
+	(   nonvar(E)
+	->  throw(E)
+	;   Result == yes
+	).

packages/python/swig/yap4py/prolog/pl/strict_iso.yap

@@ -0,0 +1,232 @@
+:- system_module( '$_strict_iso', [], ['$check_iso_strict_clause'/1,
+        '$iso_check_goal'/2]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+'$iso_check_goal'(V,G) :-
+	var(V), !,
+	'$do_error'(instantiation_error,call(G)).
+'$iso_check_goal'(V,G) :-
+	number(V), !,
+	'$do_error'(type_error(callable,V),G).
+'$iso_check_goal'(_:G,G0) :- !,
+	'$iso_check_goal'(G,G0).
+'$iso_check_goal'((G1,G2),G0) :- !,
+	'$iso_check_a_goal'(G1,(G1,G2),G0),
+	'$iso_check_a_goal'(G2,(G1,G2),G0).
+'$iso_check_goal'((G1;G2),G0) :- !,
+	'$iso_check_a_goal'(G1,(G1;G2),G0),
+	'$iso_check_a_goal'(G2,(G1;G2),G0).
+'$iso_check_goal'((G1->G2),G0) :- !,
+	'$iso_check_a_goal'(G1,(G1->G2),G0),
+	'$iso_check_a_goal'(G2,(G1->G2),G0).
+'$iso_check_goal'(!,_) :- !.
+'$iso_check_goal'((G1|G2),G0) :-
+	current_prolog_flag(language, iso), !, 
+	'$do_error'(domain_error(builtin_procedure,(G1|G2)), call(G0)).
+'$iso_check_goal'((G1|G2),G0) :- !,
+	'$iso_check_a_goal'(G1,(G1|G2),G0),
+	'$iso_check_a_goal'(G2,(G1|G2),G0).
+'$iso_check_goal'(G,G0) :- 
+	current_prolog_flag(language, iso),
+	'$system_predicate'(G,prolog),
+	(
+            '$iso_builtin'(G)
+	->
+	    true
+	;
+	    '$do_error'(domain_error(builtin_procedure,G), call(G0))
+	).
+'$iso_check_goal'(_,_).
+
+'$iso_check_a_goal'(V,_,G) :-
+	var(V), !,
+	'$do_error'(instantiation_error,call(G)).
+'$iso_check_a_goal'(V,E,G) :-
+	number(V), !,
+	'$do_error'(type_error(callable,E),call(G)).
+'$iso_check_a_goal'(_:G,E,G0) :- !,
+	'$iso_check_a_goal'(G,E,G0).
+'$iso_check_a_goal'((G1,G2),E,G0) :- !,
+        '$iso_check_a_goal'(G1,E,G0),
+        '$iso_check_a_goal'(G2,E,G0).
+'$iso_check_a_goal'((G1;G2),E,G0) :- !,
+        '$iso_check_a_goal'(G1,E,G0),
+        '$iso_check_a_goal'(G2,E,G0).
+'$iso_check_a_goal'((G1->G2),E,G0) :- !,
+        '$iso_check_a_goal'(G1,E,G0),
+        '$iso_check_a_goal'(G2,E,G0).
+'$iso_check_a_goal'(!,_,_) :- !.
+'$iso_check_a_goal'((_|_),E,G0) :-
+	current_prolog_flag(language, iso), !,
+	'$do_error'(domain_error(builtin_procedure,E), call(G0)).
+'$iso_check_a_goal'((_|_),_,_) :- !.
+'$iso_check_a_goal'(G,_,G0) :- 
+	current_prolog_flag(language, iso),
+	'$is+system_predicate'(G,prolog),
+	(
+            '$iso_builtin'(G)
+	->
+	    true
+	;
+	    '$do_error'(domain_error(builtin_procedure,G), call(G0))
+	).
+'$iso_check_a_goal'(_,_,_).
+
+'$check_iso_strict_clause'((_:-B)) :- !,
+	'$check_iso_strict_body'(B).
+'$check_iso_strict_clause'(_).
+
+'$check_iso_strict_body'((B1,B2)) :- !,
+	'$check_iso_strict_body'(B1),
+	'$check_iso_strict_body'(B2).
+'$check_iso_strict_body'((B1;B2)) :- !,
+	'$check_iso_strict_body'(B1),
+	'$check_iso_strict_body'(B2).
+'$check_iso_strict_body'((B1->B2)) :- !,
+	'$check_iso_strict_body'(B1),
+	'$check_iso_strict_body'(B2).
+'$check_iso_strict_body'(B) :-
+	'$check_iso_strict_goal'(B).
+
+'$check_iso_strict_goal'(G) :-
+	'$is_system_predicate'(G,prolog), !,
+	'$check_iso_system_goal'(G).
+'$check_iso_strict_goal'(_).
+
+
+'$check_iso_system_goal'(G) :-
+	'$iso_builtin'(G), !.
+'$check_iso_system_goal'(G) :-
+	'$do_error'(domain_error(builtin_procedure,G), G).
+
+'$iso_builtin'(abolish(_)).
+'$iso_builtin'(acylic_term(_)).
+'$iso_builtin'(arg(_,_,_)).
+'$iso_builtin'(_=:=_).
+'$iso_builtin'(_=\=_).
+'$iso_builtin'(_>_).
+'$iso_builtin'(_>=_).
+'$iso_builtin'(_<_).
+'$iso_builtin'(_=<_).
+'$iso_builtin'(asserta(_)).
+'$iso_builtin'(assertz(_)).
+'$iso_builtin'(at_end_of_stream).
+'$iso_builtin'(at_end_of_stream(_)).
+'$iso_builtin'(atom(_)).
+'$iso_builtin'(atom_chars(_,_)).
+'$iso_builtin'(atom_codes(_,_)).
+'$iso_builtin'(atom_concat(_,_,_)).
+'$iso_builtin'(atom_length(_,_)).
+'$iso_builtin'(atomic(_)).
+'$iso_builtin'(bagof(_,_,_)).
+'$iso_builtin'(call(_)).
+'$iso_builtin'(call(_,_)).
+'$iso_builtin'(call(_,_,_)).
+'$iso_builtin'(call(_,_,_,_)).
+'$iso_builtin'(call(_,_,_,_,_)).
+'$iso_builtin'(call(_,_,_,_,_,_)).
+'$iso_builtin'(call(_,_,_,_,_,_,_)).
+'$iso_builtin'(call(_,_,_,_,_,_,_,_)).
+'$iso_builtin'(callable(_)).
+'$iso_builtin'(catch(_,_,_)).
+'$iso_builtin'(char_code(_,_)).
+'$iso_builtin'(char_conversion(_,_)).
+'$iso_builtin'(clause(_,_)).
+'$iso_builtin'(close(_)).
+'$iso_builtin'(close(_,_)).
+'$iso_builtin'(compare(_,_,_)).
+'$iso_builtin'(compound(_)).
+'$iso_builtin'((_,_)).
+'$iso_builtin'(copy_term(_,_)).
+'$iso_builtin'(current_char_conversion(_,_)).
+'$iso_builtin'(current_input(_)).
+'$iso_builtin'(current_op(_,_,_)).
+'$iso_builtin'(current_output(_)).
+'$iso_builtin'(current_predicate(_)).
+'$iso_builtin'(current_prolog_flag(_,_)).
+'$iso_builtin'(!).
+'$iso_builtin'((_;_)).
+'$iso_builtin'(fail).
+'$iso_builtin'(false).
+'$iso_builtin'(findall(_,_,_)).
+'$iso_builtin'(float(_)).
+'$iso_builtin'(abort).
+'$iso_builtin'(flush_output).
+'$iso_builtin'(flush_output(_)).
+'$iso_builtin'(functor(_,_,_)).
+'$iso_builtin'(get_byte(_)).
+'$iso_builtin'(get_byte(_,_)).
+'$iso_builtin'(get_char(_)).
+'$iso_builtin'(get_char(_,_)).
+'$iso_builtin'(get_code(_)).
+'$iso_builtin'(get_code(_,_)).
+'$iso_builtin'(ground(_)).
+'$iso_builtin'(halt).
+'$iso_builtin'(halt(_)).
+'$iso_builtin'((_->_)).
+'$iso_builtin'(integer(_)).
+'$iso_builtin'(_ is _).
+'$iso_builtin'(keysort(_,_)).
+'$iso_builtin'(nl).
+'$iso_builtin'(nl(_)).
+'$iso_builtin'(nonvar(_)).
+'$iso_builtin'(\+(_)).
+'$iso_builtin'(number(_)).
+'$iso_builtin'(number_chars(_,_)).
+'$iso_builtin'(number_codes(_,_)).
+'$iso_builtin'(once(_)).
+'$iso_builtin'(op(_,_,_)).
+'$iso_builtin'(open(_,_,_)).
+'$iso_builtin'(open(_,_,_,_)).
+'$iso_builtin'(peek_byte(_)).
+'$iso_builtin'(peek_byte(_,_)).
+'$iso_builtin'(peek_char(_)).
+'$iso_builtin'(peek_char(_,_)).
+'$iso_builtin'(peek_code(_)).
+'$iso_builtin'(peek_code(_,_)).
+'$iso_builtin'(put_byte(_)).
+'$iso_builtin'(put_byte(_,_)).
+'$iso_builtin'(put_char(_)).
+'$iso_builtin'(put_char(_,_)).
+'$iso_builtin'(put_code(_)).
+'$iso_builtin'(put_code(_,_)).
+'$iso_builtin'(read(_)).
+'$iso_builtin'(read(_,_)).
+'$iso_builtin'(read_term(_,_)).
+'$iso_builtin'(read_term(_,_,_)).
+'$iso_builtin'(repeat).
+'$iso_builtin'(retract(_)).
+'$iso_builtin'(retractall(_)).
+'$iso_builtin'(set_input(_)).
+'$iso_builtin'(set_output(_)).
+'$iso_builtin'(set_prolog_flag(_,_)).
+'$iso_builtin'(set_stream_position(_,_)).
+'$iso_builtin'(setof(_,_,_)).
+'$iso_builtin'(sort(_,_)).
+'$iso_builtin'(stream_property(_,_)).
+'$iso_builtin'(sub_atom(_,_,_,_,_)).
+'$iso_builtin'(subsumes_term(_,_)).
+'$iso_builtin'(_@>_).
+'$iso_builtin'(_@>=_).
+'$iso_builtin'(_==_).
+'$iso_builtin'(_@<_).
+'$iso_builtin'(_@=<_).
+'$iso_builtin'(_\==_).
+'$iso_builtin'(term_variables(_,_)).
+'$iso_builtin'(throw(_)).
+'$iso_builtin'(true).
+'$iso_builtin'(_\=_).
+'$iso_builtin'(_=_).
+'$iso_builtin'(unify_with_occurs_check(_,_)).
+'$iso_builtin'(_384=.._385).
+'$iso_builtin'(var(_)).
+'$iso_builtin'(write(_)).
+'$iso_builtin'(write(_,_)).
+'$iso_builtin'(write_canonical(_)).
+'$iso_builtin'(write_canonical(_,_)).
+'$iso_builtin'(write_term(_,_)).
+'$iso_builtin'(write_term(_,_,_)).
+'$iso_builtin'(writeq(_)).
+'$iso_builtin'(writeq(_,_)).
+

packages/python/swig/yap4py/prolog/pl/swi.yap

@@ -0,0 +1,103 @@
+:- module('$swi',
+	  []).
+
+%%	file_alias_path(-Alias, ?Dir) is nondet.
+%
+%	True if file Alias points to Dir.  Multiple solutions are
+%	generated with the longest directory first.
+
+%%	file_name_on_path(+File:atom, -OnPath) is det.
+%
+%	True if OnPath a description of File   based  on the file search
+%	path. This performs the inverse of absolute_file_name/3.
+
+prolog:file_name_on_path(Path, ShortId) :-
+	(   prolog:file_alias_path(Alias, Dir),
+	    atom_concat(Dir, Local, Path)
+	->  (   Alias == '.'
+	    ->  ShortId = Local
+	    ;   file_name_extension(Base, pl, Local)
+	    ->  ShortId =.. [Alias, Base]
+	    ;   ShortId =.. [Alias, Local]
+	    )
+	;   ShortId = Path
+	).
+
+
+:- dynamic
+	alias_cache/2.
+
+prolog:file_alias_path(Alias, Dir) :-
+	(   alias_cache(_, _)
+	->  true
+	;   build_alias_cache
+	),
+	(   nonvar(Dir)
+	->  ensure_slash(Dir, DirSlash),
+	    alias_cache(Alias, DirSlash)
+	;   alias_cache(Alias, Dir)
+	).
+
+build_alias_cache :-
+	findall(t(DirLen, AliasLen, Alias, Dir),
+		search_path(Alias, Dir, AliasLen, DirLen), Ts),
+	sort(Ts, List0),
+	reverse(List0, List),
+	forall(lists:member(t(_, _, Alias, Dir), List),
+	       assert(alias_cache(Alias, Dir))).
+
+search_path('.', Here, 999, DirLen) :-
+	working_directory(Here0, Here0),
+	ensure_slash(Here0, Here),
+	atom_length(Here, DirLen).
+search_path(Alias, Dir, AliasLen, DirLen) :-
+	user:file_search_path(Alias, _),
+	Alias \== autoload,
+	Spec =.. [Alias,'.'],
+	atom_length(Alias, AliasLen0),
+	AliasLen is 1000 - AliasLen0,	% must do reverse sort
+	absolute_file_name(Spec, Dir0,
+			   [ file_type(directory),
+			     access(read),
+			     solutions(all),
+			     file_errors(fail)
+			   ]),
+	ensure_slash(Dir0, Dir),
+	atom_length(Dir, DirLen).
+
+ensure_slash(Dir, Dir) :-
+	sub_atom(Dir, _, _, 0, /), !.
+ensure_slash(Dir0, Dir) :-
+	atom_concat(Dir0, /, Dir).
+
+
+/** @pred reverse(+ _List_, ? _Reversed_) 
+
+
+True when  _List_ and  _Reversed_ are lists with the same elements
+but in opposite orders. 
+
+ 
+*/
+reverse(List, Reversed) :-
+	reverse(List, [], Reversed).
+
+reverse([], Reversed, Reversed).
+reverse([Head|Tail], Sofar, Reversed) :-
+	reverse(Tail, [Head|Sofar], Reversed).
+
+
+%%      win_add_dll_directory(+AbsDir) is det.
+%
+%       Add AbsDir to the directories where  dependent DLLs are searched
+%       on Windows systems.
+
+:- if(current_prolog_flag(windows, true)).
+prolog:win_add_dll_directory(Dir) :-
+        win_add_dll_directory(Dir, _), !.
+prolog:win_add_dll_directory(Dir) :-
+        prolog_to_os_filename(Dir, OSDir),
+        getenv('PATH', Path0),
+        atomic_list_concat([Path0, OSDir], ';', Path),
+        setenv('PATH', Path).
+:- endif.

packages/python/swig/yap4py/prolog/pl/tabling.yap

@@ -0,0 +1,534 @@
+:- system_module( '$_tabling', [abolish_table/1,
+        global_trie_statistics/0,
+        is_tabled/1,
+        show_all_local_tables/0,
+        show_all_tables/0,
+        show_global_trie/0,
+        show_table/1,
+        show_table/2,
+        show_tabled_predicates/0,
+        (table)/1,
+        table_statistics/1,
+        table_statistics/2,
+        tabling_mode/2,
+        tabling_statistics/0,
+        tabling_statistics/2], []).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+/** @defgroup Tabling Tabling
+@ingroup extensions
+@{
+
+ *YAPTab* is the tabling engine that extends YAP's execution
+model to support tabled evaluation for definite programs. YAPTab was
+implemented by Ricardo Rocha and its implementation is largely based
+on the ground-breaking design of the XSB Prolog system, which
+implements the SLG-WAM. Tables are implemented using tries and YAPTab
+supports the dynamic intermixing of batched scheduling and local
+scheduling at the subgoal level. Currently, the following restrictions
+are of note:
+
++ YAPTab does not handle tabled predicates with loops through negation (undefined behaviour).
++ YAPTab does not handle tabled predicates with cuts (undefined behaviour).
++ YAPTab does not support coroutining (configure error).
++ YAPTab does not support tabling dynamic predicates (permission error).
+
+
+To experiment with YAPTab use `--enable-tabling` in the configure
+script or add `-DTABLING` to `YAP_EXTRAS` in the system's
+`Makefile`. We next describe the set of built-ins predicates
+designed to interact with YAPTab and control tabled execution:
+
+ 
+*/
+
+/*
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                     %%
+%%                   The YapTab/YapOr/OPTYap systems                   %%
+%%                                                                     %%
+%% YapTab extends the Yap Prolog engine to support sequential tabling  %%
+%% YapOr extends the Yap Prolog engine to support or-parallelism       %%
+%% OPTYap extends the Yap Prolog engine to support or-parallel tabling %%
+%%                                                                     %%
+%%                                                                     %%
+%%      Yap Prolog was developed at University of Porto, Portugal      %%
+%%                                                                     %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+*/
+
+/**
+YapTab extends the Yap Prolog engine to support sequential tabling. YapOr extends the Yap Prolog engine to support or-parallelism. YapOr extends the Yap Prolog engine to support or-parallelism.
+*/
+
+
+/** @pred abolish_table(+ _P_) 
+
+
+Removes all the entries from the table space for predicate  _P_ (or
+a list of predicates  _P1_,..., _Pn_ or
+[ _P1_,..., _Pn_]). The predicate remains as a tabled predicate.
+
+ 
+*/
+/** @pred is_tabled(+ _P_) 
+
+
+Succeeds if the predicate  _P_ (or a list of predicates
+ _P1_,..., _Pn_ or [ _P1_,..., _Pn_]), of the form
+ _name/arity_, is a tabled predicate.
+
+ 
+*/
+/** @pred show_table(+ _P_) 
+
+
+Prints table contents (subgoals and answers) for predicate  _P_
+(or a list of predicates  _P1_,..., _Pn_ or
+[ _P1_,..., _Pn_]).
+
+ 
+*/
+/** @pred table( + _P_ )
+
+
+Declares predicate  _P_ (or a list of predicates
+ _P1_,..., _Pn_ or [ _P1_,..., _Pn_]) as a tabled
+predicate.  _P_ must be written in the form
+ _name/arity_. Examples:
+
+~~~~~
+:- table son/3.
+:- table father/2.
+:- table mother/2.
+~~~~~
+ or
+
+~~~~~
+:- table son/3, father/2, mother/2.
+~~~~~
+ or
+
+~~~~~
+:- table [son/3, father/2, mother/2].
+~~~~~
+
+ 
+*/
+/** @pred table_statistics(+ _P_) 
+
+
+Prints table statistics (subgoals and answers) for predicate  _P_
+(or a list of predicates  _P1_,..., _Pn_ or
+[ _P1_,..., _Pn_]).
+
+ 
+*/
+/** @pred tabling_mode(+ _P_,? _Mode_) 
+
+
+Sets or reads the default tabling mode for a tabled predicate  _P_
+(or a list of predicates  _P1_,..., _Pn_ or
+[ _P1_,..., _Pn_]). The list of  _Mode_ options includes:
+
++ `batched`
+
+    Defines that, by default, batched scheduling is the scheduling
+strategy to be used to evaluated calls to predicate  _P_.
+
++ `local`
+
+    Defines that, by default, local scheduling is the scheduling
+strategy to be used to evaluated calls to predicate  _P_.
+
++ `exec_answers`
+
+    Defines that, by default, when a call to predicate  _P_ is
+already evaluated (completed), answers are obtained by executing
+compiled WAM-like code directly from the trie data
+structure. This reduces the loading time when backtracking, but
+the order in which answers are obtained is undefined.
+
++ `load_answers`
+  
+   Defines that, by default, when a call to predicate  _P_ is
+already evaluated (completed), answers are obtained (as a
+consumer) by loading them from the trie data structure. This
+guarantees that answers are obtained in the same order as they
+were found. Somewhat less efficient but creates less choice-points.
+
+The default tabling mode for a new tabled predicate is `batched`
+and `exec_answers`. To set the tabling mode for all predicates at
+once you can use the yap_flag/2 predicate as described next.
+ 
+*/
+:- meta_predicate 
+   table(:), 
+   is_tabled(:), 
+   tabling_mode(:,?), 
+   abolish_table(:), 
+   show_table(:), 
+   show_table(?,:), 
+   table_statistics(:),
+   table_statistics(?,:).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                      show_tabled_predicates/0                       %%
+%%                         show_global_trie/0                          %%
+%%                          show_all_tables/0                          %%
+%%                       show_all_local_tables/0                       %%
+%%                      global_trie_statistics/0                       %%
+%%                        tabling_statistics/0                         %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+show_tabled_predicates :- 
+   current_output(Stream),
+   show_tabled_predicates(Stream).
+
+show_global_trie :-
+   current_output(Stream),
+   show_global_trie(Stream).
+
+show_all_tables :-
+   current_output(Stream),
+   show_all_tables(Stream).
+
+show_all_local_tables :-
+   current_output(Stream),
+   show_all_local_tables(Stream).
+
+global_trie_statistics :-
+   current_output(Stream),
+   global_trie_statistics(Stream).
+
+/** @pred tabling_statistics/0 
+
+
+Prints statistics on space used by all tables.
+
+
+
+ */
+tabling_statistics :-
+   current_output(Stream),
+   tabling_statistics(Stream).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                        tabling_statistics/2                         %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% should match with code in OPTYap/opt.preds.c
+tabling_statistics(total_memory,[BytesInUse,BytesAllocated]) :-
+   '$c_get_optyap_statistics'(0,BytesInUse,BytesAllocated).
+tabling_statistics(table_entries,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(1,BytesInUse,StructsInUse).
+tabling_statistics(subgoal_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(2,BytesInUse,StructsInUse).
+tabling_statistics(dependency_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(3,BytesInUse,StructsInUse).
+tabling_statistics(subgoal_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(6,BytesInUse,StructsInUse).
+tabling_statistics(answer_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(7,BytesInUse,StructsInUse).
+tabling_statistics(subgoal_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(8,BytesInUse,StructsInUse).
+tabling_statistics(answer_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(9,BytesInUse,StructsInUse).
+tabling_statistics(global_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(10,BytesInUse,StructsInUse).
+tabling_statistics(global_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(11,BytesInUse,StructsInUse).
+tabling_statistics(subgoal_entries,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(16,BytesInUse,StructsInUse).
+tabling_statistics(answer_ref_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(17,BytesInUse,StructsInUse).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                               table/1                               %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+table(Pred) :-
+   '$current_module'(Mod),
+   '$do_table'(Mod,Pred).
+
+'$do_table'(Mod,Pred) :-
+    var(Pred), !,
+   '$do_error'(instantiation_error,table(Mod:Pred)).
+'$do_table'(_,Mod:Pred) :- !,
+   '$do_table'(Mod,Pred).
+'$do_table'(_,[]) :- !.
+'$do_table'(Mod,[HPred|TPred]) :- !,
+   '$do_table'(Mod,HPred),
+   '$do_table'(Mod,TPred).
+'$do_table'(Mod,(Pred1,Pred2)) :- !,
+   '$do_table'(Mod,Pred1),
+   '$do_table'(Mod,Pred2).
+'$do_table'(Mod,PredName/PredArity) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity), !,
+   '$set_table'(Mod,PredFunctor,[]).
+'$do_table'(Mod,PredDeclaration) :- 
+    PredDeclaration=..[PredName|PredList],
+    '$transl_to_mode_list'(PredList,PredModeList,PredArity),
+    functor(PredFunctor,PredName,PredArity), !,
+    '$set_table'(Mod,PredFunctor,PredModeList).
+'$do_table'(Mod,Pred) :-
+   '$do_pi_error'(type_error(callable,Pred),table(Mod:Pred)).
+
+'$set_table'(Mod,PredFunctor,_PredModeList) :-
+   '$undefined'('$c_table'(_,_,_),prolog), !,
+   functor(PredFunctor, PredName, PredArity),
+   '$do_error'(resource_error(tabling,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
+'$set_table'(Mod,PredFunctor,PredModeList) :-
+   '$undefined'(PredFunctor,Mod), !,
+   '$c_table'(Mod,PredFunctor,PredModeList).
+'$set_table'(Mod,PredFunctor,_PredModeList) :-
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags),
+   Flags /\ 0x00000040 =:= 0x00000040, !.
+'$set_table'(Mod,PredFunctor,PredModeList) :-
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags),
+   Flags /\ 0x1991F8C0 =:= 0,
+   '$c_table'(Mod,PredFunctor,PredModeList), !.
+'$set_table'(Mod,PredFunctor,_PredModeList) :-
+   functor(PredFunctor,PredName,PredArity), 
+   '$do_error'(permission_error(modify,table,Mod:PredName/PredArity),table(Mod:PredName/PredArity)).
+
+'$transl_to_mode_list'([],[],0) :- !.
+'$transl_to_mode_list'([TextualMode|L],[Mode|ModeList],Arity) :-
+    '$transl_to_mode_directed_tabling'(TextualMode,Mode),
+    '$transl_to_mode_list'(L,ModeList,ListArity),
+    Arity is ListArity + 1.
+
+%% should match with code in OPTYap/tab.macros.h
+'$transl_to_mode_directed_tabling'(index,1).
+'$transl_to_mode_directed_tabling'(min,2).
+'$transl_to_mode_directed_tabling'(max,3).
+'$transl_to_mode_directed_tabling'(all,4).
+'$transl_to_mode_directed_tabling'(sum,5).
+'$transl_to_mode_directed_tabling'(last,6).
+'$transl_to_mode_directed_tabling'(first,7).
+%% B-Prolog compatibility
+'$transl_to_mode_directed_tabling'(+,1).
+'$transl_to_mode_directed_tabling'(@,4).
+'$transl_to_mode_directed_tabling'(-,7).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                             is_tabled/1                             %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+is_tabled(Pred) :- 
+   '$current_module'(Mod), 
+   '$do_is_tabled'(Mod,Pred).
+
+'$do_is_tabled'(Mod,Pred) :- 
+   var(Pred), !, 
+   '$do_error'(instantiation_error,is_tabled(Mod:Pred)).
+'$do_is_tabled'(_,Mod:Pred) :- !, 
+   '$do_is_tabled'(Mod,Pred).
+'$do_is_tabled'(_,[]) :- !.
+'$do_is_tabled'(Mod,[HPred|TPred]) :- !,
+   '$do_is_tabled'(Mod,HPred),
+   '$do_is_tabled'(Mod,TPred).
+'$do_is_tabled'(Mod,(Pred1,Pred2)) :- !,
+   '$do_is_tabled'(Mod,Pred1),
+   '$do_is_tabled'(Mod,Pred2).
+'$do_is_tabled'(Mod,PredName/PredArity) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity),
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
+   Flags /\ 0x000040 =\= 0.
+'$do_is_tabled'(Mod,Pred) :- 
+   '$do_pi_error'(type_error(callable,Pred),is_tabled(Mod:Pred)).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                            tabling_mode/2                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+tabling_mode(Pred,Options) :- 
+   '$current_module'(Mod), 
+   '$do_tabling_mode'(Mod,Pred,Options).
+
+'$do_tabling_mode'(Mod,Pred,Options) :- 
+   var(Pred), !, 
+   '$do_error'(instantiation_error,tabling_mode(Mod:Pred,Options)).
+'$do_tabling_mode'(_,Mod:Pred,Options) :- !, 
+   '$do_tabling_mode'(Mod,Pred,Options).
+'$do_tabling_mode'(_,[],_) :- !.
+'$do_tabling_mode'(Mod,[HPred|TPred],Options) :- !,
+   '$do_tabling_mode'(Mod,HPred,Options),
+   '$do_tabling_mode'(Mod,TPred,Options).
+'$do_tabling_mode'(Mod,(Pred1,Pred2),Options) :- !,
+   '$do_tabling_mode'(Mod,Pred1,Options),
+   '$do_tabling_mode'(Mod,Pred2,Options).
+'$do_tabling_mode'(Mod,PredName/PredArity,Options) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity),
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
+   (
+       Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options)
+   ;
+       '$do_error'(domain_error(table,Mod:PredName/PredArity),tabling_mode(Mod:PredName/PredArity,Options))
+   ).
+'$do_tabling_mode'(Mod,Pred,Options) :- 
+   '$do_pi_error'(type_error(callable,Pred),tabling_mode(Mod:Pred,Options)).
+
+'$set_tabling_mode'(Mod,PredFunctor,Options) :-
+   var(Options), !,
+   '$c_tabling_mode'(Mod,PredFunctor,Options).
+'$set_tabling_mode'(_,_,[]) :- !.
+'$set_tabling_mode'(Mod,PredFunctor,[HOption|TOption]) :- !,
+   '$set_tabling_mode'(Mod,PredFunctor,HOption),
+   '$set_tabling_mode'(Mod,PredFunctor,TOption).
+'$set_tabling_mode'(Mod,PredFunctor,(Option1,Option2)) :- !,
+   '$set_tabling_mode'(Mod,PredFunctor,Option1),
+   '$set_tabling_mode'(Mod,PredFunctor,Option2).
+'$set_tabling_mode'(Mod,PredFunctor,Option) :- 
+   '$transl_to_pred_flag_tabling_mode'(Flag,Option), !,
+   '$c_tabling_mode'(Mod,PredFunctor,Flag).
+'$set_tabling_mode'(Mod,PredFunctor,Options) :- 
+   functor(PredFunctor,PredName,PredArity), 
+   '$do_error'(domain_error(flag_value,tabling_mode+Options),tabling_mode(Mod:PredName/PredArity,Options)).
+
+%% should match with code in OPTYap/opt.preds.c
+'$transl_to_pred_flag_tabling_mode'(1,batched).
+'$transl_to_pred_flag_tabling_mode'(2,local).
+'$transl_to_pred_flag_tabling_mode'(3,exec_answers).
+'$transl_to_pred_flag_tabling_mode'(4,load_answers).
+'$transl_to_pred_flag_tabling_mode'(5,local_trie).
+'$transl_to_pred_flag_tabling_mode'(6,global_trie).
+'$transl_to_pred_flag_tabling_mode'(7,coinductive).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                           abolish_table/1                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+abolish_table(Pred) :-
+   '$current_module'(Mod),
+   '$do_abolish_table'(Mod,Pred).
+
+'$do_abolish_table'(Mod,Pred) :-
+   var(Pred), !,
+   '$do_error'(instantiation_error,abolish_table(Mod:Pred)).
+'$do_abolish_table'(_,Mod:Pred) :- !,
+   '$do_abolish_table'(Mod,Pred).
+'$do_abolish_table'(_,[]) :- !.
+'$do_abolish_table'(Mod,[HPred|TPred]) :- !,
+   '$do_abolish_table'(Mod,HPred),
+   '$do_abolish_table'(Mod,TPred).
+'$do_abolish_table'(Mod,(Pred1,Pred2)) :- !,
+   '$do_abolish_table'(Mod,Pred1),
+   '$do_abolish_table'(Mod,Pred2).
+'$do_abolish_table'(Mod,PredName/PredArity) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity),
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
+   (
+       Flags /\ 0x000040 =\= 0, !, '$c_abolish_table'(Mod,PredFunctor)
+   ;
+       '$do_error'(domain_error(table,Mod:PredName/PredArity),abolish_table(Mod:PredName/PredArity))
+   ).
+'$do_abolish_table'(Mod,Pred) :-
+   '$do_pi_error'(type_error(callable,Pred),abolish_table(Mod:Pred)).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                             show_table/1                            %%
+%%                             show_table/2                            %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+show_table(Pred) :-
+   current_output(Stream),
+   show_table(Stream,Pred).
+
+show_table(Stream,Pred) :-
+   '$current_module'(Mod),
+   '$do_show_table'(Stream,Mod,Pred).
+
+'$do_show_table'(_,Mod,Pred) :-
+   var(Pred), !,
+   '$do_error'(instantiation_error,show_table(Mod:Pred)).
+'$do_show_table'(Stream,_,Mod:Pred) :- !,
+   '$do_show_table'(Stream,Mod,Pred).
+'$do_show_table'(_,_,[]) :- !.
+'$do_show_table'(Stream,Mod,[HPred|TPred]) :- !,
+   '$do_show_table'(Stream,Mod,HPred),
+   '$do_show_table'(Stream,Mod,TPred).
+'$do_show_table'(Stream,Mod,(Pred1,Pred2)) :- !,
+   '$do_show_table'(Stream,Mod,Pred1),
+   '$do_show_table'(Stream,Mod,Pred2).
+'$do_show_table'(Stream,Mod,PredName/PredArity) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity),
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
+   (
+       Flags /\ 0x000040 =\= 0, !, '$c_show_table'(Stream,Mod,PredFunctor)
+   ;
+       '$do_error'(domain_error(table,Mod:PredName/PredArity),show_table(Mod:PredName/PredArity))
+   ).
+'$do_show_table'(_,Mod,Pred) :-
+   '$do_pi_error'(type_error(callable,Pred),show_table(Mod:Pred)).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                         table_statistics/1                          %%
+%%                         table_statistics/2                          %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+table_statistics(Pred) :-
+   current_output(Stream),
+   table_statistics(Stream,Pred).
+
+table_statistics(Stream,Pred) :-
+   '$current_module'(Mod),
+   '$do_table_statistics'(Stream,Mod,Pred).
+
+'$do_table_statistics'(_,Mod,Pred) :-
+   var(Pred), !,
+   '$do_error'(instantiation_error,table_statistics(Mod:Pred)).
+'$do_table_statistics'(Stream,_,Mod:Pred) :- !,
+   '$do_table_statistics'(Stream,Mod,Pred).
+'$do_table_statistics'(_,_,[]) :- !.
+'$do_table_statistics'(Stream,Mod,[HPred|TPred]) :- !,
+   '$do_table_statistics'(Stream,Mod,HPred),
+   '$do_table_statistics'(Stream,Mod,TPred).
+'$do_table_statistics'(Stream,Mod,(Pred1,Pred2)) :- !,
+   '$do_table_statistics'(Stream,Mod,Pred1),
+   '$do_table_statistics'(Stream,Mod,Pred2).
+'$do_table_statistics'(Stream,Mod,PredName/PredArity) :- 
+   atom(PredName), 
+   integer(PredArity),
+   functor(PredFunctor,PredName,PredArity),
+   '$predicate_flags'(PredFunctor,Mod,Flags,Flags), !,
+   (
+       Flags /\ 0x000040 =\= 0, !, '$c_table_statistics'(Stream,Mod,PredFunctor)
+   ;
+       '$do_error'(domain_error(table,Mod:PredName/PredArity),table_statistics(Mod:PredName/PredArity))
+   ).
+'$do_table_statistics'(_,Mod,Pred) :-
+   '$do_pi_error'(type_error(callable,Pred),table_statistics(Mod:Pred)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/udi.yap

@@ -0,0 +1,27 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2010	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		udi.yap							 *
+* Last rev:	17/12/2012						 *
+* mods:									 *
+* comments:	support user defined indexing				 *
+*									 *
+*************************************************************************/
+
+:- system_module( '$_udi', [udi/1], []).
+
+:- meta_predicate udi(:).
+
+/******************
+*     udi/1     *
+******************/
+
+udi(Pred) :-
+   '$udi_init'(Pred).

packages/python/swig/yap4py/prolog/pl/undefined.yap

@@ -0,0 +1,152 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		undefined.yap						 *
+* Last rev:	8/2/88							 *
+* mods:									 *
+* comments:	Predicate Undefined for YAP				 *
+*									 *
+*************************************************************************/
+
+/** @defgroup Undefined_Procedures Handling Undefined Procedures
+@ingroup YAPControl
+@{
+
+A predicate in a module is said to be undefined if there are no clauses
+defining the predicate, and if the predicate has not been declared to be
+dynamic. What YAP does when trying to execute undefined predicates can
+be specified in three different ways:
+
+
++ By setting an YAP flag, through the yap_flag/2 or
+set_prolog_flag/2 built-ins. This solution generalizes the
+ISO standard by allowing module-specific behavior.
++ By using the unknown/2 built-in (this deprecated solution is
+compatible with previous releases of YAP).
++ By defining clauses for the hook predicate
+`user:unknown_predicate_handler/3`. This solution is compatible
+with SICStus Prolog.
+
+
+*/
+
+/**  @pred  user:unknown_predicate_handler(+ _Call_, + _M_, - _N_)
+
+In YAP, the default action on undefined predicates is to output an
+`error` message. Alternatives are to silently `fail`, or to print a
+`warning` message and then fail.  This follows the ISO Prolog standard
+where the default action is `error`.
+
+The user:unknown_predicate_handler/3 hook was originally include in
+SICStus Prolog. It allows redefining the answer for specifici
+calls. As an example. after defining `undefined/1` by:
+
+~~~~~{.prolog}
+undefined(A) :- format('Undefined predicate: ~w~n',[A]), fail.
+~~~~~
+and executing the goal:
+
+~~~~~{.prolog}
+:- assert(user:unknown_predicate_handler(U,M,undefined(M:U)) )
+~~~~~
+a call to a predicate for which no clauses were defined will result in
+the output of a message of the form:
+
+~~~~~{.prolog}
+Undefined predicate: user:xyz(A1,A2)
+~~~~~
+followed by the failure of that call.
+*/
+:- multifile user:unknown_predicate_handler/3.
+
+'$handle_error'(error,Goal,Mod) :-
+    functor(Goal,Name,Arity),
+    'program_continuation'(PMod,PName,PAr),
+    '$do_error'(existence_error(procedure,Name/Arity),
+           context(Mod:Goal,PMod:PName/PAr)).
+'$handle_error'(warning,Goal,Mod) :-
+    functor(Goal,Name,Arity),
+    'program_continuation'(PMod,PName,PAr),
+    print_message(warning,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
+    fail.
+'$handle_error'(fail,_Goal,_Mod) :-
+    fail.
+
+:- '$set_no_trace'('$handle_error'(_,_,_), prolog).
+
+/**
+ * @pred '$undefp_expand'(+ M0:G0, -MG)
+ *
+ * @param G0 input goal
+ * @param M0 current module
+ * @param G1 new goal
+ *
+ * @return succeeds on finding G1, otherwise fails.
+ *
+ * Tries:
+ *   1 - `user:unknown_predicate_handler`
+ *   2 - `goal_expansion`
+ *   1 - `import` mechanism`
+*/
+'$undefp_search'(M0:G0, MG) :-
+    '$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
+    '$yap_strip_module'(M0:G0,  EM0, GM0),
+    user:unknown_predicate_handler(GM0,EM0,M1:G1),
+    !,
+    expand_goal(M1:G1, MG).
+'$undefp_search'(MG, FMG) :-
+    expand_goal(MG, FMG).
+
+
+% undef handler
+'$undefp'([M0|G0], Action) :-
+    % make sure we do not loop on undefined predicates
+    yap_flag( unknown, Action, fail),
+    '$stop_creeping'(Current),
+ %   yap_flag( debug, Debug, false),
+    (
+     '$undefp_search'(M0:G0, NM:NG),
+     ( M0 \== NM -> true  ; G0 \== NG ),
+     NG \= fail
+     ->
+	 yap_flag( unknown, _, Action),
+	 %   yap_flag( debug, _, Debug),
+	 (
+	     Current == true
+	  ->
+	      % carry on signal processing
+	      '$start_creep'([NM|NG], creep)
+	  ;
+	  '$execute0'(NG, NM)
+	 )
+     ;
+     yap_flag( unknown, _, Action),
+     '$handle_error'(Action,G0,M0)
+    ).
+
+:- '$undefp_handler'('$undefp'(_,_), prolog).
+
+/** @pred  unknown(- _O_,+ _N_)
+
+The unknown predicate, informs about what the user wants to be done
+	when there are no clauses for a predicate. Using unknown/3 is
+	strongly deprecated. We recommend setting the `unknown` prolog
+	flag for generic behaviour, and calling the hook
+	user:unknown_predicate_handler/3 to fine-tune specific cases
+	undefined goals.
+
+*/
+
+unknown(P, NP) :-
+    prolog_flag( unknown, P, NP ).
+
+/**
+@}
+*/

packages/python/swig/yap4py/prolog/pl/utils.yap

@@ -0,0 +1,377 @@
+ /*************************************************************************
+ *									 *
+ *	 YAP Prolog 							 *
+ *									 *
+ *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+ *									 *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+ *									 *
+ **************************************************************************
+ *									 *
+ * File:		utils.yap						 *
+ * Last rev:	8/2/88							 *
+ * mods:									 *
+ * comments:	Some utility predicates available in yap		 *
+ *									 *
+ *************************************************************************/
+
+:- system_module( '$_utils', [callable/1,
+        current_op/3,
+        nb_current/2,
+        nth_instance/3,
+        nth_instance/4,
+        op/3,
+        prolog/0,
+        recordaifnot/3,
+        recordzifnot/3,
+        simple/1,
+        subsumes_term/2], ['$getval_exception'/3]).
+
+:- use_system_module( '$_boot', ['$live'/0]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+
+/** @pred op(+ _P_,+ _T_,+ _A_) is iso
+
+
+Defines the operator  _A_ or the list of operators  _A_ with type
+ _T_ (which must be one of `xfx`, `xfy`,`yfx`,
+`xf`, `yf`, `fx` or `fy`) and precedence  _P_
+(see appendix iv for a list of predefined operators).
+
+Note that if there is a preexisting operator with the same name and
+type, this operator will be discarded. Also, `,` may not be defined
+as an operator, and it is not allowed to have the same for an infix and
+a postfix operator.
+
+
+*/
+ op(P,T,V) :-
+	 '$check_op'(P,T,V,op(P,T,V)),
+	 '$op'(P, T, V).
+
+% just check the operator declarations for correctness.
+'$check_op'(P,T,Op,G) :-
+	( var(P) ; var(T); var(Op)), !,
+	'$do_error'(instantiation_error,G).
+'$check_op'(P,_,_,G) :-
+	\+ integer(P), !,
+	'$do_error'(type_error(integer,P),G).
+'$check_op'(P,_,_,G) :-
+	P < 0, !,
+	'$do_error'(domain_error(operator_priority,P),G).
+'$check_op'(_,T,_,G) :-
+	\+ atom(T), !,
+	'$do_error'(type_error(atom,T),G).
+'$check_op'(_,T,_,G) :-
+	\+  '$associativity'(T), !,
+	'$do_error'(domain_error(operator_specifier,T),G).
+'$check_op'(P,T,V,G) :-
+	'$check_module_for_op'(V, G, NV),
+	'$check_top_op'(P, T, NV, G).
+
+'$check_top_op'(_, _, [], _) :- !.
+'$check_top_op'(P, T, [Op|NV], G) :- !,
+	'$check_ops'(P, T, [Op|NV], G).
+'$check_top_op'(P, T, V, G) :-
+	atom(V), !,
+	'$check_op_name'(P, T, V, G).
+'$check_top_op'(_P, _T, V, G) :-
+	'$do_error'(type_error(atom,V),G).
+
+ '$associativity'(xfx).
+ '$associativity'(xfy).
+ '$associativity'(yfx).
+ '$associativity'(yfy).
+ '$associativity'(xf).
+ '$associativity'(yf).
+ '$associativity'(fx).
+ '$associativity'(fy).
+
+'$check_module_for_op'(MOp, G, _) :-
+	var(MOp), !,
+	'$do_error'(instantiation_error,G).
+'$check_module_for_op'(M:_V, G, _) :-
+	var(M), !,
+	'$do_error'(instantiation_error,G).
+'$check_module_for_op'(M:V, G, NV) :-
+	atom(M), !,
+	'$check_module_for_op'(V, G, NV).
+'$check_module_for_op'(M:_V, G, _) :- !,
+	'$do_error'(type_error(atom,M),G).
+'$check_module_for_op'(V, _G, V).
+
+'$check_ops'(_P, _T, [], _G) :- !.
+'$check_ops'(P, T, [Op|NV], G) :- !,
+	(
+	 var(NV)
+	->
+	 '$do_error'(instantiation_error,G)
+	;
+	 '$check_module_for_op'(Op, G, NOp),
+	 '$check_op_name'(P, T, NOp, G),
+	 '$check_ops'(P, T, NV, G)
+	).
+'$check_ops'(_P, _T, Ops, G) :-
+	'$do_error'(type_error(list,Ops),G).
+
+'$check_op_name'(_,_,V,G) :-
+	  var(V), !,
+	  '$do_error'(instantiation_error,G).
+ '$check_op_name'(_,_,',',G) :- !,
+	  '$do_error'(permission_error(modify,operator,','),G).
+'$check_op_name'(_,_,'[]',G) :-  T \= yf, T\= xf, !,
+	  '$do_error'(permission_error(create,operator,'[]'),G).
+'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !,
+	  '$do_error'(permission_error(create,operator,'{}'),G).
+'$check_op_name'(P,T,'|',G) :-
+	 (
+	  integer(P),
+	  P < 1001, P > 0
+	 ;
+	  atom_codes(T,[_,_])
+	 ), !,
+	 '$do_error'(permission_error(create,operator,'|'),G).
+'$check_op_name'(_,_,V,_) :-
+	 atom(V), !.
+'$check_op_name'(_,_,A,G) :-
+	 '$do_error'(type_error(atom,A),G).
+
+'$op'(P, T, ML) :-
+	strip_module(ML, M, [A|As]), !,
+	'$opl'(P, T, M, [A|As]).
+'$op'(P, T, A) :-
+	'$op2'(P,T,A).
+
+'$opl'(_P, _T, _, []).
+'$opl'(P, T, M, [A|As]) :-
+	'$op2'(P, T, M:A),
+	'$opl'(P, T, M, As).
+
+'$op2'(P,T,A) :-
+	atom(A), !,
+	'$opdec'(P,T,A,prolog).
+'$op2'(P,T,A) :-
+	strip_module(A,M,N),
+	'$opdec'(P,T,N,M).
+
+/** @pred current_op( _P_, _T_, _F_) is iso
+
+
+Defines the relation:  _P_ is a currently defined  operator of type
+ _T_ and precedence  _P_.
+
+
+*/
+current_op(X,Y,V) :- var(V), !,
+	'$current_module'(M),
+	'$do_current_op'(X,Y,V,M).
+current_op(X,Y,M:Z) :- !,
+	'$current_opm'(X,Y,Z,M).
+current_op(X,Y,Z) :-
+	'$current_module'(M),
+	'$do_current_op'(X,Y,Z,M).
+
+
+'$current_opm'(X,Y,Z,M) :-
+	nonvar(Y),
+	\+ '$associativity'(Y),
+	'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
+'$current_opm'(X,Y,Z,M) :-
+	var(Z), !,
+	'$do_current_op'(X,Y,Z,M).
+'$current_opm'(X,Y,M:Z,_) :- !,
+	'$current_opm'(X,Y,Z,M).
+'$current_opm'(X,Y,Z,M) :-
+	'$do_current_op'(X,Y,Z,M).
+
+'$do_current_op'(X,Y,Z,M) :-
+	nonvar(Y),
+	\+ '$associativity'(Y),
+	'$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)).
+'$do_current_op'(X,Y,Z,M) :-
+	atom(Z), !,
+	'$current_atom_op'(Z, M1, Prefix, Infix, Posfix),
+	( M1 = prolog -> true ; M1 = M ),
+	(
+	 '$get_prefix'(Prefix, X, Y)
+	;
+	 '$get_infix'(Infix, X, Y)
+	;
+	 '$get_posfix'(Posfix, X, Y)
+	).
+'$do_current_op'(X,Y,Z,M) :-
+	'$current_op'(Z, M1, Prefix, Infix, Posfix),
+	( M1 = prolog -> true ; M1 = M ),
+	(
+	 '$get_prefix'(Prefix, X, Y)
+	;
+	 '$get_infix'(Infix, X, Y)
+	;
+	 '$get_posfix'(Posfix, X, Y)
+	).
+
+'$get_prefix'(Prefix, X, Y) :-
+	Prefix > 0,
+	X is Prefix /\ 0xfff,
+	(
+         0x2000 /\ Prefix =:= 0x2000
+        ->
+         Y = fx
+        ;
+         Y = fy
+        ).
+
+'$get_infix'(Infix, X, Y) :-
+	Infix > 0,
+	X is Infix  /\ 0xfff,
+	(
+         0x3000 /\ Infix =:= 0x3000
+        ->
+         Y = xfx
+	;
+         0x1000 /\ Infix =:= 0x1000
+        ->
+         Y = xfy
+        ;
+         Y = yfx
+        ).
+
+'$get_posfix'(Posfix, X, Y) :-
+	Posfix > 0,
+	X is Posfix /\ 0xfff,
+	(
+         0x1000 /\ Posfix =:= 0x1000
+        ->
+         Y = xf
+	;
+         Y = yf
+        ).
+
+
+prolog :-
+	live.
+
+%%% current ....
+
+/** @pred  callable( _T_) is iso
+
+
+Checks whether  _T_ is a callable term, that is, an atom or a
+compound term.
+
+
+*/
+callable(A) :-
+	( var(A) -> fail ; number(A) -> fail ; true ).
+
+/** @pred  simple( _T_)
+
+
+Checks whether  _T_ is unbound, an atom, or a number.
+
+
+*/
+simple(V) :- var(V), !.
+simple(A) :- atom(A), !.
+simple(N) :- number(N).
+
+/** @pred  nth_instance(? _Key_,? _Index_,? _R_)
+
+
+Fetches the  _Index_nth entry in the internal database under the key
+ _Key_. Entries are numbered from one. If the key  _Key_ or the
+ _Index_ are bound, a reference is unified with  _R_. Otherwise,
+the reference  _R_ must be given, and YAP will find
+the matching key and index.
+
+
+*/
+nth_instance(Key,Index,Ref) :-
+	nonvar(Key), var(Index), var(Ref), !,
+	recorded(Key,_,Ref),
+	'$nth_instance'(_,Index,Ref).
+nth_instance(Key,Index,Ref) :-
+	'$nth_instance'(Key,Index,Ref).
+
+/** @pred  nth_instance(? _Key_,? _Index_, _T_,? _R_)
+
+Fetches the  _Index_nth entry in the internal database under the key
+ _Key_. Entries are numbered from one. If the key  _Key_ or the
+ _Index_ are bound, a reference is unified with  _R_. Otherwise,
+the reference  _R_ must be given, and YAP will find
+the matching key and index.
+
+
+*/
+nth_instance(Key,Index,T,Ref) :-
+	nonvar(Key), var(Index), var(Ref), !,
+	recorded(Key,T,Ref),
+	'$nth_instance'(_,Index,Ref).
+nth_instance(Key,Index,T,Ref) :-
+	'$nth_instance'(Key,Index,Ref),
+	instance(Ref,T).
+
+/** @pred  nb_current(? _Name_, ? _Value_)
+
+
+Enumerate all defined variables with their value. The order of
+enumeration is undefined.
+
+
+*/
+/** @pred nb_current(? _Name_,? _Value_)
+
+
+Enumerate all defined variables with their value. The order of
+enumeration is undefined.
+
+
+*/
+nb_current(GlobalVariable, Val) :-
+	'$nb_current'(GlobalVariable),
+	'$nb_getval'(GlobalVariable, Val, _).
+
+'$getval_exception'(GlobalVariable, _Val, Caller) :-
+	user:exception(undefined_global_variable, GlobalVariable, Action),
+	!,
+	(
+	 Action == fail
+	->
+	 fail
+	;
+	 Action == retry
+	->
+	 true
+	;
+	 Action == error
+	->
+	 '$do_error'(existence_error(variable, GlobalVariable),Caller)
+	;
+	 '$do_error'(type_error(atom, Action),Caller)
+	).
+
+
+/** @pred  subsumes_term(? _Subsumer_, ? _Subsumed_)
+
+
+
+Succeed if  _Submuser_ subsumes  _Subsuned_ but does not bind any
+variable in  _Subsumer_.
+
+
+*/
+subsumes_term(A,B) :-
+	\+ \+ terms:subsumes(A,B).
+
+term_string( T, S, Opts) :-
+    var( T ),
+    !,
+    memory_file:open_mem_read_stream( S, Stream ),
+    read_term( Stream, T, Opts ),
+    close( Stream ).
+    term_string( T, S, _Opts) :-
+        format(string(S), '~q.~n', [T]).
+
+

packages/python/swig/yap4py/prolog/pl/yapor.yap

@@ -0,0 +1,200 @@
+:- system_module( '$_utils', [callable/1,
+        current_op/3,
+        nb_current/2,
+        nth_instance/3,
+        nth_instance/4,
+        op/3,
+        prolog/0,
+        recordaifnot/3,
+        recordzifnot/3,
+        simple/1,
+        subsumes_term/2], ['$getval_exception'/3]).
+
+:- use_system_module( '$_boot', ['$live'/0]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                                                                     %%
+%%                   The YapTab/YapOr/OPTYap systems                   %%
+%%                                                                     %%
+%% YapTab extends the Yap Prolog engine to support sequential tabling  %%
+%% YapOr extends the Yap Prolog engine to support or-parallelism       %%
+%% OPTYap extends the Yap Prolog engine to support or-parallel tabling %%
+%%                                                                     %%
+%%                                                                     %%
+%%      Yap Prolog was developed at University of Porto, Portugal      %%
+%%                                                                     %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- meta_predicate 
+   parallel(0),
+   parallel_findall(?,0,?),
+   parallel_findfirst(?,0,?),
+   parallel_once(0).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                           or_statistics/0                           %%
+%%                          opt_statistics/0                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+or_statistics :-
+   current_output(Stream),
+   or_statistics(Stream).
+
+opt_statistics :-
+   current_output(Stream),
+   opt_statistics(Stream).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                           or_statistics/2                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% should match with code in OPTYap/opt.preds.c
+or_statistics(total_memory,[BytesInUse,BytesAllocated]) :-
+   '$c_get_optyap_statistics'(0,BytesInUse,BytesAllocated).
+or_statistics(or_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(4,BytesInUse,StructsInUse).
+or_statistics(query_goal_solution_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(12,BytesInUse,StructsInUse).
+or_statistics(query_goal_answer_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(13,BytesInUse,StructsInUse).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                          opt_statistics/2                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% should match with code in OPTYap/opt.preds.c
+opt_statistics(total_memory,[BytesInUse,BytesAllocated]) :-
+   '$c_get_optyap_statistics'(0,BytesInUse,BytesAllocated).
+opt_statistics(table_entries,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(1,BytesInUse,StructsInUse).
+opt_statistics(subgoal_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(2,BytesInUse,StructsInUse).
+opt_statistics(dependency_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(3,BytesInUse,StructsInUse).
+opt_statistics(or_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(4,BytesInUse,StructsInUse).
+opt_statistics(suspension_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(5,BytesInUse,StructsInUse).
+opt_statistics(subgoal_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(6,BytesInUse,StructsInUse).
+opt_statistics(answer_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(7,BytesInUse,StructsInUse).
+opt_statistics(subgoal_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(8,BytesInUse,StructsInUse).
+opt_statistics(answer_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(9,BytesInUse,StructsInUse).
+opt_statistics(global_trie_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(10,BytesInUse,StructsInUse).
+opt_statistics(global_trie_hashes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(11,BytesInUse,StructsInUse).
+opt_statistics(query_goal_solution_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(12,BytesInUse,StructsInUse).
+opt_statistics(query_goal_answer_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(13,BytesInUse,StructsInUse).
+opt_statistics(table_subgoal_solution_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(14,BytesInUse,StructsInUse).
+opt_statistics(table_subgoal_answer_frames,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(15,BytesInUse,StructsInUse).
+opt_statistics(subgoal_entries,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(16,BytesInUse,StructsInUse).
+opt_statistics(answer_ref_nodes,[BytesInUse,StructsInUse]) :-
+   '$c_get_optyap_statistics'(17,BytesInUse,StructsInUse).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                             parallel/1                              %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+parallel(Goal) :-
+   parallel_mode(Mode), Mode = on, !,
+   (
+      '$parallel_query'(Goal)
+   ;
+      true
+   ).
+parallel(Goal) :-
+   (
+      '$execute'(Goal),
+      fail
+   ;
+      true
+   ).
+
+'$parallel_query'(Goal) :-
+   '$c_yapor_start', 
+   '$execute'(Goal),
+   fail.
+'$parallel_query'(_).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                          parallel_findall/3                         %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+parallel_findall(Template,Goal,Answers) :- 
+   parallel_mode(Mode), Mode = on, !,
+   (
+      '$parallel_findall_query'(Template,Goal)
+   ;
+      '$c_parallel_get_answers'(Refs),
+      '$parallel_findall_recorded'(Refs,Answers),     
+      eraseall(parallel_findall)
+   ).
+parallel_findall(Template,Goal,Answers) :-
+   findall(Template,Goal,Answers).
+
+'$parallel_findall_query'(Template,Goal) :-
+   '$c_yapor_start', 
+   '$execute'(Goal),
+   recordz(parallel_findall,Template,Ref),
+   '$c_parallel_new_answer'(Ref),
+   fail.
+'$parallel_findall_query'(_,_).
+
+'$parallel_findall_recorded'([],[]) :- !.
+'$parallel_findall_recorded'([Ref|Refs],[Template|Answers]):-
+   recorded(parallel_findall,Template,Ref),
+   '$parallel_findall_recorded'(Refs,Answers).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                      parallel_findfirst/3                           %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+parallel_findfirst(Template,Goal,Answer) :- 
+   parallel_findall(Template,(Goal,!),Answer).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%                         parallel_once/1                             %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+parallel_once(Goal) :-
+   parallel_mode(Mode), Mode = on, !,
+   (
+      '$parallel_once_query'(Goal)
+   ;
+      recorded(parallel_once,Goal,Ref),
+      erase(Ref)
+   ).
+parallel_once(Goal) :-
+   once(Goal).
+
+'$parallel_once_query'(Goal) :-
+   '$c_yapor_start', 
+   '$execute'(once(Goal)),
+    recordz(parallel_once,Goal,_),
+    fail.
+'$parallel_once_query'(_).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

packages/python/swig/yap4py/prolog/pl/yio.yap

@@ -0,0 +1,464 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+  *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		yio.yap							 *
+* Last rev:								 *
+* mods:									 *
+* comments:	Input output predicates			 		 *
+*									 *
+*************************************************************************/
+
+
+
+:- system_module( '$_yio', [at_end_of_line/0,
+        at_end_of_line/1,
+        consult_depth/1,
+        current_char_conversion/2,
+        current_line_number/1,
+        current_line_number/2,
+        current_stream/3,
+        display/1,
+        display/2,
+        exists/1,
+        fileerrors/0,
+        format/1,
+        nofileerrors/0,
+        open_pipe_streams/2,
+        prolog_file_name/2,
+        read/1,
+        read/2,
+        sformat/3,
+        socket/2,
+        socket/4,
+        socket_connect/3,
+        stream_position/2,
+        stream_position/3,
+        stream_position_data/3,
+        ttyget/1,
+        ttyget0/1,
+        ttynl/0,
+        ttyput/1,
+        ttyskip/1,
+	rename/2,
+        write_depth/2], ['$default_expand'/1,
+        '$extend_file_search_path'/1,
+        '$set_default_expand'/1]).
+
+:- use_system_module( '$_boot', ['$system_catch'/4]).
+
+:- use_system_module( '$_errors', ['$do_error'/2]).
+
+/** @defgroup InputOutput Input/Output Predicates
+@ingroup builtins
+
+Some of the Input/Output predicates described below will in certain conditions
+provide error messages and abort only if the file_errors flag is set.
+If this flag is cleared the same predicates will just fail. Details on
+setting and clearing this flag are given under 7.7.
+
+  @{
+ */
+
+/* stream predicates							*/
+
+/** @defgroup IO_Sockets YAP Old Style Socket and Pipe Interface
+     @{
+
+    Autoload the socket/pipe library
+
+*/
+
+/** @pred  socket(+ _DOMAIN_,- _SOCKET_)
+
+Call socket/4 with  _TYPE_ bound to `SOCK_STREAM'` and
+ _PROTOCOL_ bound to `0`.
+
+
+*/
+
+/** @pred  socket(+ _DOMAIN_,+ _TYPE_,+ _PROTOCOL_,- _SOCKET_)
+
+Corresponds to the BSD system call `socket`. Create a socket for
+domain  _DOMAIN_ of type  _TYPE_ and protocol
+ _PROTOCOL_. Both  _DOMAIN_ and  _TYPE_ should be atoms,
+whereas  _PROTOCOL_ must be an integer.
+The new socket object is
+accessible through a descriptor bound to the variable  _SOCKET_.
+
+The current implementation of YAP  accepts socket
+domains `AF_INET` and `AF_UNIX`.
+Socket types depend on the
+underlying operating system, but at least the following types are
+supported: `SOCK_STREAM'` and `SOCK_DGRAM'` (untested in 6.3).
+
+
+*/
+/** @pred  socket_connect(+ _SOCKET_, + _PORT_, - _STREAM_)
+
+
+
+Interface to system call `connect`, used for clients: connect
+socket  _SOCKET_ to  _PORT_. The connection results in the
+read/write stream  _STREAM_.
+
+Port information depends on the domain:
+
++ 'AF_UNIX'(+ _FILENAME_)
++ 'AF_FILE'(+ _FILENAME_)
+connect to socket at file  _FILENAME_.
+
++ 'AF_INET'(+ _HOST_,+ _PORT_)
+Connect to socket at host  _HOST_ and port  _PORT_.
+*/
+
+
+/** @pred open_pipe_streams(Read, Write)
+
+  Autoload old pipe access interface
+
+*/
+%! @}
+
+
+
+
+/** @pred  exists(+ _F_)
+
+Checks if file  _F_ exists in the current directory.
+
+*/
+exists(F) :-
+	absolute_file_name(F, _, [file_errors(fail),access(exist),expand(true)]).
+
+%! @addtogroup ReadTerm
+%   @{
+
+/* Term IO	*/
+
+
+%! @}
+
+%! @addtogroup Write
+%   @{
+
+/* meaning of flags for '$write' is
+	 1	quote illegal atoms
+	 2	ignore operator declarations
+	 4	output '$VAR'(N) terms as A, B, C, ...
+	 8	use portray(_)
+
+   flags are defined in yapio.h
+*/
+
+/** @pred  display(+ _T_)
+
+
+Displays term  _T_ on the current output stream. All Prolog terms are
+written in standard parenthesized prefix notation.
+
+
+*/
+display(T) :-
+	   current_output(Out),
+	   write_term(Out, T, [ignore_ops(true)]).
+
+/** @pred  display(+ _S_, _T_)
+
+Like display/1, but using stream  _S_ to display the term.
+
+
+*/
+display(Stream, T) :-
+	   write_term(Stream, T, [ignore_ops(true)]).
+
+/* interface to user portray	*/
+'$portray'(T) :-
+	\+ '$undefined'(portray(_),user),
+	'$system_catch'(call(portray(T)),user,Error,user:'$Error'(Error)), !,
+	set_value('$portray',true), fail.
+'$portray'(_) :- set_value('$portray',false), fail.
+
+%! @}
+
+%! @addtogroup Format
+%   @{
+
+/** @pred  format(+ _T_)
+
+Print formatted output to the current output stream.
+
+
+*/
+format(T) :-
+	format(T, []).
+
+%! @}
+
+%! @addtogroup CharsIO
+%   @{
+
+/* character I/O	*/
+
+/** @pred  ttyget(- _C_)
+
+
+The same as `get(C)`, but from stream user_input.
+
+
+*/
+ttyget(N) :- get(user_input,N).
+
+/** @pred  ttyget0(- _C_)
+
+
+The same as `get0(C)`, but from stream user_input.
+
+
+*/
+ttyget0(N) :- get0(user_input,N).
+
+/** @pred  ttyskip(- _C_)
+
+
+Like skip/1, but always using stream user_input.
+stream.
+
+
+*/
+ttyskip(N) :-  N1 is N, '$skip'(user_input,N1).
+
+/** @pred  ttyput(+ _N_)
+
+
+As `put(N)` but always to user_output.
+
+
+*/
+ttyput(N) :-  N1 is N, put(user_output,N1).
+
+/** @pred  ttynl
+
+
+Outputs a new line to stream user_output.
+
+*/
+ttynl :- nl(user_output).
+
+%! @}
+
+%! @addtogroup StreamM
+%   @{
+
+/** @pred  current_line_number(- _LineNumber_)
+
+Unify  _LineNumber_ with the line number for  the current output stream.
+
+*/
+current_line_number(N) :-
+	current_input(Stream),
+	line_count(Stream, N).
+
+/** @pred  current_line_number(+ _Stream_,- _LineNumber_)
+
+Unify  _LineNumber_ with the line number for  _Stream_.
+
+*/
+current_line_number(Stream,N) :-
+	line_count(Stream, N).
+
+/** @pred  stream_position(+ _Stream_,- _StreamPosition_)
+
+Unify  _StreamPosition_ with the packaged information of position on
+current stream  _Stream_. Use stream_position_data/3 to
+retrieve information on character or line count.
+
+*/
+stream_position(Stream, Position) :-
+	stream_property(Stream, position(Position)).
+
+/** @pred  stream_position(+ _Stream_,- _StreamPosition_, +_NewPosition_)
+
+Unify _StreamPosition_ with the packaged information of position on
+current stream _Stream_ an then moves to position _NewPosition_.
+
+*/
+stream_position(Stream, Position, NewPosition) :-
+	stream_property(Stream, position(Position)),
+	set_stream_position(Stream, NewPosition).
+
+/** @pred at_end_of_line
+
+   Tests whether the next character in the current input stream is a line break character.
+*/
+
+at_end_of_line :-
+	current_input(S),
+	at_end_of_line(S).
+
+/** @pred at_end_of_line( +Stream )
+
+   Tests whether the next character in the stream is a line break character.
+*/
+at_end_of_line(S) :-
+	stream_property(S, end_of_stream(past)), !.
+at_end_of_line(S) :-
+	peek_code(S,N), ( N = 10 -> true ; N = -1).
+
+/** @pred  current_char_conversion(? _IN_,? _OUT_) is iso
+
+
+If  _IN_ is unbound give all current character
+translations. Otherwise, give the translation for  _IN_, if one
+exists.
+
+
+*/
+current_char_conversion(X,Y) :-
+	var(X), !,
+	'$all_char_conversions'(List),
+	'$fetch_char_conversion'(List,X,Y).
+current_char_conversion(X,Y) :-
+	'$current_char_conversion'(X,Y).
+
+
+'$fetch_char_conversion'([X,Y|_],X,Y).
+'$fetch_char_conversion'([_,_|List],X,Y) :-
+	'$fetch_char_conversion'(List,X,Y).
+
+split_path_file(File, Path, Name) :-
+	file_directory_name(File, Path),
+	file_base_name(File, Name).
+
+/** @pred  current_stream( _F_, _M_, _S_)
+
+
+Defines the relation: The stream  _S_ is opened on the file  _F_
+in mode  _M_. It might be used to obtain all open streams (by
+backtracking) or to access the stream for a file  _F_ in mode
+ _M_, or to find properties for a stream  _S_. Notice that some
+streams might not be associated to a file: in this case YAP tries to
+return the file number. If that is not available, YAP unifies  _F_
+with  _S_.
+
+
+*/
+current_stream(File, Mode, Stream) :-
+
+    stream_property(Stream, mode(Mode)),
+    '$stream_name'(Stream, File).
+
+'$stream_name'(Stream, File) :-
+    stream_property(Stream, file_name(File)), !.
+'$stream_name'(Stream, file_no(File)) :-
+    stream_property(Stream, file_no(File)), !.
+'$stream_name'(Stream, Stream).
+
+'$extend_file_search_path'(P) :-
+	atom_codes(P,S),
+	'$env_separator'(ES),
+	'$split_for_path'(S,0'=,ES,Paths), %'
+	'$add_file_search_paths'(Paths).
+
+'$split_for_path'([], _, _, []).
+'$split_for_path'(S, S1, S2, [A1=A2|R]) :-
+	'$fetch_first_path'(S, S1, A1, SR1),
+	'$fetch_second_path'(SR1, S2, A2, SR),
+	'$split_for_path'(SR, S1, S2, R) .
+
+'$fetch_first_path'([S1|SR],S1,[],SR) :- !.
+'$fetch_first_path'([C|S],S1,[C|F],SR) :-
+	'$fetch_first_path'(S,S1,F,SR).
+
+'$fetch_second_path'([],_,[],[]).
+'$fetch_second_path'([S1|SR],S1,[],SR) :- !.
+'$fetch_second_path'([C|S],S1,[C|A2],SR) :-
+	'$fetch_second_path'(S,S1,A2,SR).
+
+'$add_file_search_paths'([]).
+'$add_file_search_paths'([NS=DS|Paths]) :-
+	atom_codes(N,NS),
+	atom_codes(D,DS),
+	assert(user:file_search_path(N,D)),
+	'$add_file_search_paths'(Paths).
+
+
+'$format@'(Goal,Out) :-
+	with_output_to(codes(Out), Goal).
+
+sformat(String, Form, Args) :-
+	format(codes(String, []), Form, Args).
+
+
+/** @pred  stream_position_data(+ _Field_,+ _StreamPosition_,- _Info_)
+  Extract values from stream position objects.
+
+
+  '$stream_position' is of the format '$stream_position'(Byte, Char,
+  Line, LinePos).  Given the packaged stream position term
+  _StreamPosition_, unify _Info_ with _Field_ `line_count`,
+  `byte_count`, or `char_count`.
+
+ */
+stream_position_data(Prop, Term, Value) :-
+        nonvar(Prop), !,
+        (   '$stream_position_field'(Prop, Pos)
+        ->  arg(Pos, Term, Value)
+        ;   '$do_error'(domain_error(stream_position_data), Prop)
+        ).
+stream_position_data(Prop, Term, Value) :-
+        '$stream_position_field'(Prop, Pos),
+        arg(Pos, Term, Value).
+
+'$stream_position_field'(char_count,    1).
+'$stream_position_field'(line_count,    2).
+'$stream_position_field'(line_position, 3).
+'$stream_position_field'(byte_count,    4).
+
+'$set_encoding'(Enc) :-
+    set_stream(loop_stream, encoding(Enc)).
+
+%! @}
+
+
+'$codes_to_chars'(String0, String, String0) :- String0 == String, !.
+'$codes_to_chars'(String0, [Code|String], [Char|Chars]) :-
+	atom_codes(Char, [Code]),
+	'$codes_to_chars'(String0, String, Chars).
+
+/** @pred file_exists(+ _File__)
+
+The atom  _File_ corresponds to an existing file or directory.
+
+
+*/
+file_exists(IFile) :-
+	absolute_file_name(IFile, _File, [expand(true), solutions(first), access(exist)]).
+
+/** @pred  rename(+F , +G)
+
+      Renames the single file  _F_ to  _G_.
+*/
+rename(IFile, OFile) :-
+	absolute_file_name(IFile, IF, [access(read),expand(true)]),
+	absolute_file_name(OFile, OF, [expand(true)]),
+	'$rename'(IF, OF).
+
+/** @pred  access_file(+F , +G)
+
+      Verify whether file F respects property _G_. The file is  processed
+      with absolute_file_name.
+*/
+access_file(IFile, Access) :-
+    absolute_file_name(IFile, _IF, [access(Access),expand(true)]).
+
+
+/**
+@}
+*/