some more fixes to make YAP swi compatible
fix absolute_file_name (again) fix setarg git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1951 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
fb37dd62ea
commit
5df974b857
1
C/init.c
1
C/init.c
@ -886,6 +886,7 @@ InitCodes(void)
|
||||
Yap_heap_regs->readutil_module = MkAtomTerm(Yap_LookupAtom("readutil"));
|
||||
Yap_heap_regs->hacks_module = MkAtomTerm(Yap_LookupAtom("yap_hacks"));
|
||||
Yap_heap_regs->globals_module = MkAtomTerm(Yap_LookupAtom("nb"));
|
||||
Yap_heap_regs->swi_module = MkAtomTerm(Yap_LookupAtom("swi"));
|
||||
Yap_InitModules();
|
||||
#ifdef BEAM
|
||||
Yap_heap_regs->beam_retry_code.opc = Yap_opcode(_retry_eam);
|
||||
|
||||
30
C/mavar.c
30
C/mavar.c
@ -32,11 +32,19 @@ STD_PROTO(static Int p_is_mutable, (void));
|
||||
static Int
|
||||
p_setarg(void)
|
||||
{
|
||||
CELL ti = Deref(ARG1), ts = Deref(ARG2);
|
||||
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
|
||||
Int i;
|
||||
|
||||
if (IsVarTerm(t3) &&
|
||||
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
|
||||
/* local variable */
|
||||
Term tn = MkVarTerm();
|
||||
Bind_Local(VarOfTerm(t3), tn);
|
||||
t3 = tn;
|
||||
}
|
||||
if (IsVarTerm(ti)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
} else {
|
||||
if (IsIntTerm(ti))
|
||||
i = IntOfTerm(ti);
|
||||
@ -46,7 +54,7 @@ p_setarg(void)
|
||||
i = v.Int;
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -56,34 +64,34 @@ p_setarg(void)
|
||||
CELL *pt;
|
||||
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
|
||||
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
|
||||
if (i<0)
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
if (i==0)
|
||||
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
pt = RepAppl(ts)+i;
|
||||
/* the evil deed is to be done now */
|
||||
MaBind(pt, Deref(ARG3));
|
||||
MaBind(pt, t3);
|
||||
} else if(IsPairTerm(ts)) {
|
||||
CELL *pt;
|
||||
if (i < 1 || i > 2) {
|
||||
if (i<0)
|
||||
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
pt = RepPair(ts)+i-1;
|
||||
/* the evil deed is to be done now */
|
||||
MaBind(pt, Deref(ARG3));
|
||||
MaBind(pt, t3);
|
||||
} else {
|
||||
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
|
||||
return(FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
return(TRUE);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
|
||||
12
C/stdpreds.c
12
C/stdpreds.c
@ -11,8 +11,11 @@
|
||||
* File: stdpreds.c *
|
||||
* comments: General-purpose C implemented system predicates *
|
||||
* *
|
||||
* Last rev: $Date: 2007-10-08 23:02:15 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-10 09:44:24 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.120 2007/10/08 23:02:15 vsc
|
||||
* minor fixes
|
||||
*
|
||||
* Revision 1.119 2007/04/18 23:01:16 vsc
|
||||
* fix deadlock when trying to create a module with the same name as a
|
||||
* predicate (for now, just don't lock modules). obs Paulo Moura.
|
||||
@ -3944,9 +3947,14 @@ Yap_InitCPreds(void)
|
||||
init_sys();
|
||||
init_random();
|
||||
// init_tries();
|
||||
swi_install();
|
||||
init_regexp();
|
||||
#endif
|
||||
{
|
||||
Term cm = CurrentModule;
|
||||
CurrentModule = SWI_MODULE;
|
||||
swi_install();
|
||||
CurrentModule = cm;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
6
H/Heap.h
6
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.117 2007-09-28 23:18:17 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.118 2007-10-10 09:44:24 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -491,7 +491,8 @@ typedef struct various_codes {
|
||||
system_module,
|
||||
readutil_module,
|
||||
hacks_module,
|
||||
globals_module;
|
||||
globals_module,
|
||||
swi_module;
|
||||
void *last_wtime;
|
||||
struct pred_entry *pred_goal_expansion;
|
||||
struct pred_entry *pred_meta_call;
|
||||
@ -795,6 +796,7 @@ struct various_codes *Yap_heap_regs;
|
||||
#define READUTIL_MODULE Yap_heap_regs->readutil_module
|
||||
#define HACKS_MODULE Yap_heap_regs->hacks_module
|
||||
#define GLOBALS_MODULE Yap_heap_regs->globals_module
|
||||
#define SWI_MODULE Yap_heap_regs->swi_module
|
||||
#define PredGoalExpansion Yap_heap_regs->pred_goal_expansion
|
||||
#define PredMetaCall Yap_heap_regs->pred_meta_call
|
||||
#define PredDollarCatch Yap_heap_regs->pred_dollar_catch
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: rheap.h *
|
||||
* comments: walk through heap code *
|
||||
* *
|
||||
* Last rev: $Date: 2007-09-28 23:18:17 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2007-10-10 09:44:24 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.76 2007/09/28 23:18:17 vsc
|
||||
* handle learning from interpretations.
|
||||
*
|
||||
* Revision 1.75 2007/04/10 22:13:21 vsc
|
||||
* fix max modules limitation
|
||||
*
|
||||
@ -690,6 +693,7 @@ restore_codes(void)
|
||||
Yap_heap_regs->system_module = AtomTermAdjust(Yap_heap_regs->system_module);
|
||||
Yap_heap_regs->readutil_module = AtomTermAdjust(Yap_heap_regs->readutil_module);
|
||||
Yap_heap_regs->globals_module = AtomTermAdjust(Yap_heap_regs->globals_module);
|
||||
Yap_heap_regs->swi_module = AtomTermAdjust(Yap_heap_regs->swi_module);
|
||||
if (Yap_heap_regs->file_aliases != NULL) {
|
||||
Yap_heap_regs->yap_streams =
|
||||
(struct stream_desc *)AddrAdjust((ADDR)Yap_heap_regs->yap_streams);
|
||||
|
||||
0
LGPL/chr/chr_compiler_errors.pl
Normal file
0
LGPL/chr/chr_compiler_errors.pl
Normal file
0
LGPL/chr/chr_integertable_store.pl
Normal file
0
LGPL/chr/chr_integertable_store.pl
Normal file
@ -17,6 +17,7 @@
|
||||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: setarg/3 should always set a global variable.</li>
|
||||
<li> NEW: define dialect and version_data flags.</li>
|
||||
<li> NEW: define __YAP_PROLOG__.</li>
|
||||
<li> FIXED: LAM compilation was broken (obs from Bernd Gutmann).</li>
|
||||
|
||||
@ -30,6 +30,7 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
|
||||
$(srcdir)/avl.yap \
|
||||
$(srcdir)/charsio.yap \
|
||||
$(srcdir)/cleanup.yap \
|
||||
$(srcdir)/clpfd.pl \
|
||||
$(srcdir)/dbqueues.yap \
|
||||
$(srcdir)/dgraphs.yap \
|
||||
$(srcdir)/gensym.yap \
|
||||
|
||||
@ -42,6 +42,50 @@ user:file_search_path(foreign, swi(ArchLib)) :-
|
||||
atom_concat('lib/', Arch, ArchLib).
|
||||
user:file_search_path(foreign, swi(lib)).
|
||||
|
||||
:- meta_predicate prolog:predsort(:,+,-).
|
||||
|
||||
%% 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.
|
||||
|
||||
prolog: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).
|
||||
|
||||
|
||||
%
|
||||
% maybe a good idea to eventually support this in YAP.
|
||||
% but for now just ignore it.
|
||||
@ -69,9 +113,7 @@ prolog:load_foreign_library(P) :-
|
||||
|
||||
do_volatile(_,_).
|
||||
|
||||
:- meta_predicate prolog:forall(+,:).
|
||||
|
||||
:- load_foreign_files([yap2swi], [], swi_install).
|
||||
:- meta_predicate prolog:forall(:,:).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
@ -94,6 +136,7 @@ prolog:concat_atom(List, Separator, New) :-
|
||||
prolog:concat_atom(List, New) :-
|
||||
atomic_concat(List, New).
|
||||
|
||||
|
||||
split_atom_by_chars([],_,[],L,A,[]):-
|
||||
atom_codes(A,L).
|
||||
split_atom_by_chars([C|NewChars],C,[],L,A,[NA|Atoms]) :- !,
|
||||
@ -256,3 +299,27 @@ prolog:intersection([_|T], L, R) :-
|
||||
|
||||
prolog:(Term1 =@= Term2) :-
|
||||
variant(Term1, Term2), !.
|
||||
|
||||
%% flatten(+List1, ?List2) is det.
|
||||
%
|
||||
% Is true it List2 is a non nested version of List1.
|
||||
%
|
||||
% @deprecated Ending up needing flatten/3 often indicates,
|
||||
% like append/3 for appending two lists, a bad
|
||||
% design. Efficient code that generates lists
|
||||
% from generated small lists must use difference
|
||||
% lists, often possible through grammar rules for
|
||||
% optimal readability.
|
||||
|
||||
prolog:flatten(List, FlatList) :-
|
||||
flatten(List, [], FlatList0), !,
|
||||
FlatList = FlatList0.
|
||||
|
||||
flatten(Var, Tl, [Var|Tl]) :-
|
||||
var(Var), !.
|
||||
flatten([], Tl, Tl) :- !.
|
||||
flatten([Hd|Tl], Tail, List) :- !,
|
||||
flatten(Hd, FlatHeadTail, List),
|
||||
flatten(Tl, Tail, FlatHeadTail).
|
||||
flatten(NonList, Tl, [NonList|Tl]).
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -291,7 +291,9 @@ true :- true.
|
||||
'$execute_command'(end_of_file,_,_,_) :- !.
|
||||
'$execute_command'((:-G),_,Option,_) :- !,
|
||||
'$current_module'(M),
|
||||
'$process_directive'(G, Option, M),
|
||||
% allow user expansion
|
||||
'$precompile_term'((:- G), _, (:- G1), M),
|
||||
'$process_directive'(G1, Option, M),
|
||||
fail.
|
||||
'$execute_command'((?-G),V,_,Source) :- !,
|
||||
'$execute_command'(G,V,top,Source).
|
||||
|
||||
@ -747,10 +747,10 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NFile, Call) :-
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-
|
||||
atom(Dir), !,
|
||||
atom_concat([Dir,A,File],NFile),
|
||||
'$search_in_path'(NFile, Opts, NewFile), !.
|
||||
'$find_in_path'(NFile, Opts, NewFile, Goal), !.
|
||||
'$extend_pathd'(Name, A, File, Opts, OFile, Goal) :-
|
||||
nonvar(Name),
|
||||
Name =.. [N,P0],
|
||||
|
||||
Reference in New Issue
Block a user