1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Bousi-Prolog foreign library interface
    3
    4:- module(foreign, [
    5		load_foreign_extension/0
    6   ]).    7
    8:- initialization use_foreign_library(foreign(bousi_support)).    9
   10% :- use_module(library(shlib)).
   11
   12%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   13
   14:- set_prolog_flag(double_quotes, codes).   15
   16
   17%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   18% Foreign library loader
   19%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   20
   21load_foreign_extension :- !, true.
 load_foreign_extension
Loads Bousi-Prolog foreign library into memory.
   28load_foreign_extension :- 
   29	% Retrieves the path of the foreign library for this OS
   30	current_prolog_flag(executable, BPLExecutable),
   31	foreign_library_name(LibraryName),
   32  path_separator(Separator),
   33	% Loads the foreign library (if it exists)	
   34	( file_directory_name(BPLExecutable, BPLPath)
   35   ;
   36	  findall(I, sub_atom(BPLExecutable, I, 1, _, Separator), Is), % Find the last separator
   37	  max_list(Is, M), 
   38	  %M1 is M+1, 
   39	  sub_atom(BPLExecutable, 0, M, _, BPLPath)
   40	),
   41  concat_atom([BPLPath, Separator, LibraryName], LibraryPath),
   42	exists_file(LibraryPath),
   43	load_foreign_library(LibraryPath)
   44	;
   45	(
   46	  LibraryPath=LibraryPath,
   47		writef('ERROR: \'%w\' library not found.', [LibraryPath]), nl,
   48		write('If your Bousi-Prolog distribution includes the source code, \c
   49		       run \'make\' before starting Bousi-Prolog.'), nl,
   50		halt
   51	).
 path_separator(?Separator)
Unifies Separator with the path separator of the OS file system
   58path_separator('\\') :-
   59	current_prolog_flag(windows, true), 
   60	!.
   61
   62path_separator('/').
 foreign_library_name(?Library)
Unifies Library with the name of the foreign library written in C, which is 'extern.so' on Unix/Linux or 'extern.dll' on Windows.
   71foreign_library_name('extern.dll') :-
   72	current_prolog_flag(windows, true), 
   73	!.
   74
   75foreign_library_name('extern.so').
   76
   77
   78%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   79% Foreign predicates documentation
   80%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 ext_closure(+InputEquations, +Closure, +TNorm, +RelationName, -OutputEquations)
Computes the reflexive, symmetric and/or transitive closure of the fuzzy relation defined by a set of equations and returns the list of equations of the resulting fuzzy relation. Input equations must be like "rel(a, b, 0.5)", where "rel" can be any functor; output equations will be similar but replacing "rel" with RelationName atom. Closure must be a combination of one or more of these flags:

TNorm must be one of these values:

 ext_translate_fuzzysets(+Domain, +Subsets, +NewSubsets, +RelationName, -Equations)
Computes the similarity degree between the fuzzy subsets of the NewSubsets list and the fuzzy subsets of the Subsets list, and returns a list of equations that represent a fuzzy relation with the subsets in NewSubsets. Domain must be a list with four items: [Name, Min, Max, MeasureUnit]. Output equations will be like "rel(a, b, 0.5)", where "rel" is RelationName atom, and "a"/"b" are subsets' names. Finally, these are the syntax of the valid fuzzy subsets:
 ext_tokenize(+StringAtom, -Tokens)
Scans the Bousi-Prolog program or query contained in StringAtom, performs a lexical analysis and returns a list with all the tokens found. Each token will be defined by a compound term of arity 2 with this syntax: "<type>(<text>, [<line>, <column>])" (e.g. "comma(',', [3, 5])" or "name('aaa bbb', [10, 15])").
 ext_read_shell_line(+Prompt, -String, -Arguments)
Reads a line from standard input using editline library, which allows command-line editing and history features. The line entered by the user is returned as an atom in String. A list with all the arguments found in the line (using space-bar characters as delimiters) is returned in Arguments.
 ext_load_shell_history(+File)
Loads command history used by editline library from File. If File doesn't exist, it'll be created.
 ext_save_shell_history(+File, +MaxCommands)
Saves command history used by editline library in File, storing no more commands than the specified in MaxCommands. If File already exists, it'll be overwritten.
 ext_set_system_predicate_list(+List)
Sets the list of predefined predicates available in Bousi-Prolog. This list will be used by shell's autocomplete feature.
 ext_set_program_predicate_list(+List)
Sets the list of predicates defined in the currently loaded program. This list will be used by shell's autocomplete feature.