user:goal_expand should be called before import
add extra apply_macros and apply stuff; fix unexisting definitions. add forall/2 and ignore/1 to system stuff. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2237 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
a25234a2da
commit
316811d2cd
|
|
@ -3870,7 +3870,7 @@ static Int
|
|||
} else {
|
||||
if (tokstart != NULL && tokstart->Tok != Ord (eot_tok)) {
|
||||
/* we got the end of file from an abort */
|
||||
if (Yap_ErrorMessage == "Abort") {
|
||||
if (!strcmp(Yap_ErrorMessage,"Abort")) {
|
||||
Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
|
||||
return FALSE;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -167,8 +167,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||
#ifdef THREADS
|
||||
Yap_heap_regs->thread_handle[worker_id].thread_inst_count++;
|
||||
#endif
|
||||
UNLOCK(Yap_heap_regs->low_level_trace_lock);
|
||||
return;
|
||||
#ifdef COMMENTED
|
||||
//*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc ||
|
||||
//0x4fd4d
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* $Id: error.pl,v 1.1 2008-02-12 17:03:52 vsc Exp $
|
||||
/* $Id: error.pl,v 1.2 2008-05-15 13:41:45 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
|
|
@ -172,7 +172,7 @@ not_a_list(Type, X) :-
|
|||
'$skip_list'(Anything, [_|More], Rest).
|
||||
'$skip_list'(Anything, [_|More], Rest) :-
|
||||
'$skip_list'(Anything, More, Rest).
|
||||
'$skip_list'(Anything, Rest, Rest).
|
||||
'$skip_list'(_Anything, Rest, Rest).
|
||||
|
||||
:- endif.
|
||||
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@
|
|||
* Last rev: December 90 *
|
||||
* mods: *
|
||||
* comments: Original Tag Scheme for machines with 32 bits adresses *
|
||||
* version: $Id: Tags_64bits.h,v 1.2 2008-01-30 10:35:43 vsc Exp $ *
|
||||
* version: $Id: Tags_64bits.h,v 1.3 2008-05-15 13:41:46 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#define TAG_64BITS 1
|
||||
|
|
@ -67,8 +67,8 @@ property list
|
|||
#define TagOf(t) (Unsigned(t)&TagBits)
|
||||
#define LowTagOf(t) (Unsigned(t)&LowTagBits)
|
||||
#define NonTagPart(X) (Signed(X) & MaskPrim)
|
||||
#define TAGGEDA(TAG,V) (TAG | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */
|
||||
#define TAGGEDA(TAG,V) (Unsigned(TAG) | Unsigned(V))
|
||||
#define TAGGED(TAG,V) (Unsigned(TAG) | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */
|
||||
#define NONTAGGED(TAG,V) NonTagPart(Unsigned(V)<<3) /* SQRT(8) */
|
||||
#define CHKTAG(t,Tag) ((Unsigned(t)&TagBits)==Tag)
|
||||
|
||||
|
|
|
|||
8
H/Yap.h
8
H/Yap.h
|
|
@ -10,7 +10,7 @@
|
|||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h,v 1.35 2008-05-13 10:37:27 vsc Exp $ *
|
||||
* version: $Id: Yap.h,v 1.36 2008-05-15 13:41:46 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
|
|
@ -250,7 +250,7 @@ extern char Yap_Option[20];
|
|||
#endif
|
||||
#endif /* !IN_SECOND_QUADRANT */
|
||||
|
||||
#ifdef THREADS
|
||||
#ifdef USE_SYSTEM_MALLOC
|
||||
#define HEAP_INIT_BASE 0L
|
||||
#define AtomBase NULL
|
||||
#else
|
||||
|
|
@ -855,7 +855,7 @@ inline EXTERN Term MkAtomTerm (Atom);
|
|||
inline EXTERN Term
|
||||
MkAtomTerm (Atom a)
|
||||
{
|
||||
return (Term) ((AtomTag | (CELL) (a)));
|
||||
return (Term) (AtomTag | (CELL) (a));
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -876,7 +876,7 @@ inline EXTERN Term MkAtomTerm (Atom);
|
|||
inline EXTERN Term
|
||||
MkAtomTerm (Atom a)
|
||||
{
|
||||
return (Term) (TAGGEDA (AtomTag, (CELL) (a)));
|
||||
return (Term) (TAGGEDA ((CELL)AtomTag, (CELL) (a)));
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* $Id: apply_macros.pl,v 1.1 2008-03-13 14:37:59 vsc Exp $
|
||||
/* $Id: apply_macros.pl,v 1.2 2008-05-15 13:41:46 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,13 @@ xb
|
|||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: user:expand_goal should be called before import,
|
||||
not after.</li>
|
||||
<li> NEW: add apply SWI library to apply_macros.</li>
|
||||
<li> NEW: add forall/2 and ignore/1 to system (SWI compatibility).</li>
|
||||
<li> FIXED: apply_macros should also define the predicates it exports
|
||||
(obs from Rui Mendes).</li>
|
||||
<li> FIXED: complain if we want to redefine an imported module.</li>
|
||||
<li> FIXED: X is -(222222222222) would crash (obs from Jan Wielemaker).</li>
|
||||
<li> FIXED: more restore fixes.</li>
|
||||
<li> FIXED: don't ever jump to mid of lu code.</li>
|
||||
|
|
|
|||
73
docs/yap.tex
73
docs/yap.tex
|
|
@ -191,6 +191,7 @@ Subnodes of Database
|
|||
* BlackBoard:: Storing and Fetching Terms in the BlackBoard
|
||||
|
||||
Subnodes of Library
|
||||
* Apply:: SWI-Compatible Apply library.
|
||||
* Apply Macros:: Apply a Predicate to a list or to sub-terms.
|
||||
* Association Lists:: Binary Tree Implementation of Association Lists.
|
||||
* AVL Trees:: Predicates to add and lookup balanced binary trees.
|
||||
|
|
@ -240,7 +241,6 @@ Subnodes of Attributes
|
|||
|
||||
Subnodes of SWI-Prolog
|
||||
* Invoking Predicates on all Members of a List :: maplist and friends
|
||||
* Forall :: forall built-in
|
||||
* hProlog and SWI-Prolog Attributed Variables :: Emulating SWI-like attributed variables
|
||||
* SWI-Prolog Global Variables :: Emulating SWI-like attributed variables
|
||||
|
||||
|
|
@ -2741,6 +2741,32 @@ Execute the goal @var{G} only once. The predicate is defined by:
|
|||
Note that cuts inside @code{once/1} can only cut the other goals inside
|
||||
@code{once/1}.
|
||||
|
||||
@item forall(:@var{Cond},:@var{Action})
|
||||
@findex forall/2
|
||||
@snindex forall/2
|
||||
@cnindex forall/2
|
||||
For all alternative bindings of @var{Cond} @var{Action} can be
|
||||
proven. The example verifies that all arithmetic statements in the list
|
||||
@var{L} are correct. It does not say which is wrong if one proves wrong.
|
||||
|
||||
@example
|
||||
?- forall(member(Result = Formula, [2 = 1 + 1, 4 = 2 * 2]),
|
||||
Result =:= Formula).
|
||||
@end example
|
||||
|
||||
@item ignore(:@var{Goal})
|
||||
@findex ignore/1
|
||||
@snindex ignore/1
|
||||
@cnindex ignore/1
|
||||
Calls @var{Goal} as @code{once/1}, but succeeds, regardless of whether
|
||||
@code{Goal} succeeded or not. Defined as:
|
||||
|
||||
@example
|
||||
ignore(Goal) :-
|
||||
Goal, !.
|
||||
ignore(_).
|
||||
@end example
|
||||
|
||||
@item abort
|
||||
@findex abort/0
|
||||
@syindex abort/0
|
||||
|
|
@ -7928,6 +7954,7 @@ most files in the library are from the Edinburgh Prolog library.
|
|||
@menu
|
||||
|
||||
Library, Extensions, Built-ins, Top
|
||||
* Apply:: SWI-Compatible Apply library.
|
||||
* Apply Macros:: Apply a Predicate to a list or to sub-terms.
|
||||
* Association Lists:: Binary Tree Implementation of Association Lists.
|
||||
* AVL Trees:: Predicates to add and lookup balanced binary trees.
|
||||
|
|
@ -7961,7 +7988,15 @@ Library, Extensions, Built-ins, Top
|
|||
@end menu
|
||||
|
||||
|
||||
@node Apply Macros, Association Lists, , Library
|
||||
@node Apply, Apply Macros, , Library
|
||||
@section Apply Macros
|
||||
@cindex macros
|
||||
|
||||
This library provides a SWI-compatible set of utilities for applying a
|
||||
predicate to all elements of a list. The library just forwards
|
||||
definitions from the @code{apply_macros} library.
|
||||
|
||||
@node Apply Macros, Association Lists, Apply, Library
|
||||
@section Apply Macros
|
||||
@cindex macros
|
||||
|
||||
|
|
@ -8045,7 +8080,39 @@ collects a result in @var{Accumulator}
|
|||
@snindex sumnodes/4
|
||||
@cnindex sumnodes/4
|
||||
Calls the predicate @var{Pred} on all sub-terms of @var{Term} and
|
||||
collect a result in @var{Accumulator} (depth-first and left-to-right order)
|
||||
collect a result in @var{Accumulator} (depth-first and left-to-right
|
||||
order)
|
||||
|
||||
@item include(+@var{Pred}, +@var{ListIn}, ?@var{ListOut})
|
||||
@findex include/3
|
||||
@snindex include/3
|
||||
@cnindex include/3
|
||||
Same as @code{selectlist/3}.
|
||||
|
||||
@item exclude(+@var{Goal}, +@var{List1}, ?@var{List2})
|
||||
@findex exclude/3
|
||||
@snindex exclude/3
|
||||
@cnindex exclude/3
|
||||
Filter elements for which @var{Goal} fails. True if @var{List2} contains
|
||||
those elements @var{Xi} of @var{List1} for which @code{call(Goal, Xi)} fails.
|
||||
|
||||
@item partition(+@var{Pred}, +@var{List1}, ?@var{Included}, ?@var{Excluded})
|
||||
@findex partition/4
|
||||
@snindex partition/4
|
||||
@cnindex partition/4
|
||||
Filter elements of @var{List} according to @var{Pred}. True if
|
||||
@var{Included} contains all elements for which @code{call(Pred, X)}
|
||||
succeeds and @var{Excluded} contains the remaining elements.
|
||||
|
||||
@item partition(+@var{Pred}, +@var{List1}, ?@var{Lesser}, ?@var{Equal}, ?@var{Greater})
|
||||
@findex partition/5
|
||||
@snindex partition/5
|
||||
@cnindex partition/5
|
||||
Filter list according to @var{Pred} in three sets. For each element
|
||||
@var{Xi} of @var{List}, its destination is determined by
|
||||
@code{call(Pred, Xi, Place)}, where @var{Place} must be unified to one
|
||||
of @code{<}, @code{=} or @code{>}. @code{Pred} must be deterministic.
|
||||
|
||||
@end table
|
||||
|
||||
Examples:
|
||||
|
|
|
|||
|
|
@ -24,7 +24,8 @@ INSTALL_PROGRAM=@INSTALL_PROGRAM@
|
|||
srcdir=@srcdir@
|
||||
YAP_EXTRAS=@YAP_EXTRAS@
|
||||
|
||||
PROGRAMS= $(srcdir)/apply_macros.yap \
|
||||
PROGRAMS= $(srcdir)/apply.yap \
|
||||
$(srcdir)/apply_macros.yap \
|
||||
$(srcdir)/arg.yap \
|
||||
$(srcdir)/assoc.yap \
|
||||
$(srcdir)/atts.yap \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,9 @@
|
|||
|
||||
:- reexport(library(apply_macros),
|
||||
[maplist/3,
|
||||
include/3,
|
||||
exclude/3,
|
||||
partition/4,
|
||||
partition/5
|
||||
]).
|
||||
|
||||
|
|
@ -4,17 +4,235 @@
|
|||
% Purpose: Macros to apply a predicate to all elements
|
||||
% of a list or to all sub-terms of a term.
|
||||
|
||||
:- module(apply_macros, []).
|
||||
% Also has code from:
|
||||
% File : APPLIC.PL
|
||||
% Author : Lawrence Byrd + Richard A. O'Keefe
|
||||
% Updated: 4 August 1984 and Ken Johnson 11-8-87
|
||||
% Purpose: Various "function" application routines based on apply/2.
|
||||
% Needs : append/3 from listut.pl
|
||||
|
||||
|
||||
:- module(apply_macros, [selectlist/3,
|
||||
checklist/2,
|
||||
maplist/3,
|
||||
convlist/3,
|
||||
mapargs/3,
|
||||
sumargs/4,
|
||||
mapnodes/3,
|
||||
checknodes/2,
|
||||
sumlist/4,
|
||||
sumnodes/4,
|
||||
include/3,
|
||||
exclude/3,
|
||||
partition/4,
|
||||
partition/5
|
||||
]).
|
||||
|
||||
:- meta_predicate
|
||||
selectlist(:,+,-),
|
||||
checklist(:,+),
|
||||
maplist(:,+,-),
|
||||
convlist(:,+,-),
|
||||
mapargs(:,+,-),
|
||||
mapargs_args(:,+,-,+),
|
||||
sumargs(:,+,+,-),
|
||||
sumargs_args(:,+,+,-,+),
|
||||
mapnodes(:,+,-),
|
||||
mapnodes_list(:,+,-),
|
||||
checknodes(:,+),
|
||||
checknodes_list(:,+),
|
||||
sumlist(:,+,+,-),
|
||||
sumnodes(:,+,+,-),
|
||||
sumnodes_body(:,+,+,-,+,+),
|
||||
include(:,+,-),
|
||||
exclude(:,+,-),
|
||||
partition(:,+,-,-),
|
||||
partition(:,+,-,-,-).
|
||||
|
||||
|
||||
:- multifile user:goal_expansion/3.
|
||||
|
||||
:- use_module(library(lists), [append/3]).
|
||||
:- use_module(library(charsio), [format_to_chars/3, read_from_chars/2]).
|
||||
:- use_module(library(error), [must_be/2]).
|
||||
|
||||
user:goal_expansion(maplist(Meta, ListIn, ListOut), Module, Goal) :-
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% Definitions for Metacalls
|
||||
%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
include(G,In,Out) :-
|
||||
selectlist(G, In, Out).
|
||||
|
||||
selectlist(_, [], []).
|
||||
selectlist(Pred, [In|ListIn], ListOut) :-
|
||||
(call(Pred, In) ->
|
||||
ListOut = [In|NewListOut]
|
||||
;
|
||||
ListOut = NewListOut
|
||||
),
|
||||
selectlist(Pred, ListIn, NewListOut).
|
||||
|
||||
exclude(_, [], []).
|
||||
exclude(Pred, [In|ListIn], ListOut) :-
|
||||
(call(Pred, In) ->
|
||||
ListOut = NewListOut
|
||||
;
|
||||
ListOut = [In|NewListOut]
|
||||
),
|
||||
exclude(Pred, ListIn, NewListOut).
|
||||
|
||||
partition(_, [], [], []).
|
||||
partition(Pred, [In|ListIn], List1, List2) :-
|
||||
(call(Pred, In) ->
|
||||
List1 = [In|RList1],
|
||||
List2 = RList2
|
||||
;
|
||||
List1 = RList1,
|
||||
List2 = [In|RList2]
|
||||
),
|
||||
partition(Pred, ListIn, RList1, RList2).
|
||||
|
||||
partition(_, [], [], [], []).
|
||||
partition(Pred, [In|ListIn], List1, List2, List3) :-
|
||||
call(Pred, In, Diff),
|
||||
( Diff == (<) ->
|
||||
List1 = [In|RList1],
|
||||
List2 = RList2,
|
||||
List3 = RList3
|
||||
;
|
||||
Diff == (=) ->
|
||||
List1 = RList1,
|
||||
List2 = [In|RList2],
|
||||
List3 = RList3
|
||||
;
|
||||
Diff == (>) ->
|
||||
List1 = RList1,
|
||||
List2 = RList2,
|
||||
List3 = [In|RList3]
|
||||
;
|
||||
must_be(oneof([<,=,>]), Diff)
|
||||
),
|
||||
partition(Pred, ListIn, RList1, RList2, RList3).
|
||||
|
||||
checklist(_, []).
|
||||
checklist(Pred, [In|ListIn]) :-
|
||||
call(Pred, In),
|
||||
checklist(Pred, ListIn).
|
||||
|
||||
% maplist(Pred, OldList, NewList)
|
||||
% succeeds when Pred(Old,New) succeeds for each corresponding
|
||||
% Old in OldList, New in NewList. In InterLisp, this is MAPCAR.
|
||||
% It is also MAP2C. Isn't bidirectionality wonderful?
|
||||
maplist(_, [], []).
|
||||
maplist(Pred, [In|ListIn], [Out|ListOut]) :-
|
||||
call(Pred, In, Out),
|
||||
maplist(Pred, ListIn, ListOut).
|
||||
|
||||
% convlist(Rewrite, OldList, NewList)
|
||||
% is a sort of hybrid of maplist/3 and sublist/3.
|
||||
% Each element of NewList is the image under Rewrite of some
|
||||
% element of OldList, and order is preserved, but elements of
|
||||
% OldList on which Rewrite is undefined (fails) are not represented.
|
||||
% Thus if foo(X,Y) :- integer(X), Y is X+1.
|
||||
% then convlist(foo, [1,a,0,joe(99),101], [2,1,102]).
|
||||
convlist(_, [], []).
|
||||
convlist(Pred, [Old|Olds], NewList) :-
|
||||
call(Pred, Old, New),
|
||||
!,
|
||||
NewList = [New|News],
|
||||
convlist(Pred, Olds, News).
|
||||
convlist(Pred, [_|Olds], News) :-
|
||||
convlist(Pred, Olds, News).
|
||||
|
||||
mapargs(Pred, TermIn, TermOut) :-
|
||||
functor(TermIn, F, N),
|
||||
functor(TermOut, F, N),
|
||||
mapargs_args(Pred, TermIn, TermOut, N).
|
||||
|
||||
mapargs_args(_, _, _, 0) :- !.
|
||||
mapargs_args(Pred, TermIn, TermOut, I) :-
|
||||
arg(I, TermIn, InArg),
|
||||
arg(I, TermOut, OutArg),
|
||||
I1 is I-1,
|
||||
call(Pred, InArg, OutArg),
|
||||
mapargs_args(Pred, TermIn, TermOut, I1).
|
||||
|
||||
sumargs(Pred, Term, A0, A1) :-
|
||||
functor(Term, _, N),
|
||||
sumargs(Pred, Term, A0, A1, N).
|
||||
|
||||
sumargs_args(_, _, A0, A1, 0) :-
|
||||
!,
|
||||
A0 = A1.
|
||||
sumargs_args(Pred, Term, A1, A3, N) :-
|
||||
arg(N, Term, Arg),
|
||||
N1 is N - 1,
|
||||
call(Pred, Arg, A1, A2),
|
||||
sumargs_args(Pred, Term, A2, A3, N1).
|
||||
|
||||
mapnodes(Pred, TermIn, TermOut) :-
|
||||
(atomic(TermIn); var(TermOut)), !,
|
||||
call(Pred, TermIn, TermOut).
|
||||
mapnodes(Pred, TermIn, TermOut) :-
|
||||
call(Pred, TermIn, Temp),
|
||||
Temp =.. [Func|ArgsIn],
|
||||
mapnodes_list(Pred, ArgsIn, ArgsOut),
|
||||
TermOut =.. [Func|ArgsOut].
|
||||
|
||||
mapnodes_list(_, [], []).
|
||||
appnodes_list(Pred, [TermIn|ArgsIn], [TermOut|ArgsOut]) :-
|
||||
mapnodes(Pred, TermIn, TermOut),
|
||||
mapnodes_list(Pred, ArgsIn, ArgsOut).
|
||||
|
||||
checknodes(Pred, Term) :-
|
||||
(atomic(Term); var(Term)), !,
|
||||
call(Pred, Term).
|
||||
checknodes(Pred, Term) :-
|
||||
call(Pred, Term),
|
||||
Term =.. [_|Args],
|
||||
checknodes_list(Pred, Args).
|
||||
|
||||
checknodes_list(_, []).
|
||||
checknodes_list(Pred, [Term|Args]) :-
|
||||
checknodes_body(Pred, Term),
|
||||
checknodes_list(Pred, Args).
|
||||
|
||||
sumlist(_, [], Acc, Acc).
|
||||
sumlist(Pred, [H|T], AccIn, AccOut) :-
|
||||
call(Pred, H, AccIn, A1),
|
||||
sumlist(Pred, T, A1, AccOut).
|
||||
|
||||
sumnodes(Pred, Term, A0, A2) :-
|
||||
call(Pred, Term, A0, A1),
|
||||
(compound(Term) ->
|
||||
functor(Term, _, N),
|
||||
sumnodes_body(Pred, Term, A1, A2, 0, N)
|
||||
; % simple term or variable
|
||||
A1 = A2
|
||||
).
|
||||
|
||||
sumnodes_body(Pred, Term, A1, A3, N0, Ar) :-
|
||||
N0 < Ar ->
|
||||
N is N0+1,
|
||||
arg(N, Term, Arg),
|
||||
sumnodes(Pred, Arg, A1, A2),
|
||||
sumnodes_body(Pred, Term, A2, A3, N, Ar)
|
||||
;
|
||||
A1 = A3.
|
||||
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%%
|
||||
%% preprocessing for meta-calls
|
||||
%%
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
|
||||
user:goal_expansion(maplist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(maplist, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, ListOut], GoalArgs),
|
||||
|
|
@ -25,15 +243,16 @@ user:goal_expansion(maplist(Meta, ListIn, ListOut), Module, Goal) :-
|
|||
append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead),
|
||||
append_args(Pred, [In, Out], Apply),
|
||||
append_args(HeadPrefix, [Ins, Outs], RecursiveCall),
|
||||
write(Goal),nl,
|
||||
compile_aux([
|
||||
Base,
|
||||
(RecursionHead :- Apply, RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(checklist(Meta, List), Module, Goal) :-
|
||||
user:goal_expansion(checklist(Meta, List), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(checklist, Proto, GoalName),
|
||||
append(MetaVars, [List], GoalArgs),
|
||||
|
|
@ -49,10 +268,10 @@ user:goal_expansion(checklist(Meta, List), Module, Goal) :-
|
|||
(RecursionHead :- Apply, RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(selectlist(Meta, ListIn, ListOut), Module, Goal) :-
|
||||
user:goal_expansion(selectlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(selectlist, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, ListOut], GoalArgs),
|
||||
|
|
@ -70,10 +289,112 @@ user:goal_expansion(selectlist(Meta, ListIn, ListOut), Module, Goal) :-
|
|||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(convlist(Meta, ListIn, ListOut), Module, Goal) :-
|
||||
% same as selectlist
|
||||
user:goal_expansion(include(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(include, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, ListOut], GoalArgs),
|
||||
Goal =.. [GoalName|GoalArgs],
|
||||
% the new predicate declaration
|
||||
HeadPrefix =.. [GoalName|PredVars],
|
||||
append_args(HeadPrefix, [[], []], Base),
|
||||
append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
|
||||
append_args(Pred, [In], Apply),
|
||||
append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
|
||||
compile_aux([
|
||||
Base,
|
||||
(RecursionHead :-
|
||||
(Apply -> Outs = [In|NOuts]; Outs = NOuts),
|
||||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(exclude(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(exclude, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, ListOut], GoalArgs),
|
||||
Goal =.. [GoalName|GoalArgs],
|
||||
% the new predicate declaration
|
||||
HeadPrefix =.. [GoalName|PredVars],
|
||||
append_args(HeadPrefix, [[], []], Base),
|
||||
append_args(HeadPrefix, [[In|Ins], Outs], RecursionHead),
|
||||
append_args(Pred, [In], Apply),
|
||||
append_args(HeadPrefix, [Ins, NOuts], RecursiveCall),
|
||||
compile_aux([
|
||||
Base,
|
||||
(RecursionHead :-
|
||||
(Apply -> Outs = [In|NOuts]; Outs = NOuts),
|
||||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(partition(Meta, ListIn, List1, List2), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(partition, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, List1, List2], GoalArgs),
|
||||
Goal =.. [GoalName|GoalArgs],
|
||||
% the new predicate declaration
|
||||
HeadPrefix =.. [GoalName|PredVars],
|
||||
append_args(HeadPrefix, [[], [], []], Base),
|
||||
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2], RecursionHead),
|
||||
append_args(Pred, [In], Apply),
|
||||
append_args(HeadPrefix, [Ins, NOuts1, NOuts2], RecursiveCall),
|
||||
compile_aux([
|
||||
Base,
|
||||
(RecursionHead :-
|
||||
(Apply -> Outs1 = [In|NOuts1], Outs2 = NOuts2; Outs1 = NOuts1, Outs2 = [In|NOuts2]),
|
||||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(partition(Meta, ListIn, List1, List2, List3), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(partition2, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, List1, List2, List3], GoalArgs),
|
||||
Goal =.. [GoalName|GoalArgs],
|
||||
% the new predicate declaration
|
||||
HeadPrefix =.. [GoalName|PredVars],
|
||||
append_args(HeadPrefix, [[], [], [], []], Base),
|
||||
append_args(HeadPrefix, [[In|Ins], Outs1, Outs2, Outs3], RecursionHead),
|
||||
append_args(Pred, [In,Diff], Apply),
|
||||
append_args(HeadPrefix, [Ins, NOuts1, NOuts2, NOuts3], RecursiveCall),
|
||||
compile_aux([
|
||||
Base,
|
||||
(RecursionHead :-
|
||||
Apply,
|
||||
(Diff == (<) ->
|
||||
Outs1 = [In|NOuts1],
|
||||
Outs2 = NOuts2,
|
||||
Outs3 = NOuts3
|
||||
;
|
||||
Diff == (=) ->
|
||||
Outs1 = NOuts1,
|
||||
Outs2 = [In|NOuts2],
|
||||
Outs3 = NOuts3
|
||||
;
|
||||
Diff == (>) ->
|
||||
Outs1 = NOuts1,
|
||||
Outs2 = NOuts2,
|
||||
Outs3 = [In|NOuts3]
|
||||
;
|
||||
error:must_be(oneof([<,=,>]), Diff)
|
||||
),
|
||||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(convlist(Meta, ListIn, ListOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(convlist, Proto, GoalName),
|
||||
append(MetaVars, [ListIn, ListOut], GoalArgs),
|
||||
|
|
@ -91,10 +412,10 @@ user:goal_expansion(convlist(Meta, ListIn, ListOut), Module, Goal) :-
|
|||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(sumlist(Meta, List, AccIn, AccOut), Module, Goal) :-
|
||||
user:goal_expansion(sumlist(Meta, List, AccIn, AccOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(sumlist, Proto, GoalName),
|
||||
append(MetaVars, [List, AccIn, AccOut], GoalArgs),
|
||||
|
|
@ -132,10 +453,10 @@ user:goal_expansion(sumargs(Meta, Term, AccIn, AccOut), _Module, Goal) :-
|
|||
sumlist(Meta, TermArgs, AccIn, AccOut)
|
||||
).
|
||||
|
||||
user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Module, Goal) :-
|
||||
user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(mapnodes, Proto, GoalName),
|
||||
append(MetaVars, [[InTerm], [OutTerm]], GoalArgs),
|
||||
|
|
@ -162,10 +483,10 @@ user:goal_expansion(mapnodes(Meta, InTerm, OutTerm), Module, Goal) :-
|
|||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(checknodes(Meta, Term), Module, Goal) :-
|
||||
user:goal_expansion(checknodes(Meta, Term), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(checknodes, Proto, GoalName),
|
||||
append(MetaVars, [[Term]], GoalArgs),
|
||||
|
|
@ -190,10 +511,10 @@ user:goal_expansion(checknodes(Meta, Term), Module, Goal) :-
|
|||
RecursiveCall)
|
||||
], Module).
|
||||
|
||||
user:goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Module, Goal) :-
|
||||
user:goal_expansion(sumnodes(Meta, Term, AccIn, AccOut), Mod, Goal) :-
|
||||
callable(Meta),
|
||||
!,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto),
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Mod, Module),
|
||||
% the new goal
|
||||
pred_name(sumnodes, Proto, GoalName),
|
||||
append(MetaVars, [[Term], AccIn, AccOut], GoalArgs),
|
||||
|
|
@ -247,7 +568,9 @@ append_args(Term, Args, NewTerm) :-
|
|||
append(OldArgs, Args, GoalArgs),
|
||||
NewTerm =.. [Meta|GoalArgs].
|
||||
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto) :-
|
||||
aux_preds(Module:Meta, MetaVars, Pred, PredVars, Proto, _, OModule) :- !,
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, OModule).
|
||||
aux_preds(Meta, MetaVars, Pred, PredVars, Proto, Module, Module) :-
|
||||
Meta =.. [F|Args],
|
||||
aux_args(Args, MetaVars, PredArgs, PredVars, ProtoArgs),
|
||||
Pred =.. [F|PredArgs],
|
||||
|
|
@ -262,5 +585,6 @@ aux_args([Arg|Args], MVars, [Arg|PArgs], PVars, [Arg|ProtoArgs]) :-
|
|||
aux_args(Args, MVars, PArgs, PVars, ProtoArgs).
|
||||
|
||||
pred_name(Macro, Proto, Name) :-
|
||||
format_to_chars("'~a(~w)'.",[Macro, Proto], Chars),
|
||||
format_to_chars('\'~a(~w)\'.',[Macro, Proto], Chars),
|
||||
read_from_chars(Chars, Name).
|
||||
|
||||
|
|
|
|||
|
|
@ -179,8 +179,6 @@ prolog:load_foreign_library(P) :-
|
|||
|
||||
do_volatile(_,_).
|
||||
|
||||
:- meta_predicate prolog:forall(:,:).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
prolog:term_to_atom(Term,Atom) :-
|
||||
|
|
@ -227,19 +225,8 @@ prolog:is_absolute_file_name(X) :-
|
|||
prolog:read_clause(X,Y) :-
|
||||
read_term(X,Y,[singetons(warning)]).
|
||||
|
||||
prolog:forall(X,Y) :-
|
||||
catch(do_forall(X,Y), fail_forall, fail).
|
||||
|
||||
prolog:string(_) :- fail.
|
||||
|
||||
do_forall(X,Y) :-
|
||||
call(X),
|
||||
do_for_forall(Y).
|
||||
do_forall(_,_).
|
||||
|
||||
do_for_forall(Y) :- call(Y), !, fail.
|
||||
do_for_forall(_) :- throw(fail_forall).
|
||||
|
||||
prolog:between(I,_,I).
|
||||
prolog:between(I0,I,J) :- I0 < I,
|
||||
I1 is I0+1,
|
||||
|
|
|
|||
|
|
@ -61,6 +61,14 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
|
|||
'$do_c_built_in'(once(G), M, (yap_hacks:current_choice_point(CP),NG,'$$cut_by'(CP))) :- !,
|
||||
'$do_c_built_in'(G,M,NG0),
|
||||
'$clean_cuts'(NG0, NG).
|
||||
'$do_c_built_in'(forall(Cond,Action), M, \+((NCond, \+(NAction)))) :- !,
|
||||
'$do_c_built_in'(Cond,M,ICond),
|
||||
'$do_c_built_in'(Action,M,IAction),
|
||||
'$clean_cuts'(ICond, NCond),
|
||||
'$clean_cuts'(IAction, NAction).
|
||||
'$do_c_built_in'(ignore(Goal), M, (NGoal -> true ; true)) :- !,
|
||||
'$do_c_built_in'(Goal,M,IGoal),
|
||||
'$clean_cuts'(IGoal, NGoal).
|
||||
'$do_c_built_in'(if(G,A,B), M, (yap_hacks:current_choicepoint(DCP),NG,yap_hacks:cut_at(DCP),NA; NB)) :- !,
|
||||
'$do_c_built_in'(A,M,NA0),
|
||||
'$clean_cuts'(NA0, NA),
|
||||
|
|
|
|||
26
pl/boot.yap
26
pl/boot.yap
|
|
@ -410,7 +410,7 @@ true :- true.
|
|||
|
||||
% process an input clause
|
||||
'$$compile'(G, G0, L, Mod) :-
|
||||
'$head_and_body'(G,H,_),
|
||||
'$head_and_body'(G,H,_),
|
||||
'$flags'(H, Mod, Fl, Fl),
|
||||
is(NFl, /\, Fl, 0x00002000),
|
||||
(
|
||||
|
|
@ -424,28 +424,36 @@ true :- true.
|
|||
'$dynamic'(N/A,Mod),
|
||||
'$assertz_dynamic'(L,G,G0,Mod)
|
||||
;
|
||||
'$not_imported'(H, Mod),
|
||||
'$compile'(G, L, G0, Mod)
|
||||
).
|
||||
|
||||
'$check_if_reconsulted'(N,A) :-
|
||||
'$not_imported'(H, Mod) :-
|
||||
recorded('$import','$import'(NM,Mod,NH,H,_,_),_),
|
||||
NM \= Mod, !,
|
||||
functor(NH,N,Ar),
|
||||
'$do_error'(permission_error(modify, static_procedure, NM:N/Ar), consult).
|
||||
'$not_imported'(_, _).
|
||||
|
||||
'$check_if_reconsulted'(N,A) :-
|
||||
recorded('$reconsulted',X,_),
|
||||
( X = N/A , !;
|
||||
X = '$', !, fail;
|
||||
fail
|
||||
).
|
||||
|
||||
'$inform_as_reconsulted'(N,A) :-
|
||||
'$inform_as_reconsulted'(N,A) :-
|
||||
recorda('$reconsulted',N/A,_).
|
||||
|
||||
'$clear_reconsulting' :-
|
||||
recorded('$reconsulted',X,Ref),
|
||||
erase(Ref),
|
||||
X == '$', !,
|
||||
( recorded('$reconsulting',_,R) -> erase(R) ).
|
||||
'$clear_reconsulting' :-
|
||||
recorded('$reconsulted',X,Ref),
|
||||
erase(Ref),
|
||||
X == '$', !,
|
||||
( recorded('$reconsulting',_,R) -> erase(R) ).
|
||||
|
||||
/* Executing a query */
|
||||
|
||||
'$query'(end_of_file,_).
|
||||
'$query'(end_of_file,_).
|
||||
|
||||
% ***************************
|
||||
% * -------- YAPOR -------- *
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
* File: utilities for displaying messages in YAP. *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2008-04-02 17:37:07 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-05-15 13:41:47 $,$Author: vsc $ *
|
||||
* *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
|
@ -211,10 +211,10 @@ system_message(error(permission_error(modify,flag,W), _)) -->
|
|||
[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
|
||||
system_message(error(permission_error(modify,operator,W), _)) -->
|
||||
[ 'PERMISSION ERROR- T cannot declare ~w an operator' - [W] ].
|
||||
system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
|
||||
system_message(error(permission_error(modify,static_procedure,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a static procedure' - [Where] ].
|
||||
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), _)) -->
|
||||
|
|
|
|||
|
|
@ -289,6 +289,11 @@ module(N) :-
|
|||
%
|
||||
% next, check if this is something imported.
|
||||
%
|
||||
% first, try doing goal_expansion
|
||||
'$module_expansion'(G, G1, G0, CurMod, MM, TM, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G, CurMod, GI), !,
|
||||
'$module_expansion'(GI, G1, G0, CurMod, MM, TM, HVars).
|
||||
'$module_expansion'(G, G1, GO, CurMod, MM, TM, HVars) :-
|
||||
% is this imported from some other module M1?
|
||||
( '$imported_pred'(G, CurMod, GG, M1) ->
|
||||
|
|
@ -328,10 +333,6 @@ module(N) :-
|
|||
% goal to pass to compiler
|
||||
% goal to pass to listing
|
||||
% head variables.
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$pred_goal_expansion_on',
|
||||
user:goal_expansion(G,M,GI), !,
|
||||
'$module_expansion'(GI, G1, G2, M, CM, TM, HVars).
|
||||
'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :-
|
||||
'$all_system_predicate'(G,M), !,
|
||||
'$c_built_in'(G, M, Gi),
|
||||
|
|
@ -535,9 +536,11 @@ source_module(Mod) :-
|
|||
ensure_loaded(:),
|
||||
findall(?,:,?),
|
||||
findall(?,:,?,?),
|
||||
forall(:,:),
|
||||
freeze(?,:),
|
||||
hide_predicate(:),
|
||||
if(:,:,:),
|
||||
ignore(:),
|
||||
incore(:),
|
||||
listing(:),
|
||||
multifile(:),
|
||||
|
|
|
|||
|
|
@ -17,6 +17,10 @@
|
|||
|
||||
once(G) :- '$execute'(G), !.
|
||||
|
||||
forall(Cond, Action) :- \+((Cond, \+(Action))).
|
||||
|
||||
ignore(Goal) :- (Goal->true;true).
|
||||
|
||||
if(X,Y,Z) :-
|
||||
yap_hacks:env_choice_point(CP0),
|
||||
(
|
||||
|
|
|
|||
Reference in New Issue