1:- module(delay, [ delay/1 2 , univ/3 3 , when_proper_list/2 4 ]). 5:- use_module(library(when), [when/2]). 6 7:- multifile mode/1. 8mode('$dcg':phrase(nonvar,ground)). 9mode('$dcg':phrase(ground,_)). 10 11mode('$dcg':phrase(nonvar,ground,_)). 12mode('$dcg':phrase(ground,_,_)). 13 14mode(apply:maplist(nonvar,list,_)). 15mode(apply:maplist(nonvar,_,list)). 16 17mode(delay:univ(nonvar,_,_)). 18mode(delay:univ(_,ground,list)). 19 20mode(lists:reverse(list,_)). 21mode(lists:reverse(_,list)). 22 23mode(lists:same_length(list,_)). 24mode(lists:same_length(_,list)). 25 26mode(system:atom(nonvar)). 27 28mode(system:atom_codes(ground, _)). 29mode(system:atom_codes(_, ground)). 30 31mode(system:atomic_list_concat(ground,ground,_)). 32mode(system:atomic_list_concat(_,ground,ground)). 33 34mode(system:functor(nonvar,_,_)). 35mode(system:functor(_,ground,ground)). 36 37mode(system:float(nonvar)). 38 39mode(system:dict_pairs(nonvar,_,_)). 40mode(system:dict_pairs(_,_,list)). 41 42mode(system:integer(nonvar)). 43 44mode(system:is_dict(nonvar)). 45 46mode(system:is_dict(nonvar,_)). 47 48mode(system:length(_,ground)). 49mode(system:length(list,_)). 50 51mode(system:number_codes(ground,_)). 52mode(system:number_codes(_,ground)). 53 54mode(system:plus(ground,ground,_)). 55mode(system:plus(ground,_,ground)). 56mode(system:plus(_,ground,ground)). 57 58mode(system:string_codes(ground,_)). 59mode(system:string_codes(_,ground)). 60 61mode(system:succ(ground,_)). 62mode(system:succ(_,ground)).
Term =.. [Name|Args]
. This predicate is exported
to placate the cross-referencer. It's intended
to be called as delay(univ(T,N,As))
. Although it can be used as a
normal goal, if wanted.
72univ(Term, Name, Args) :-
73 Term =.. [Name|Args].
call(Goal)
but postpones execution until Goal's arguments are
bound enough to avoid errors like: "Arguments are not sufficiently
instantiated". This is currently realized with attributed
variables and when/2, so execution timing is identical. For example,
t :- delay(atom_codes(A,C)), A = hello, C == "hello".
does not throw an exception on the first line. One is simply declaring that A and C have a given relationship without stating when the predicate (atom_codes/2) will execute. This declarative style is especially valuable when different modes of a predicate require different goal order.
The following predicates are currently supported:
delay(length(L,Len))
warrants additional explanation. length/2
doesn't throw instantiation exceptions. It simply iterates all
possible lists and their respective lengths. This isn't always
ideal. Using delay/1 with length/2 yields the same semantics but
performs much less backtracking. It waits until either L
or Len is bound then length/2 evaluates without any choicepoints.
L must become a proper list to trigger, so incrementally binding
its head is OK.
114:- dynamic delay/1, delay_followup/1. 115:- meta_predicate delay( ). 116delay(Module:Goal) :- 117 % build a delay/1 clause to support Goal 118 119 goal_to_conditions(Module:Goal, Head, SimpleConditions, ComplexConditions), 120 !, 121 ( SimpleConditions==ComplexConditions -> 122 DelayedGoal = Module:Head 123 ; % otherwise -> 124 DelayedGoal = delay_followup(Module:Head), 125 maplist(assert_followup_clause(Module:Head), ComplexConditions) 126 ), 127 128 maplist(xfy_list(','), Simples, SimpleConditions), 129 xfy_list(';', Condition, Simples), 130 asserta(( 131 delay(Module:Head) :- 132 !, 133 when(Condition, DelayedGoal) 134 )), 135 delay(Module:Goal). 136delay(Module:Goal) :- 137 functor(Goal, Name, Arity), 138 format(atom(Msg), '~w:~w/~d not supported. See delay:mode/1', [Module,Name,Arity]), 139 throw(Msg). 140 141 142% like this: 143% goal_to_conditions( 144% length(L,Len), 145% length(X,Y), 146% [[nonvar(X)],[ground(Y)]], 147% [[list(X)],[ground(Y)]] 148% ) 149goal_to_conditions(Module:Goal, Head, SimpleConditions, ComplexConditions) :- 150 functor(Goal, Name, Arity), 151 functor(Head, Name, Arity), 152 Head =.. [Name|HeadArgs], 153 154 % find all modes for this goal 155 ( setof(Head, mode(Module:Head), Modes) -> 156 true 157 ; predicate_property(Module:Head, imported_from(Origin)) -> 158 setof(Head, mode(Origin:Head), Modes) 159 ), 160 161 partition_modes(Modes, HeadArgs, SimpleConditions, ComplexConditions). 162 163 164partition_modes([], _, [], []). 165partition_modes([Mode|Modes], HeadArgs, [SimpleH|SimpleT], [ComplexH|ComplexT]) :- 166 Mode =.. [_|ModeArgs], 167 map_include(make_condition, ModeArgs, HeadArgs, SimpleH, ComplexH), 168 partition_modes(Modes, HeadArgs, SimpleT, ComplexT). 169 170 171% convert a mode name and argument variable into when/2 conditions 172make_condition(X, _, _, _) :- 173 var(X), 174 !, 175 fail. 176make_condition(ground, X, ground(X), ground(X)). 177make_condition(nonvar, X, nonvar(X), nonvar(X)). 178make_condition(list, X, nonvar(X), list(X)). 179 180 181% create an additional clause for delay_followup/1 182assert_followup_clause(Module:Head, ComplexConditions) :- 183 exclude(is_list_mode, ComplexConditions, GuardConditions), 184 include(is_list_mode, ComplexConditions, ListConditions), 185 ( ListConditions=[] -> 186 xfy_list(',', Guard, GuardConditions), 187 Goal = Module:Head 188 ; ListConditions=[list(List)] -> 189 xfy_list(',', Guard, [nonvar(List)|GuardConditions]), 190 Goal = when_proper_list(List, Module:Head) 191 ; % otherwise -> 192 throw('Predicates with multiple `list` modes are not supported') 193 ), 194 195 assertz(( 196 delay_followup(Module:Head) :- 197 , 198 !, 199 200 )). 201 202 203% true if the given mode represents 'list' 204is_list_mode(list(_)).
212:- meta_predicate when_proper_list( , ). 213when_proper_list(List, Goal) :- 214 var(List), 215 !, 216 when(nonvar(List), when_proper_list(List, Goal)). 217when_proper_list([], Goal) :- 218 call(Goal). 219when_proper_list([_|T], Goal) :- 220 when_proper_list(T, Goal). 221 222 223% like maplist but skips elements for which Goal fails. 224% it's like the love child of maplist and exclude. 225:- meta_predicate map_include( , , , , ). 226:- meta_predicate map_include_( , , , , ). 227map_include(F, La, Lb, Lc, Ld) :- 228 map_include_(La, Lb, F, Lc, Ld). 229map_include_([], [], _, [], []). 230map_include_([Ha|Ta], [Hb|Tb], F, Lc0, Ld0) :- 231 ( call(F, Ha, Hb, Hc, Hd) -> 232 Lc0 = [Hc|Lc], 233 Ld0 = [Hd|Ld] 234 ; % otherwise -> 235 Lc0 = Lc, 236 Ld0 = Ld 237 ), 238 map_include_(Ta, Tb, F, Lc, Ld). 239 240 241% originally copied from library(list_util). 242% I don't want this pack to depend on external libraries. 243xfy_list(Op, Term, [Left|List]) :- 244 Term =.. [Op, Left, Right], 245 xfy_list(Op, Right, List), 246 !. 247xfy_list(_, Term, [Term])