more fixes
This commit is contained in:
Vítor Santos Costa
parent
7f8f80fdbe
commit
14747fd0bf
@ -118,7 +118,7 @@ Yap_InitPlIO (void)
|
||||
*/
|
||||
static int newline = TRUE;
|
||||
|
||||
#if DEBUG
|
||||
#if DEBUG_YAP
|
||||
|
||||
static int eolflg = 1;
|
||||
|
||||
@ -1088,7 +1088,7 @@ Yap_InitBackIO (void)
|
||||
{
|
||||
}
|
||||
|
||||
#if DEBUG
|
||||
#if DEBUG_YAP
|
||||
static Int
|
||||
p_write_string( USES_REGS1 )
|
||||
{
|
||||
@ -1116,7 +1116,7 @@ Yap_InitIOPreds(void)
|
||||
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPred ("$read", 7, p_read, SyncPredFlag|UserCPredFlag);
|
||||
Yap_InitCPred ("$read", 8, p_read2, SyncPredFlag|UserCPredFlag);
|
||||
#if DEBUG
|
||||
#if DEBUG_YAP
|
||||
Yap_InitCPred ("write_string", 2, p_write_string, SyncPredFlag|UserCPredFlag);
|
||||
#endif
|
||||
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag);
|
||||
|
||||
79
C/pl-yap.c
79
C/pl-yap.c
@ -1333,6 +1333,85 @@ accessLevel(void)
|
||||
return NULL_ATOM;
|
||||
}
|
||||
|
||||
#define SKIP_VERY_DEEP 1000000000L
|
||||
#define SKIP_REDO_IN_SKIP (SKIP_VERY_DEEP-1)
|
||||
|
||||
#define WFG_TRACE 0x01000
|
||||
#define WFG_TRACING 0x02000
|
||||
#define WFG_BACKTRACE 0x04000
|
||||
#define WFG_CHOICE 0x08000
|
||||
|
||||
#define TRACE_FIND_NONE 0
|
||||
#define TRACE_FIND_ANY 1
|
||||
#define TRACE_FIND_NAME 2
|
||||
#define TRACE_FIND_TERM 3
|
||||
|
||||
typedef struct find_data_tag
|
||||
{ int port; /* Port to find */
|
||||
bool searching; /* Currently searching? */
|
||||
int type; /* TRACE_FIND_* */
|
||||
union
|
||||
{ atom_t name; /* Name of goal to find */
|
||||
struct
|
||||
{ functor_t functor; /* functor of the goal */
|
||||
Record term; /* Goal to find */
|
||||
} term;
|
||||
} goal;
|
||||
} find_data;
|
||||
|
||||
|
||||
int
|
||||
tracemode(debug_type doit, debug_type *old)
|
||||
{ GET_LD
|
||||
|
||||
if ( doit )
|
||||
{ debugmode(DBG_ON, NULL);
|
||||
doit = TRUE;
|
||||
}
|
||||
|
||||
if ( old )
|
||||
*old = debugstatus.tracing;
|
||||
|
||||
if ( debugstatus.tracing != doit )
|
||||
{ debugstatus.tracing = doit;
|
||||
printMessage(ATOM_silent,
|
||||
PL_FUNCTOR_CHARS, "trace_mode", 1,
|
||||
PL_ATOM, doit ? ATOM_on : ATOM_off);
|
||||
}
|
||||
if ( doit ) /* make sure trace works inside skip */
|
||||
{ debugstatus.skiplevel = SKIP_VERY_DEEP;
|
||||
if ( LD->trace.find )
|
||||
LD->trace.find->searching = FALSE;
|
||||
}
|
||||
|
||||
succeed;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
debugmode(debug_type doit, debug_type *old)
|
||||
{ GET_LD
|
||||
|
||||
if ( old )
|
||||
*old = debugstatus.debugging;
|
||||
|
||||
if ( debugstatus.debugging != doit )
|
||||
{ if ( doit )
|
||||
{ debugstatus.skiplevel = SKIP_VERY_DEEP;
|
||||
if ( doit == DBG_ALL )
|
||||
{ doit = DBG_ON;
|
||||
}
|
||||
}
|
||||
debugstatus.debugging = doit;
|
||||
printMessage(ATOM_silent,
|
||||
PL_FUNCTOR_CHARS, "debug_mode", 1,
|
||||
PL_ATOM, doit ? ATOM_on : ATOM_off);
|
||||
}
|
||||
|
||||
succeed;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
getAccessLevelMask(atom_t a, access_level_t *val)
|
||||
{ if ( a == ATOM_user )
|
||||
|
||||
27
H/Yap.h
27
H/Yap.h
@ -365,33 +365,6 @@ typedef enum
|
||||
#define QUINTUS_TO_CHARS 0
|
||||
#define ISO_TO_CHARS 1
|
||||
|
||||
#define CPROLOG_CHARACTER_ESCAPES 0
|
||||
#define ISO_CHARACTER_ESCAPES 1
|
||||
#define SICSTUS_CHARACTER_ESCAPES 2
|
||||
|
||||
// SWI Stuff
|
||||
typedef enum
|
||||
{ DBG_OFF = 0, /* no debugging */
|
||||
DBG_ON, /* switch on in current environment */
|
||||
DBG_ALL /* switch on globally */
|
||||
} debug_type;
|
||||
|
||||
typedef int bool;
|
||||
|
||||
typedef struct debuginfo
|
||||
{ size_t skiplevel; /* current skip level */
|
||||
bool tracing; /* are we tracing? */
|
||||
debug_type debugging; /* are we debugging? */
|
||||
int leashing; /* ports we are leashing */
|
||||
int visible; /* ports that are visible */
|
||||
bool showContext; /* tracer shows context module */
|
||||
int styleCheck; /* source style checking */
|
||||
int suspendTrace; /* tracing is suspended now */
|
||||
//LocalFrame retryFrame; /* Frame to retry */
|
||||
} pl_debugstatus_t;
|
||||
// over SWI
|
||||
|
||||
|
||||
typedef enum
|
||||
{
|
||||
INDEX_MODE_OFF = 0,
|
||||
|
||||
@ -412,8 +412,6 @@
|
||||
|
||||
#define LOCAL_search_atoms LOCAL->search_atoms_
|
||||
#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
|
||||
#define LOCAL_debugstatus LOCAL->debugstatus_
|
||||
#define REMOTE_debugstatus(wid) REMOTE(wid)->debugstatus_
|
||||
#define LOCAL_SourceModule LOCAL->SourceModule_
|
||||
#define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_
|
||||
|
||||
|
||||
@ -232,6 +232,5 @@ typedef struct worker_local {
|
||||
UInt exo_arg_;
|
||||
|
||||
struct scan_atoms* search_atoms_;
|
||||
pl_debugstatus_t debugstatus_;
|
||||
Term SourceModule_;
|
||||
} w_local;
|
||||
|
||||
@ -232,6 +232,5 @@ static void InitWorker(int wid) {
|
||||
REMOTE_exo_arg(wid) = 0;
|
||||
|
||||
|
||||
|
||||
REMOTE_SourceModule(wid) = 0;
|
||||
}
|
||||
|
||||
@ -1,3 +1,25 @@
|
||||
|
||||
typedef enum
|
||||
{ DBG_OFF = 0, /* no debugging */
|
||||
DBG_ON, /* switch on in current environment */
|
||||
DBG_ALL /* switch on globally */
|
||||
} debug_type;
|
||||
|
||||
typedef struct debuginfo
|
||||
{ size_t skiplevel; /* current skip level */
|
||||
bool tracing; /* are we tracing? */
|
||||
debug_type debugging; /* are we debugging? */
|
||||
int leashing; /* ports we are leashing */
|
||||
int visible; /* ports that are visible */
|
||||
bool showContext; /* tracer shows context module */
|
||||
int styleCheck; /* source style checking */
|
||||
int suspendTrace; /* tracing is suspended now */
|
||||
//LocalFrame retryFrame; /* Frame to retry */
|
||||
} pl_debugstatus_t;
|
||||
|
||||
|
||||
typedef struct find_data_tag * FindData; /* pl-trace.c */
|
||||
|
||||
typedef enum
|
||||
{ LDATA_IDLE = 0,
|
||||
LDATA_SIGNALLED,
|
||||
@ -319,6 +341,12 @@ typedef struct PL_local_data {
|
||||
} exception;
|
||||
const char *float_format; /* floating point format */
|
||||
|
||||
struct
|
||||
{ FindData find; /* /<ports> <goal> in tracer */
|
||||
} trace;
|
||||
|
||||
pl_debugstatus_t _debugstatus; /* status of the debugger */
|
||||
|
||||
#ifdef O_PLMT
|
||||
struct
|
||||
{ //intptr_t magic; /* PL_THREAD_MAGIC (checking) */
|
||||
@ -375,3 +403,4 @@ extern PL_local_data_t lds;
|
||||
#define source_line_pos (LD->read_source.linepos)
|
||||
#define source_char_no (LD->read_source.character)
|
||||
|
||||
#define debugstatus (LD->_debugstatus)
|
||||
|
||||
13
H/pl-incl.h
13
H/pl-incl.h
@ -1,4 +1,8 @@
|
||||
|
||||
#ifndef PL_INCL_H
|
||||
|
||||
#define PL_INCL_H 1
|
||||
|
||||
#include "config.h"
|
||||
|
||||
#if USE_GMP
|
||||
@ -47,8 +51,6 @@
|
||||
|
||||
#define SWIP "swi_"
|
||||
|
||||
#include "pl-shared.h"
|
||||
|
||||
/* try not to pollute the SWI space */
|
||||
#ifdef P
|
||||
#undef P
|
||||
@ -89,6 +91,8 @@ typedef int bool;
|
||||
typedef int Char; /* char that can pass EOF */
|
||||
typedef uintptr_t word; /* Anonymous 4 byte object */
|
||||
|
||||
#include "pl-shared.h"
|
||||
|
||||
#if SIZE_DOUBLE==SIZEOF_INT_P
|
||||
#define WORDS_PER_DOUBLE 1
|
||||
#else
|
||||
@ -186,6 +190,8 @@ typedef enum
|
||||
#endif
|
||||
typedef uintptr_t PL_atomic_t; /* same size as a word */
|
||||
|
||||
typedef struct record * Record;
|
||||
|
||||
#define MAXSIGNAL 64
|
||||
|
||||
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
|
||||
@ -839,3 +845,6 @@ extern const PL_extension PL_predicates_from_write[];
|
||||
extern const PL_extension PL_predicates_from_prologflag[];
|
||||
extern const PL_extension PL_predicates_from_win[];
|
||||
|
||||
#define enableThreads(val) FALSE
|
||||
|
||||
#endif
|
||||
|
||||
@ -16,14 +16,17 @@
|
||||
typedef uintptr_t term_t;
|
||||
#endif
|
||||
|
||||
#ifndef _FLI_H_INCLUDED
|
||||
#if !defined(_FLI_H_INCLUDED) && !defined(PL_INCL_H)
|
||||
|
||||
#ifdef __WINDOWS__
|
||||
#include <windows.h>
|
||||
#include <windows/uxnt.h>
|
||||
#endif
|
||||
|
||||
typedef void *record_t;
|
||||
typedef int bool;
|
||||
|
||||
|
||||
typedef DBTerm *record_t;
|
||||
typedef struct mod_entry *module_t;
|
||||
typedef uintptr_t atom_t;
|
||||
|
||||
@ -156,6 +159,7 @@ typedef struct initialise_handle * InitialiseHandle;
|
||||
#define clear(s, a) ((s)->flags &= ~(a))
|
||||
#ifdef DEBUG
|
||||
/* should have messages here */
|
||||
#define DEBUG_YAP 1
|
||||
#undef DEBUG
|
||||
#define DEBUG(LEVEL, COMMAND)
|
||||
#else
|
||||
@ -203,10 +207,11 @@ typedef struct initialise_handle * InitialiseHandle;
|
||||
extern unsigned int
|
||||
getUnknownModule(module_t m);
|
||||
|
||||
#define debugstatus LOCAL_debugstatus /* status of the debugger */
|
||||
|
||||
#define truePrologFlag(flag) true(&LD->prolog_flag.mask, flag)
|
||||
#define setPrologFlagMask(flag) set(&LD->prolog_flag.mask, flag)
|
||||
#define clearPrologFlagMask(flag) clear(&LD->prolog_flag.mask, flag)
|
||||
|
||||
COMMON(int) debugmode(debug_type new, debug_type *old);
|
||||
COMMON(int) tracemode(debug_type new, debug_type *old);
|
||||
|
||||
#endif /* PL_SHARED_INCLUDE */
|
||||
|
||||
@ -231,7 +231,6 @@ static void RestoreWorker(int wid USES_REGS) {
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -265,8 +265,6 @@ UInt exo_arg =0
|
||||
// atom completion
|
||||
struct scan_atoms* search_atoms void
|
||||
|
||||
pl_debugstatus_t debugstatus void
|
||||
|
||||
Term SourceModule =0
|
||||
|
||||
END_WORKER_LOCAL
|
||||
|
||||
@ -568,7 +568,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
|
||||
else
|
||||
clearPrologFlagMask(mask);
|
||||
}
|
||||
#ifndef __YAP_PROLOG__
|
||||
if ( k == ATOM_character_escapes )
|
||||
{ if ( val )
|
||||
set(m, M_CHARESCAPE);
|
||||
@ -589,7 +588,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
|
||||
break; /* don't change value */
|
||||
#endif
|
||||
}
|
||||
#endif /* __YAP_PROLOG__ */
|
||||
|
||||
/* set the flag value */
|
||||
f->value.a = (val ? ATOM_true : ATOM_false);
|
||||
|
||||
326
pl/absf.yap
Normal file
326
pl/absf.yap
Normal file
@ -0,0 +1,326 @@
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: consult.yap *
|
||||
* Last rev: 8/2/88 *
|
||||
* mods: *
|
||||
* comments: Consulting Files in YAP *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
absolute_file_name(V,Out) :- var(V), !,
|
||||
'$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(source),file_errors(fail),solutions(first),expand(true)],F,G).
|
||||
|
||||
% fix wrong argument order, TrueFileName should be last.
|
||||
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)).
|
||||
|
||||
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$absolute_file_name'(File,Opts,TrueFileName, G) :-
|
||||
'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
|
||||
/* our own local findall */
|
||||
nb:nb_queue(Ref),
|
||||
(
|
||||
'$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
|
||||
nb:nb_queue_enqueue(Ref, TrueFileName),
|
||||
fail
|
||||
;
|
||||
nb:nb_queue_close(Ref, FileNames, [])
|
||||
),
|
||||
'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
|
||||
|
||||
'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
|
||||
'$do_error'(existence_error(file,File),G).
|
||||
'$absolute_file_names'(Solutions, FileNames, _, TrueFileName, _, _) :-
|
||||
lists:member(TrueFileName, FileNames),
|
||||
(Solutions == first -> ! ; true).
|
||||
|
||||
|
||||
'$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !.
|
||||
'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
|
||||
'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
|
||||
'$process_fn_opts'(Opts,_Extensions,_RelTo,_Type,_Access,_FErrors,_Solutions,_Expand,_Debug,G) :- !,
|
||||
'$do_error'(type_error(list,Opts),G).
|
||||
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$process_fn_opt'(extensions(Extensions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,_,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_extensions'(Extensions,G).
|
||||
'$process_fn_opt'(relative_to(RelTo),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,_,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_atom'(RelTo,G).
|
||||
'$process_fn_opt'(access(Access),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,_,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_atom'(Access,G).
|
||||
'$process_fn_opt'(file_type(Type),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,_,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_type'(Type,G).
|
||||
'$process_fn_opt'(file_errors(FErrors),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,_,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_errors'(FErrors,G).
|
||||
'$process_fn_opt'(solutions(Solutions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,_,Expand,Debug,G) :- !,
|
||||
'$check_fn_solutions'(Solutions,G).
|
||||
'$process_fn_opt'(expand(Expand),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,_,Debug,G) :- !,
|
||||
'$check_true_false'(Expand,G).
|
||||
'$process_fn_opt'(verbose_file_search(Debug),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,_,G) :- !,
|
||||
'$check_true_false'(Debug,G).
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$do_error'(domain_error(file_name_option,Opt),G).
|
||||
|
||||
'$check_fn_extensions'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_extensions'([],_) :- !.
|
||||
'$check_fn_extensions'([A|L],G) :- !,
|
||||
'$check_atom'(A,G),
|
||||
'$check_fn_extensions'(L,G).
|
||||
'$check_fn_extensions'(T,G) :- !,
|
||||
'$do_error'(type_error(list,T),G).
|
||||
|
||||
'$check_atom'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_atom'(A,_G) :- atom(A), !.
|
||||
'$check_atom'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_type'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_type'(txt,_) :- !.
|
||||
'$check_fn_type'(prolog,_) :- !.
|
||||
'$check_fn_type'(source,_) :- !.
|
||||
'$check_fn_type'(executable,_) :- !.
|
||||
'$check_fn_type'(qlf,_) :- !.
|
||||
'$check_fn_type'(directory,_) :- !.
|
||||
'$check_fn_type'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(file_type,T),G).
|
||||
'$check_fn_type'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_errors'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_errors'(fail,_) :- !.
|
||||
'$check_fn_errors'(error,_) :- !.
|
||||
'$check_fn_errors'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(file_errors,T),G).
|
||||
'$check_fn_errors'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_solutions'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_solutions'(first,_) :- !.
|
||||
'$check_fn_solutions'(all,_) :- !.
|
||||
'$check_fn_solutions'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(solutions,T),G).
|
||||
'$check_fn_solutions'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_true_false'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_true_false'(true,_) :- !.
|
||||
'$check_true_false'(false,_) :- !.
|
||||
'$check_true_false'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(boolean,T),G).
|
||||
'$check_true_false'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),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'(commons(D),_,_, _) :-
|
||||
% make sure library_directory is open.
|
||||
\+ clause(user:commons_directory(_),_),
|
||||
'$system_commons_directories'(D),
|
||||
assert(user:commons_directory(D)),
|
||||
fail.
|
||||
'$find_in_path'(S, Opts, NewFile, Call) :-
|
||||
S =.. [Name,File0],
|
||||
'$cat_file_name'(File0,File1), !,
|
||||
'$expand_file_name'(File1, File),
|
||||
'$dir_separator'(D),
|
||||
atom_codes(A,[D]),
|
||||
'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
|
||||
'$find_in_path'(File0,Opts,NewFile,_) :-
|
||||
'$cat_file_name'(File0,File1), !,
|
||||
'$expand_file_name'(File1, File),
|
||||
'$add_path'(File,PFile),
|
||||
'$get_abs_file'(PFile,Opts,AbsFile),
|
||||
'$search_in_path'(AbsFile,Opts,NewFile).
|
||||
'$find_in_path'(File,_,_,Call) :-
|
||||
'$do_error'(domain_error(source_sink,File),Call).
|
||||
|
||||
% allow paths in File Name
|
||||
'$cat_file_name'(File0,File) :-
|
||||
atom(File0), !,
|
||||
File = File0.
|
||||
'$cat_file_name'(Atoms, File) :-
|
||||
'$to_list_of_atoms'(Atoms, List, []),
|
||||
atom_concat(List, File).
|
||||
|
||||
'$to_list_of_atoms'(V, _, _) :- var(V), !, fail.
|
||||
'$to_list_of_atoms'(Atom, [Atom|L], L) :- atom(Atom), !.
|
||||
'$to_list_of_atoms'(Atoms, L1, LF) :-
|
||||
Atoms =.. [A,As,Bs],
|
||||
atom_codes(A,[D]),
|
||||
'$dir_separator'(D),
|
||||
'$to_list_of_atoms'(As, L1, [A|L2]),
|
||||
'$to_list_of_atoms'(Bs, L2, LF).
|
||||
|
||||
'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
|
||||
(
|
||||
nonvar(RelTo)
|
||||
->
|
||||
( is_absolute_file_name(File) ->
|
||||
ActualFile = File
|
||||
;
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
atom_concat([RelTo, DA, File], ActualFile)
|
||||
)
|
||||
;
|
||||
ActualFile = File
|
||||
),
|
||||
'$swi_current_prolog_flag'(file_name_variables, OldF),
|
||||
'$swi_set_prolog_flag'(file_name_variables, Expand),
|
||||
(
|
||||
'$absolute_file_name'(ActualFile,AbsFile)
|
||||
->
|
||||
'$swi_set_prolog_flag'(file_name_variables, OldF)
|
||||
;
|
||||
'$swi_set_prolog_flag'(file_name_variables, OldF),
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
|
||||
'$add_extensions'(Extensions, File, F0),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
'$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
|
||||
'$add_type_extensions'(Type, File, F0),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
|
||||
'$check_file'(F, _Type, none, F) :- !.
|
||||
'$check_file'(F0, Type, Access, F0) :-
|
||||
access_file(F0, Access),
|
||||
(Type == directory
|
||||
->
|
||||
exists_directory(F0)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$add_extensions'([Ext|_],File,F) :-
|
||||
'$mk_sure_true_ext'(Ext,NExt),
|
||||
atom_concat([File,NExt],F).
|
||||
'$add_extensions'([_|Extensions],File,F) :-
|
||||
'$add_extensions'(Extensions,File,F).
|
||||
|
||||
'$mk_sure_true_ext'(Ext,NExt) :-
|
||||
atom_codes(Ext,[C|L]),
|
||||
C \= 0'.,
|
||||
!,
|
||||
atom_codes(NExt,[0'.,C|L]).
|
||||
'$mk_sure_true_ext'(Ext,Ext).
|
||||
|
||||
'$add_type_extensions'(Type,File,F) :-
|
||||
( Type == source -> NType = prolog ; NType = Type ),
|
||||
user:prolog_file_type(Ext, NType),
|
||||
atom_concat([File,'.',Ext],F).
|
||||
'$add_type_extensions'(_,File,File).
|
||||
|
||||
'$add_path'(File,File) :-
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
sub_atom(File, 0, 1, _, DA), !.
|
||||
'$add_path'(File,File).
|
||||
'$add_path'(File,PFile) :-
|
||||
recorded('$path',Path,_),
|
||||
atom_concat([Path,File],PFile).
|
||||
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPSHAREDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPCOMMONSDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(system_library_directory,Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(prolog_commons_directory,Dir).
|
||||
|
||||
|
||||
'$split_by_sep'(Start, Next, Dirs, Dir) :-
|
||||
'$swi_current_prolog_flag'(windows, true), !,
|
||||
'$split_by_sep'(Start, Next, Dirs, ';', Dir).
|
||||
'$split_by_sep'(Start, Next, Dirs, Dir) :-
|
||||
'$split_by_sep'(Start, Next, Dirs, ':', Dir).
|
||||
|
||||
'$split_by_sep'(Start, Next, Dirs, Sep, Dir) :-
|
||||
sub_atom(Dirs, Next, 1, _, Let), !,
|
||||
'$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir).
|
||||
'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :-
|
||||
Next > Start,
|
||||
Len is Next-Start,
|
||||
sub_atom(Dirs, Start, Len, _, Dir).
|
||||
|
||||
|
||||
% closed a directory
|
||||
'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :-
|
||||
Sz is Next-Start,
|
||||
Sz > 0,
|
||||
sub_atom(Dirs, Start, Sz, _, Dir).
|
||||
% next dir
|
||||
'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !,
|
||||
N1 is Next+1,
|
||||
'$split_by_sep'(N1, N1, Dirs, Dir).
|
||||
% same dir
|
||||
'$continue_split_by_sep'(_Let, Start, Next, Dirs, Sep, Dir) :-
|
||||
N1 is Next+1,
|
||||
'$split_by_sep'(Start, N1, Dirs, Sep, Dir).
|
||||
|
||||
|
||||
'$extend_path_directory'(_Name, D, File, _Opts, File, Call) :-
|
||||
is_absolute_file_name(File), !.
|
||||
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
|
||||
user:file_search_path(Name, IDirs),
|
||||
( atom(IDirs) ->
|
||||
'$split_by_sep'(0, 0, IDirs, Dir)
|
||||
;
|
||||
Dir = IDirs
|
||||
),
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
|
||||
atom(Dir), !,
|
||||
'$add_file_to_dir'(Dir,A,File,NFile),
|
||||
'$find_in_path'(NFile, Opts, NewFile, Goal), !.
|
||||
'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
|
||||
nonvar(Name),
|
||||
Name =.. [N,P0],
|
||||
'$add_file_to_dir'(P0,A,File,NFile),
|
||||
NewName =.. [N,NFile],
|
||||
'$find_in_path'(NewName, Opts, OFile, Goal).
|
||||
|
||||
'$add_file_to_dir'(P0,A,Atoms,NFile) :-
|
||||
atom_concat([P0,A,Atoms],NFile).
|
||||
|
||||
|
||||
309
pl/consult.yap
309
pl/consult.yap
@ -771,315 +771,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
|
||||
'$set_encoding'(Stream, Encoding) :-
|
||||
( Encoding == default -> true ; set_stream(Stream, encoding(Encoding)) ).
|
||||
|
||||
absolute_file_name(V,Out) :- var(V), !,
|
||||
'$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(source),file_errors(fail),solutions(first),expand(true)],F,G).
|
||||
|
||||
% fix wrong argument order, TrueFileName should be last.
|
||||
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)).
|
||||
|
||||
'$absolute_file_name'(File, _Opts, _TrueFileName, G) :- var(File), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$absolute_file_name'(File,Opts,TrueFileName, G) :-
|
||||
'$process_fn_opts'(Opts,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G),
|
||||
/* our own local findall */
|
||||
nb:nb_queue(Ref),
|
||||
(
|
||||
'$find_in_path'(File,opts(Extensions,RelTo,Type,Access,FErrors,Expand,Debug),TrueFileName,G),
|
||||
nb:nb_queue_enqueue(Ref, TrueFileName),
|
||||
fail
|
||||
;
|
||||
nb:nb_queue_close(Ref, FileNames, [])
|
||||
),
|
||||
'$absolute_file_names'(Solutions, FileNames, FErrors, TrueFileName, File, G).
|
||||
|
||||
'$absolute_file_names'(_Solutions, [], error, _, File, G) :- !,
|
||||
'$do_error'(existence_error(file,File),G).
|
||||
'$absolute_file_names'(Solutions, FileNames, _, TrueFileName, _, _) :-
|
||||
lists:member(TrueFileName, FileNames),
|
||||
(Solutions == first -> ! ; true).
|
||||
|
||||
|
||||
'$process_fn_opts'(V,_,_,_,_,_,_,_,_,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$process_fn_opts'([],[],_,txt,none,error,first,false,false,_) :- !.
|
||||
'$process_fn_opts'([Opt|Opts],Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G),
|
||||
'$process_fn_opts'(Opts,Extensions0,RelTo0,Type0,Access0,FErrors0,Solutions0,Expand0,Debug0,G).
|
||||
'$process_fn_opts'(Opts,_Extensions,_RelTo,_Type,_Access,_FErrors,_Solutions,_Expand,_Debug,G) :- !,
|
||||
'$do_error'(type_error(list,Opts),G).
|
||||
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- var(Opt), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$process_fn_opt'(extensions(Extensions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,_,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_extensions'(Extensions,G).
|
||||
'$process_fn_opt'(relative_to(RelTo),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,_,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_atom'(RelTo,G).
|
||||
'$process_fn_opt'(access(Access),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,_,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_atom'(Access,G).
|
||||
'$process_fn_opt'(file_type(Type),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,_,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_type'(Type,G).
|
||||
'$process_fn_opt'(file_errors(FErrors),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,_,Solutions,Expand,Debug,G) :- !,
|
||||
'$check_fn_errors'(FErrors,G).
|
||||
'$process_fn_opt'(solutions(Solutions),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,_,Expand,Debug,G) :- !,
|
||||
'$check_fn_solutions'(Solutions,G).
|
||||
'$process_fn_opt'(expand(Expand),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,_,Debug,G) :- !,
|
||||
'$check_true_false'(Expand,G).
|
||||
'$process_fn_opt'(verbose_file_search(Debug),Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,_,G) :- !,
|
||||
'$check_true_false'(Debug,G).
|
||||
'$process_fn_opt'(Opt,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,Extensions,RelTo,Type,Access,FErrors,Solutions,Expand,Debug,G) :- !,
|
||||
'$do_error'(domain_error(file_name_option,Opt),G).
|
||||
|
||||
'$check_fn_extensions'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_extensions'([],_) :- !.
|
||||
'$check_fn_extensions'([A|L],G) :- !,
|
||||
'$check_atom'(A,G),
|
||||
'$check_fn_extensions'(L,G).
|
||||
'$check_fn_extensions'(T,G) :- !,
|
||||
'$do_error'(type_error(list,T),G).
|
||||
|
||||
'$check_atom'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_atom'(A,_G) :- atom(A), !.
|
||||
'$check_atom'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_type'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_type'(txt,_) :- !.
|
||||
'$check_fn_type'(prolog,_) :- !.
|
||||
'$check_fn_type'(source,_) :- !.
|
||||
'$check_fn_type'(executable,_) :- !.
|
||||
'$check_fn_type'(qlf,_) :- !.
|
||||
'$check_fn_type'(directory,_) :- !.
|
||||
'$check_fn_type'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(file_type,T),G).
|
||||
'$check_fn_type'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_errors'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_errors'(fail,_) :- !.
|
||||
'$check_fn_errors'(error,_) :- !.
|
||||
'$check_fn_errors'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(file_errors,T),G).
|
||||
'$check_fn_errors'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_fn_solutions'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_fn_solutions'(first,_) :- !.
|
||||
'$check_fn_solutions'(all,_) :- !.
|
||||
'$check_fn_solutions'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(solutions,T),G).
|
||||
'$check_fn_solutions'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),G).
|
||||
|
||||
'$check_true_false'(V,G) :- var(V), !,
|
||||
'$do_error'(instantiation_error, G).
|
||||
'$check_true_false'(true,_) :- !.
|
||||
'$check_true_false'(false,_) :- !.
|
||||
'$check_true_false'(T,G) :- atom(T), !,
|
||||
'$do_error'(domain_error(boolean,T),G).
|
||||
'$check_true_false'(T,G) :- !,
|
||||
'$do_error'(type_error(atom,T),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'(commons(D),_,_, _) :-
|
||||
% make sure library_directory is open.
|
||||
\+ clause(user:commons_directory(_),_),
|
||||
'$system_commons_directories'(D),
|
||||
assert(user:commons_directory(D)),
|
||||
fail.
|
||||
'$find_in_path'(S, Opts, NewFile, Call) :-
|
||||
S =.. [Name,File0],
|
||||
'$cat_file_name'(File0,File1), !,
|
||||
'$expand_file_name'(File1, File),
|
||||
'$dir_separator'(D),
|
||||
atom_codes(A,[D]),
|
||||
'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
|
||||
'$find_in_path'(File0,Opts,NewFile,_) :-
|
||||
'$cat_file_name'(File0,File1), !,
|
||||
'$expand_file_name'(File1, File),
|
||||
'$add_path'(File,PFile),
|
||||
'$get_abs_file'(PFile,Opts,AbsFile),
|
||||
'$search_in_path'(AbsFile,Opts,NewFile).
|
||||
'$find_in_path'(File,_,_,Call) :-
|
||||
'$do_error'(domain_error(source_sink,File),Call).
|
||||
|
||||
% allow paths in File Name
|
||||
'$cat_file_name'(File0,File) :-
|
||||
atom(File0), !,
|
||||
File = File0.
|
||||
'$cat_file_name'(Atoms, File) :-
|
||||
'$to_list_of_atoms'(Atoms, List, []),
|
||||
atom_concat(List, File).
|
||||
|
||||
'$to_list_of_atoms'(V, _, _) :- var(V), !, fail.
|
||||
'$to_list_of_atoms'(Atom, [Atom|L], L) :- atom(Atom), !.
|
||||
'$to_list_of_atoms'(Atoms, L1, LF) :-
|
||||
Atoms =.. [A,As,Bs],
|
||||
atom_codes(A,[D]),
|
||||
'$dir_separator'(D),
|
||||
'$to_list_of_atoms'(As, L1, [A|L2]),
|
||||
'$to_list_of_atoms'(Bs, L2, LF).
|
||||
|
||||
'$get_abs_file'(File,opts(_,RelTo,_,_,_,Expand,_),AbsFile) :-
|
||||
(
|
||||
nonvar(RelTo)
|
||||
->
|
||||
( is_absolute_file_name(File) ->
|
||||
ActualFile = File
|
||||
;
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
atom_concat([RelTo, DA, File], ActualFile)
|
||||
)
|
||||
;
|
||||
ActualFile = File
|
||||
),
|
||||
'$swi_current_prolog_flag'(file_name_variables, OldF),
|
||||
'$swi_set_prolog_flag'(file_name_variables, Expand),
|
||||
(
|
||||
'$absolute_file_name'(ActualFile,AbsFile)
|
||||
->
|
||||
'$swi_set_prolog_flag'(file_name_variables, OldF)
|
||||
;
|
||||
'$swi_set_prolog_flag'(file_name_variables, OldF),
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
'$search_in_path'(File,opts(Extensions,_,Type,Access,_,_,_),F) :-
|
||||
'$add_extensions'(Extensions, File, F0),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
'$search_in_path'(File,opts(_,_,Type,Access,_,_,_),F) :-
|
||||
'$add_type_extensions'(Type, File, F0),
|
||||
'$check_file'(F0, Type, Access, F).
|
||||
|
||||
'$check_file'(F, _Type, none, F) :- !.
|
||||
'$check_file'(F0, Type, Access, F0) :-
|
||||
access_file(F0, Access),
|
||||
(Type == directory
|
||||
->
|
||||
exists_directory(F0)
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
'$add_extensions'([Ext|_],File,F) :-
|
||||
'$mk_sure_true_ext'(Ext,NExt),
|
||||
atom_concat([File,NExt],F).
|
||||
'$add_extensions'([_|Extensions],File,F) :-
|
||||
'$add_extensions'(Extensions,File,F).
|
||||
|
||||
'$mk_sure_true_ext'(Ext,NExt) :-
|
||||
atom_codes(Ext,[C|L]),
|
||||
C \= 0'.,
|
||||
!,
|
||||
atom_codes(NExt,[0'.,C|L]).
|
||||
'$mk_sure_true_ext'(Ext,Ext).
|
||||
|
||||
'$add_type_extensions'(Type,File,F) :-
|
||||
( Type == source -> NType = prolog ; NType = Type ),
|
||||
user:prolog_file_type(Ext, NType),
|
||||
atom_concat([File,'.',Ext],F).
|
||||
'$add_type_extensions'(_,File,File).
|
||||
|
||||
'$add_path'(File,File) :-
|
||||
'$dir_separator'(D),
|
||||
atom_codes(DA,[D]),
|
||||
sub_atom(File, 0, 1, _, DA), !.
|
||||
'$add_path'(File,File).
|
||||
'$add_path'(File,PFile) :-
|
||||
recorded('$path',Path,_),
|
||||
atom_concat([Path,File],PFile).
|
||||
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPSHAREDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPCOMMONSDIR', Dirs),
|
||||
'$split_by_sep'(0, 0, Dirs, Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(system_library_directory,Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(prolog_commons_directory,Dir).
|
||||
|
||||
|
||||
'$split_by_sep'(Start, Next, Dirs, Dir) :-
|
||||
'$swi_current_prolog_flag'(windows, true), !,
|
||||
'$split_by_sep'(Start, Next, Dirs, ';', Dir).
|
||||
'$split_by_sep'(Start, Next, Dirs, Dir) :-
|
||||
'$split_by_sep'(Start, Next, Dirs, ':', Dir).
|
||||
|
||||
'$split_by_sep'(Start, Next, Dirs, Sep, Dir) :-
|
||||
sub_atom(Dirs, Next, 1, _, Let), !,
|
||||
'$continue_split_by_sep'(Let, Start, Next, Dirs, Sep, Dir).
|
||||
'$split_by_sep'(Start, Next, Dirs, _Sep, Dir) :-
|
||||
Next > Start,
|
||||
Len is Next-Start,
|
||||
sub_atom(Dirs, Start, Len, _, Dir).
|
||||
|
||||
|
||||
% closed a directory
|
||||
'$continue_split_by_sep'(Sep, Start, Next, Dirs, Sep, Dir) :-
|
||||
Sz is Next-Start,
|
||||
Sz > 0,
|
||||
sub_atom(Dirs, Start, Sz, _, Dir).
|
||||
% next dir
|
||||
'$continue_split_by_sep'(Sep , _Start, Next, Dirs, Sep, Dir) :- !,
|
||||
N1 is Next+1,
|
||||
'$split_by_sep'(N1, N1, Dirs, Dir).
|
||||
% same dir
|
||||
'$continue_split_by_sep'(_Let, Start, Next, Dirs, Sep, Dir) :-
|
||||
N1 is Next+1,
|
||||
'$split_by_sep'(Start, N1, Dirs, Sep, Dir).
|
||||
|
||||
|
||||
'$extend_path_directory'(_Name, D, File, _Opts, File, Call) :-
|
||||
is_absolute_file_name(File), !.
|
||||
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
|
||||
user:file_search_path(Name, IDirs),
|
||||
( atom(IDirs) ->
|
||||
'$split_by_sep'(0, 0, IDirs, Dir)
|
||||
;
|
||||
Dir = IDirs
|
||||
),
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Goal) :-
|
||||
atom(Dir), !,
|
||||
'$add_file_to_dir'(Dir,A,File,NFile),
|
||||
'$find_in_path'(NFile, Opts, NewFile, Goal), !.
|
||||
'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
|
||||
nonvar(Name),
|
||||
Name =.. [N,P0],
|
||||
'$add_file_to_dir'(P0,A,File,NFile),
|
||||
NewName =.. [N,NFile],
|
||||
'$find_in_path'(NewName, Opts, OFile, Goal).
|
||||
|
||||
'$add_file_to_dir'(P0,A,Atoms,NFile) :-
|
||||
atom_concat([P0,A,Atoms],NFile).
|
||||
|
||||
|
||||
%
|
||||
% This is complicated because of embedded ifs.
|
||||
%
|
||||
|
||||
@ -67,6 +67,7 @@ otherwise.
|
||||
:- bootstrap('errors.yap').
|
||||
:- bootstrap('lists.yap').
|
||||
:- bootstrap('consult.yap').
|
||||
:- bootstrap('absf.yap').
|
||||
|
||||
:- [ 'utils.yap',
|
||||
'control.yap',
|
||||
|
||||
Reference in New Issue
Block a user