edcg.pl (20812B)
1 :- module( edcg, [ 2 op(1200, xfx, '-->>'), % Similar to '-->' 3 op(1200, xfx, '==>>'), % Similar to '-->' 4 op( 990, fx, '?'), % For guards with '==>>' 5 edcg_import_sentinel/0 6 ]). 7 8 % If running a version of SWI-Prolog older than 8.3.19, define the 9 % '=>' operator to prevent syntax errors in this module. The '==>>' 10 % operator is still defined in the module export, even though it'll 11 % generate a runtime error if it's used. 12 :- if(\+ current_op(_, _, '=>')). 13 :- op(1200, xfx, '=>'). 14 :- endif. 15 16 :- use_module(library(debug), [debug/3]). 17 :- use_module(library(lists), [member/2, selectchk/3]). 18 :- use_module(library(apply), [maplist/3, maplist/4, foldl/4]). 19 20 % These predicates define extra arguments and are defined in the 21 % modules that use the edcg module. 22 :- multifile 23 acc_info/5, 24 acc_info/7, 25 pred_info/3, 26 pass_info/1, 27 pass_info/2. 28 29 :- multifile 30 prolog_clause:make_varnames_hook/5, 31 prolog_clause:unify_clause_hook/5. 32 33 % True if the module being read has opted-in to EDCG macro expansion. 34 wants_edcg_expansion :- 35 prolog_load_context(module, Module), 36 wants_edcg_expansion(Module). 37 38 wants_edcg_expansion(Module) :- 39 Module \== edcg, % don't expand macros in our own library 40 predicate_property(Module:edcg_import_sentinel, imported_from(edcg)). 41 42 % dummy predicate exported to detect which modules want EDCG expansion 43 edcg_import_sentinel. 44 45 46 % term_expansion/4 is used to work around SWI-Prolog's attempts to 47 % match variable names when doing a listing (or interactive trace) and 48 % getting confused; this sometimes results in a strange error message 49 % for an unknown extended_pos(Pos,N). 50 51 % Returning a variable for _Layout2 means "I don't know". 52 % See https://swi-prolog.discourse.group/t/strange-warning-message-from-compile-or-listing/3774 53 user:term_expansion(Term, Layout0, Expansion, Layout) :- 54 wants_edcg_expansion, 55 edcg_expand_clause(Term, Expansion, Layout0, Layout). 56 57 % TODO: 58 % prolog_clause:unify_clause_hook(Read, Decompiled, Module, TermPos0, TermPos) :- 59 % wants_edcg_expansion(Module), 60 % edcg_expand_clause(Read, Decompiled, TermPos0, TermPos). 61 62 % TODO: 63 % prolog_clause:make_varnames_hook(ReadClause, DecompiledClause, Offsets, Names, Term) :- ... 64 65 % TODO: support ((H,PB-->>B) [same as regular DCG] 66 edcg_expand_clause((H-->>B), Expansion, TermPos0, _) :- 67 edcg_expand_clause_wrap((H-->>B), Expansion, TermPos0, _). 68 edcg_expand_clause((H,PB==>>B), Expansion, TermPos0, _) :- 69 edcg_expand_clause_wrap((H,PB==>>B), Expansion, TermPos0, _). 70 edcg_expand_clause((H==>>B), Expansion, TermPos0, _) :- 71 edcg_expand_clause_wrap((H==>>B), Expansion, TermPos0, _). 72 73 edcg_expand_clause_wrap(Term, Expansion, TermPos0, TermPos) :- 74 % ( valid_termpos(Term, TermPos0) % for debugging 75 % -> true 76 % ; throw(error(invalid_termpos_read(Term,TermPos0), _)) 77 % ), 78 ( '_expand_clause'(Term, Expansion, TermPos0, TermPos) 79 -> true 80 ; throw(error('FAILED_expand_clause'(Term, Expansion, TermPos0, TermPos), _)) 81 ), 82 % ( valid_termpos(Expansion, TermPos) % for debugging 83 % -> true 84 % ; throw(error(invalid_termpos_expansion(Expansion, TermPos), _)) 85 % ). 86 true. 87 88 % :- det('_expand_clause'/4). 89 % Perform EDCG macro expansion 90 % TODO: support ((H,PB-->>B) [same as regular DCG] 91 '_expand_clause'((H-->>B), Expansion, TermPos0, TermPos) => 92 TermPos0 = term_position(From,To,ArrowFrom,ArrowTo,[H_pos,B_pos]), 93 TermPos = term_position(From,To,ArrowFrom,ArrowTo,[Hx_pos,Bx_pos]), 94 Expansion = (TH:-TB), 95 '_expand_head_body'(H, B, TH, TB, NewAcc, H_pos,B_pos, Hx_pos,Bx_pos), 96 '_finish_acc'(NewAcc), 97 !. 98 '_expand_clause'((H,PB==>>B), Expansion, _TermPos0, _) => % TODO TermPos 99 % '==>>'(',',(H,PB),B) 100 Expansion = (TH,Guards=>TB2), 101 '_expand_guard'(PB, Guards), 102 '_expand_head_body'(H, B, TH, TB, NewAcc, _H_pos,_B_pos, _Hx_pos,_Bx_pos), 103 '_finish_acc_ssu'(NewAcc, TB, TB2), 104 !. 105 '_expand_clause'((H==>>B), Expansion, TermPos0, TermPos) => 106 TermPos0 = term_position(From,To,ArrowFrom,ArrowTo,[H_pos,B_pos]), 107 TermPos = term_position(From,To,ArrowFrom,ArrowTo,[Hx_pos,Bx_pos]), 108 Expansion = (TH=>TB2), 109 '_expand_head_body'(H, B, TH, TB, NewAcc, H_pos,B_pos, Hx_pos,Bx_pos), 110 '_finish_acc_ssu'(NewAcc, TB, TB2), 111 !. 112 113 :- det('_expand_guard'/2). 114 % TODO: Do we want to expand the guards? 115 % For now, just verify that they all start with '?' 116 '_expand_guard'((?G0,G2), Expansion) => 117 Expansion = (G, GE2), 118 '_expand_guard_curly'(G0, G), 119 '_expand_guard'(G2, GE2). 120 '_expand_guard'(?G0, G) => 121 '_expand_guard_curly'(G0, G). 122 '_expand_guard'(G, _) => 123 throw(error(type_error(guard,G),_)). 124 125 :- det('_expand_guard_curly'/2). 126 '_expand_guard_curly'({G}, G) :- !. 127 '_expand_guard_curly'(G, G). 128 129 130 :- det('_expand_head_body'/9). 131 '_expand_head_body'(H, B, TH, TB, NewAcc, _H_pos,_B_pos, _Hx_pos,_Bx_pos) :- 132 functor(H, Na, Ar), 133 '_has_hidden'(H, HList), % TODO: can backtrack - should it? 134 debug(edcg,'Expanding ~w',[H]), 135 '_new_goal'(H, HList, HArity, TH), 136 '_create_acc_pass'(HList, HArity, TH, Acc, Pass), 137 '_expand_goal'(B, TB, Na/Ar, HList, Acc, NewAcc, Pass), 138 !. 139 140 % Expand a goal: 141 '_expand_goal'((G1,G2), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 142 Expansion = (TG1,TG2), 143 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass), 144 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass). 145 '_expand_goal'((G1->G2;G3), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 146 Expansion = (TG1->TG2;TG3), 147 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass), 148 '_expand_goal'(G2, MG2, NaAr, HList, MidAcc, Acc1, Pass), 149 '_expand_goal'(G3, MG3, NaAr, HList, Acc, Acc2, Pass), 150 '_merge_acc'(Acc, Acc1, MG2, TG2, Acc2, MG3, TG3, NewAcc). 151 '_expand_goal'((G1*->G2;G3), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 152 Expansion = (TG1*->TG2;TG3), 153 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass), 154 '_expand_goal'(G2, MG2, NaAr, HList, MidAcc, Acc1, Pass), 155 '_expand_goal'(G3, MG3, NaAr, HList, Acc, Acc2, Pass), 156 '_merge_acc'(Acc, Acc1, MG2, TG2, Acc2, MG3, TG3, NewAcc). 157 '_expand_goal'((G1;G2), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 158 Expansion = (TG1;TG2), 159 '_expand_goal'(G1, MG1, NaAr, HList, Acc, Acc1, Pass), 160 '_expand_goal'(G2, MG2, NaAr, HList, Acc, Acc2, Pass), 161 '_merge_acc'(Acc, Acc1, MG1, TG1, Acc2, MG2, TG2, NewAcc). 162 '_expand_goal'((G1->G2), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 163 Expansion = (TG1->TG2), 164 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass), 165 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass). 166 '_expand_goal'((G1*->G2), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 167 Expansion = (TG1*->TG2), 168 '_expand_goal'(G1, TG1, NaAr, HList, Acc, MidAcc, Pass), 169 '_expand_goal'(G2, TG2, NaAr, HList, MidAcc, NewAcc, Pass). 170 '_expand_goal'((\+G), Expansion, NaAr, HList, Acc, NewAcc, Pass) => 171 Expansion = (\+TG), 172 NewAcc = Acc, 173 '_expand_goal'(G, TG, NaAr, HList, Acc, _TempAcc, Pass). 174 '_expand_goal'({G}, Expansion, _, _, Acc, NewAcc, _) => 175 Expansion = G, 176 NewAcc = Acc. 177 '_expand_goal'(insert(X,Y), Expansion, _, _, Acc, NewAcc, _) => 178 Expansion = (LeftA=X), 179 '_replace_acc'(dcg, LeftA, RightA, Y, RightA, Acc, NewAcc), !. 180 '_expand_goal'(insert(X,Y):A, Expansion, _, _, Acc, NewAcc, _) => 181 Expansion = (LeftA=X), 182 '_replace_acc'(A, LeftA, RightA, Y, RightA, Acc, NewAcc), 183 debug(edcg,'Expanding accumulator goal: ~w',[insert(X,Y):A]), 184 !. 185 % Force hidden arguments in L to be appended to G: 186 '_expand_goal'((G:A), TG, _, _HList, Acc, NewAcc, Pass), 187 \+'_list'(G), 188 '_has_hidden'(G, []) => 189 '_make_list'(A, AList), 190 '_new_goal'(G, AList, GArity, TG), 191 '_use_acc_pass'(AList, GArity, TG, Acc, NewAcc, Pass). 192 % Use G's regular hidden arguments & override defaults for those arguments 193 % not in the head: 194 '_expand_goal'((G:A), TG, _, _HList, Acc, NewAcc, Pass), 195 \+'_list'(G), 196 '_has_hidden'(G, GList), GList\==[] => 197 '_make_list'(A, L), 198 '_new_goal'(G, GList, GArity, TG), 199 '_replace_defaults'(GList, NGList, L), 200 '_use_acc_pass'(NGList, GArity, TG, Acc, NewAcc, Pass). 201 '_expand_goal'((L:A), Joiner, NaAr, _, Acc, NewAcc, _), 202 '_list'(L) => 203 '_joiner'(L, A, NaAr, Joiner, Acc, NewAcc). 204 '_expand_goal'(L, Joiner, NaAr, _, Acc, NewAcc, _), 205 '_list'(L) => 206 '_joiner'(L, dcg, NaAr, Joiner, Acc, NewAcc). 207 '_expand_goal'((X/A), Expansion, _, _, Acc, NewAcc, _), 208 atomic(A), 209 member(acc(A,X,_), Acc) => 210 Expansion = true, 211 NewAcc = Acc, 212 debug(edcg,'Expanding accumulator goal: ~w',[X/A]), 213 !. 214 '_expand_goal'((X/A), Expansion, _, _, Acc, NewAcc, Pass), 215 atomic(A), 216 member(pass(A,X), Pass) => 217 Expansion = true, 218 NewAcc = Acc, 219 debug(edcg,'Expanding passed argument goal: ~w',[X/A]), 220 !. 221 '_expand_goal'((A/X), Expansion, _, _, Acc, NewAcc, _), 222 atomic(A), 223 member(acc(A,_,X), Acc) => 224 Expansion = true, 225 NewAcc = Acc. 226 '_expand_goal'((X/A/Y), Expansion, _, _, Acc, NewAcc, _), 227 member(acc(A,X,Y), Acc), 228 var(X), var(Y), atomic(A) => 229 Expansion = true, 230 NewAcc = Acc. 231 '_expand_goal'((X/Y), true, NaAr, _, Acc, NewAcc, _) => 232 NewAcc = Acc, 233 print_message(warning,missing_hidden_parameter(NaAr,X/Y)). 234 % Defaulty cases: 235 '_expand_goal'(G, TG, _HList, _, Acc, NewAcc, Pass) => 236 '_has_hidden'(G, GList), !, 237 '_new_goal'(G, GList, GArity, TG), 238 '_use_acc_pass'(GList, GArity, TG, Acc, NewAcc, Pass). 239 240 % ==== The following was originally acc-pass.pl ==== 241 242 % Operations on the Acc and Pass data structures: 243 244 :- det('_create_acc_pass'/5). 245 % Create the Acc and Pass data structures: 246 % Acc contains terms of the form acc(A,LeftA,RightA) where A is the name of an 247 % accumulator, and RightA and LeftA are the accumulating parameters. 248 % Pass contains terms of the form pass(A,Arg) where A is the name of a passed 249 % argument, and Arg is the argument. 250 '_create_acc_pass'([], _, _, Acc, Pass) => 251 Acc = [], 252 Pass = []. 253 '_create_acc_pass'([A|AList], Index, TGoal, Acc2, Pass), 254 '_is_acc'(A) => 255 Acc2 = [acc(A,LeftA,RightA)|Acc], 256 Index1 is Index+1, 257 arg(Index1, TGoal, LeftA), 258 Index2 is Index+2, 259 arg(Index2, TGoal, RightA), 260 '_create_acc_pass'(AList, Index2, TGoal, Acc, Pass). 261 '_create_acc_pass'([A|AList], Index, TGoal, Acc, Pass2), 262 '_is_pass'(A) => 263 Pass2 = [pass(A,Arg)|Pass], 264 Index1 is Index+1, 265 arg(Index1, TGoal, Arg), 266 '_create_acc_pass'(AList, Index1, TGoal, Acc, Pass). 267 '_create_acc_pass'([A|_AList], _Index, _TGoal, _Acc, _Pass), 268 \+'_is_acc'(A), 269 \+'_is_pass'(A) => 270 print_message(error,not_a_hidden_param(A)). 271 272 273 :- det('_use_acc_pass'/6). 274 % Use the Acc and Pass data structures to create the arguments of a body goal: 275 % Add the hidden parameters named in GList to the goal. 276 '_use_acc_pass'([], _, _, Acc, NewAcc, _) => 277 NewAcc = Acc. 278 % 1a. The accumulator A is used in the head: 279 % Note: the '_replace_acc' guard instantiates MidAcc 280 '_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass), 281 '_replace_acc'(A, LeftA, RightA, MidA, RightA, Acc, MidAcc) => 282 Index1 is Index+1, 283 arg(Index1, TGoal, LeftA), 284 Index2 is Index+2, 285 arg(Index2, TGoal, MidA), 286 '_use_acc_pass'(GList, Index2, TGoal, MidAcc, NewAcc, Pass). 287 % 1b. The accumulator A is not used in the head: 288 '_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass), 289 '_acc_info'(A, LStart, RStart) => 290 Index1 is Index+1, 291 arg(Index1, TGoal, LStart), 292 Index2 is Index+2, 293 arg(Index2, TGoal, RStart), 294 '_use_acc_pass'(GList, Index2, TGoal, Acc, NewAcc, Pass). 295 % 2a. The passed argument A is used in the head: 296 '_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass), 297 '_is_pass'(A), 298 member(pass(A,Arg), Pass) => 299 Index1 is Index+1, 300 arg(Index1, TGoal, Arg), 301 '_use_acc_pass'(GList, Index1, TGoal, Acc, NewAcc, Pass). 302 % 2b. The passed argument A is not used in the head: 303 '_use_acc_pass'([A|GList], Index, TGoal, Acc, NewAcc, Pass), 304 '_pass_info'(A, AStart) => 305 Index1 is Index+1, 306 arg(Index1, TGoal, AStart), 307 '_use_acc_pass'(GList, Index1, TGoal, Acc, NewAcc, Pass). 308 % 3. Defaulty case when A does not exist: 309 '_use_acc_pass'([A|_GList], _Index, _TGoal, Acc, Acc, _Pass) => 310 print_message(error,not_a_hidden_param(A)). 311 312 :- det('_finish_acc'/1). 313 % Finish the Acc data structure: 314 % Link its Left and Right accumulation variables together in pairs: 315 % TODO: does this work correctly in the presence of cuts? ("!") - see README 316 '_finish_acc'([]). 317 '_finish_acc'([acc(_,Link,Link)|Acc]) :- '_finish_acc'(Acc). 318 319 :- det('_finish_acc_ssu'/3). 320 '_finish_acc_ssu'([], TB, TB). 321 '_finish_acc_ssu'([acc(_,Link0,Link1)|Acc], TB0, TB) :- 322 '_finish_acc_ssu'(Acc, (Link0=Link1,TB0), TB). 323 324 % Replace elements in the Acc data structure: 325 % Succeeds iff replacement is successful. 326 '_replace_acc'(A, L1, R1, L2, R2, Acc, NewAcc) :- 327 member(acc(A,L1,R1), Acc), !, 328 '_replace'(acc(A,_,_), acc(A,L2,R2), Acc, NewAcc). 329 330 :- det('_merge_acc'/8). 331 % Combine two accumulator lists ('or'ing their values) 332 '_merge_acc'([], [], G1, G1, [], G2, G2, []) :- !. 333 '_merge_acc'([acc(Acc,OL,R)|Accs], [acc(Acc,L1,R)|Accs1], G1, NG1, 334 [acc(Acc,L2,R)|Accs2], G2, NG2, [acc(Acc,NL,R)|NewAccs]) :- !, 335 ( ( OL == L1, OL \== L2 ) -> 336 MG1 = (G1,L1=L2), MG2 = G2, NL = L2 337 ; ( OL == L2, OL \== L1 ) -> 338 MG2 = (G2,L2=L1), MG1 = G1, NL = L1 339 ; MG1 = G1, MG2 = G2, L1 = L2, L2 = NL ), 340 '_merge_acc'(Accs, Accs1, MG1, NG1, Accs2, MG2, NG2, NewAccs). 341 342 % ==== The following was originally generic-util.pl ==== 343 344 % Generic utilities special-util.pl 345 346 :- det('_match'/4). 347 % Match arguments L, L+1, ..., H of the predicates P and Q: 348 '_match'(L, H, _, _) :- L>H, !. 349 '_match'(L, H, P, Q) :- L=<H, !, 350 arg(L, P, A), 351 arg(L, Q, A), 352 L1 is L+1, 353 '_match'(L1, H, P, Q). 354 355 356 '_list'(L) :- nonvar(L), L=[_|_], !. 357 '_list'(L) :- L==[], !. 358 359 :- det('_make_list'/2). 360 '_make_list'(A, [A]) :- \+'_list'(A), !. 361 '_make_list'(L, L) :- '_list'(L), !. 362 363 :- det('_replace'/4). 364 % replace(Elem, RepElem, List, RepList) 365 '_replace'(_, _, [], []) :- !. 366 '_replace'(A, B, [A|L], [B|R]) :- !, 367 '_replace'(A, B, L, R). 368 '_replace'(A, B, [C|L], [C|R]) :- 369 \+C=A, !, 370 '_replace'(A, B, L, R). 371 372 % ==== The following was originally special-util.pl ==== 373 374 % Specialized utilities: 375 376 % Given a goal Goal and a list of hidden parameters GList 377 % create a new goal TGoal with the correct number of arguments. 378 % Also return the arity of the original goal. 379 '_new_goal'(Goal, GList, GArity, TGoal) :- 380 functor(Goal, Name, GArity), 381 '_number_args'(GList, GArity, TArity), 382 functor(TGoal, Name, TArity), 383 '_match'(1, GArity, Goal, TGoal). 384 385 % Add the number of arguments needed for the hidden parameters: 386 '_number_args'([], N, N). 387 '_number_args'([A|List], N, M) :- 388 '_is_acc'(A), !, 389 N2 is N+2, 390 '_number_args'(List, N2, M). 391 '_number_args'([A|List], N, M) :- 392 '_is_pass'(A), !, 393 N1 is N+1, 394 '_number_args'(List, N1, M). 395 '_number_args'([_|List], N, M) :- !, 396 % error caught elsewhere 397 '_number_args'(List, N, M). 398 399 % Give a list of G's hidden parameters: 400 '_has_hidden'(G, GList) :- 401 functor(G, GName, GArity), 402 ( pred_info(GName, GArity, GList) 403 -> true 404 ; GList = [] 405 ). 406 407 % Succeeds if A is an accumulator: 408 '_is_acc'(A), atomic(A) => '_acc_info'(A, _, _, _, _, _, _). 409 '_is_acc'(A), functor(A, N, 2) => '_acc_info'(N, _, _, _, _, _, _). 410 411 % Succeeds if A is a passed argument: 412 '_is_pass'(A), atomic(A) => '_pass_info'(A, _). 413 '_is_pass'(A), functor(A, N, 1) => '_pass_info'(N, _). 414 415 % Get initial values for the accumulator: 416 '_acc_info'(AccParams, LStart, RStart) :- 417 functor(AccParams, Acc, 2), 418 '_is_acc'(Acc), !, 419 arg(1, AccParams, LStart), 420 arg(2, AccParams, RStart). 421 '_acc_info'(Acc, LStart, RStart) :- 422 '_acc_info'(Acc, _, _, _, _, LStart, RStart). 423 424 % Isolate the internal database from the user database: 425 '_acc_info'(Acc, Term, Left, Right, Joiner, LStart, RStart) :- 426 acc_info(Acc, Term, Left, Right, Joiner, LStart, RStart). 427 '_acc_info'(Acc, Term, Left, Right, Joiner, _, _) :- 428 acc_info(Acc, Term, Left, Right, Joiner). 429 '_acc_info'(dcg, Term, Left, Right, Left=[Term|Right], _, []). 430 431 % Get initial value for the passed argument: 432 % Also, isolate the internal database from the user database. 433 '_pass_info'(PassParam, PStart) :- 434 functor(PassParam, Pass, 1), 435 '_is_pass'(Pass), !, 436 arg(1, PassParam, PStart). 437 '_pass_info'(Pass, PStart) :- 438 pass_info(Pass, PStart). 439 '_pass_info'(Pass, _) :- 440 pass_info(Pass). 441 442 % Calculate the joiner for an accumulator A: 443 '_joiner'([], _, _, true, Acc, Acc). 444 '_joiner'([Term|List], A, NaAr, (Joiner,LJoiner), Acc, NewAcc) :- 445 '_replace_acc'(A, LeftA, RightA, MidA, RightA, Acc, MidAcc), 446 '_acc_info'(A, Term, LeftA, MidA, Joiner, _, _), !, 447 '_joiner'(List, A, NaAr, LJoiner, MidAcc, NewAcc). 448 % Defaulty case: 449 '_joiner'([_Term|List], A, NaAr, Joiner, Acc, NewAcc) :- 450 print_message(warning, missing_accumulator(NaAr,A)), 451 '_joiner'(List, A, NaAr, Joiner, Acc, NewAcc). 452 453 % Replace hidden parameters with ones containing initial values: 454 '_replace_defaults'([], [], _). 455 '_replace_defaults'([A|GList], [NA|NGList], AList) :- 456 '_replace_default'(A, NA, AList), 457 '_replace_defaults'(GList, NGList, AList). 458 459 '_replace_default'(A, NewA, AList) :- % New initial values for accumulator. 460 functor(NewA, A, 2), 461 member(NewA, AList), !. 462 '_replace_default'(A, NewA, AList) :- % New initial values for passed argument. 463 functor(NewA, A, 1), 464 member(NewA, AList), !. 465 '_replace_default'(A, NewA, _) :- % Use default initial values. 466 A=NewA. 467 468 % ==== The following was originally messages.pl ==== 469 470 :- multifile prolog:message//1. 471 472 prolog:message(missing_accumulator(Predicate,Accumulator)) --> 473 ['In ~w the accumulator ''~w'' does not exist'-[Predicate,Accumulator]]. 474 prolog:message(missing_hidden_parameter(Predicate,Term)) --> 475 ['In ~w the term ''~w'' uses a non-existent hidden parameter.'-[Predicate,Term]]. 476 prolog:message(not_a_hidden_param(Name)) --> 477 ['~w is not a hidden parameter'-[Name]]. 478 % === The following are for debugging term_expansion/4 479 480 % :- det(valid_termpos/2). % DO NOT SUBMIT 481 %! valid_termpos(+Term, ?TermPos) is semidet. 482 % Checks that a Term has an appropriate TermPos. 483 % This should always succeed: 484 % read_term(Term, [subterm_positions(TermPos)]), 485 % valid_termpos(Term, TermPos) 486 % Note that this can create a TermPos. Each clause ends with 487 % a cut, to avoid unneeded backtracking. 488 valid_termpos(Term, TermPos) :- 489 ( valid_termpos_(Term, TermPos) 490 -> true 491 ; fail % throw(error(invalid_termpos(Term,TermPos), _)) % DO NOT SUBMIT 492 ). 493 494 valid_termpos_(Var, _From-_To) :- var(Var). 495 valid_termpos_(Atom, _From-_To) :- atom(Atom), !. 496 valid_termpos_(Number, _From-_To) :- number(Number), !. 497 valid_termpos_(String, string_position(_From,_To)) :- string(String), !. 498 valid_termpos_([], _From-_To) :- !. 499 valid_termpos_({Arg}, brace_term_position(_From,_To,ArgPos)) :- 500 valid_termpos(Arg, ArgPos), !. 501 % TODO: combine the two list_position clauses 502 valid_termpos_([Hd|Tl], list_position(_From,_To, ElemsPos, none)) :- 503 maplist(valid_termpos, [Hd|Tl], ElemsPos), 504 list_tail([Hd|Tl], _, []), !. 505 valid_termpos_([Hd|Tl], list_position(_From,_To, ElemsPos, TailPos)) :- 506 list_tail([Hd|Tl], HdPart, Tail), 507 tailPos \= none, Tail \= [], 508 maplist(valid_termpos, HdPart, ElemsPos), 509 valid_termpos(Tail, TailPos), !. 510 valid_termpos_(Term, term_position(_From,_To, FFrom,FTo,SubPos)) :- 511 compound_name_arguments(Term, Name, Arguments), 512 valid_termpos(Name, FFrom-FTo), 513 maplist(valid_termpos, Arguments, SubPos), !. 514 valid_termpos_(Dict, dict_position(_From,_To,TagFrom,TagTo,KeyValuePosList)) :- 515 dict_pairs(Dict, Tag, Pairs), 516 valid_termpos(Tag, TagFrom-TagTo), 517 foldl(valid_termpos_dict, Pairs, KeyValuePosList, []), !. 518 % key_value_position(From, To, SepFrom, SepTo, Key, KeyPos, ValuePos) is handled 519 % in valid_termpos_dict. 520 valid_termpos_(Term, parentheses_term_position(_From,_To,ContentPos)) :- 521 valid_termpos(Term, ContentPos), !. 522 % TODO: documentation for quasi_quotation_position is wrong (SyntaxTo,SyntaxFrom should be SYntaxTerm,SyntaxPos). 523 valid_termpos_(_Term, quasi_quotation_position(_From,_To,SyntaxTerm,SyntaxPos,_ContentPos)) :- 524 valid_termpos(SyntaxTerm, SyntaxPos), !. 525 526 :- det(valid_termpos_dict/3). 527 valid_termpos_dict(Key-Value, KeyValuePosList0, KeyValuePosList1) :- 528 selectchk(key_value_position(_From,_To,_SepFrom,_SepTo,Key,KeyPos,ValuePos), 529 KeyValuePosList0, KeyValuePosList1), 530 valid_termpos(Key, KeyPos), 531 valid_termpos(Value, ValuePos). 532 533 :- det(list_tail/3). 534 list_tail([X|Xs], HdPart, Tail) => 535 HdPart = [X|HdPart2], 536 list_tail(Xs, HdPart2, Tail). 537 list_tail(Tail0, HdPart, Tail) => HdPart = [], Tail0 = Tail. 538 539 end_of_file.