1/************************************************************************* 2* * 3* YAP Prolog * 4* * 5* Yap Prolog was developed at NCCUP - Universidade do Porto * 6* * 7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * 8* * 9************************************************************************** 10* * 11* File: modules.pl * 12* Last rev: * 13* mods: * 14* comments: module support * 15* * 16*************************************************************************/ 17% module handling 18 19'$consulting_file_name'(Stream,F) :- 20 '$file_name'(Stream, F). 21 22 23'$module'(_,N,P) :- 24 '$module_dec'(N,P). 25 26'$module'(O,N,P,Opts) :- !, 27 '$module'(O,N,P), 28 '$process_module_decls_options'(Opts,module(Opts,N,P)). 29 30 31'$process_module_decls_options'(Var,Mod) :- 32 var(Var), !, 33 '$do_error'(instantiation_error,Mod). 34'$process_module_decls_options'([],_) :- !. 35'$process_module_decls_options'([H|L],M) :- !, 36 '$process_module_decls_option'(H,M), 37 '$process_module_decls_options'(L,M). 38'$process_module_decls_options'(T,M) :- 39 '$do_error'(type_error(list,T),M). 40 41'$process_module_decls_option'(Var,M) :- 42 var(Var), 43 '$do_error'(instantiation_error,M). 44'$process_module_decls_option'(At,_) :- 45 atom(At), !, 46 '$use_module'(At). 47'$process_module_decls_option'(library(L),_) :- !, 48 '$use_module'(library(L)). 49'$process_module_decls_option'(hidden(Bool),M) :- !, 50 '$process_hidden_module'(Bool, M). 51'$process_module_decls_option'(Opt,M) :- 52 '$do_error'(domain_error(module_decl_options,Opt),M). 53 54'$process_hidden_module'(TNew,M) :- 55 '$convert_true_off_mod3'(TNew, New, M), 56 source_mode(Old, New), 57 '$prepare_restore_hidden'(Old,New). 58 59'$convert_true_off_mod3'(true, off, _). 60'$convert_true_off_mod3'(false, on, _). 61'$convert_true_off_mod3'(X, _, M) :- 62 '$do_error'(domain_error(module_decl_options,hidden(X)),M). 63 64'$prepare_restore_hidden'(Old,Old) :- !. 65'$prepare_restore_hidden'(Old,New) :- 66 recorda('$system_initialisation', source_mode(New,Old), _). 67 68module(N) :- 69 var(N), 70 '$do_error'(instantiation_error,module(N)). 71module(N) :- 72 atom(N), !, 73 % set it as current module. 74 '$current_module'(_,N). 75module(N) :- 76 '$do_error'(type_error(atom,N),module(N)). 77 78'$module_dec'(N,P) :- 79 '$current_module'(_,N), 80 nb_getval('$consulting_file',F), 81 '$add_module_on_file'(N, F, P). 82 83'$add_module_on_file'(Mod, F, Exports) :- 84 recorded('$module','$module'(F0,Mod,_),R), !, 85 '$add_preexisting_module_on_file'(F, F0, Mod, Exports, R). 86'$add_module_on_file'(Mod, F, Exports) :- 87 '$process_exports'(Exports,Mod,ExportedPreds), 88 recorda('$module','$module'(F,Mod,ExportedPreds),_). 89 90'$process_exports'([],_,[]). 91'$process_exports'([Name/Arity|Exports],Mod,[Name/Arity|ExportedPreds]):- !, 92 '$process_exports'(Exports,Mod,ExportedPreds). 93'$process_exports'([Name//Arity|Exports],Mod,[Name/Arity2|ExportedPreds]):- !, 94 Arity2 is Arity+2, 95 '$process_exports'(Exports,Mod,ExportedPreds). 96'$process_exports'([op(Prio,Assoc,Name)|Exports],Mod,ExportedPreds) :- !, 97 op(Prio,Assoc,prolog:Name), 98 '$process_exports'(Exports,Mod,ExportedPreds). 99'$process_exports'([Trash|_],Mod,_) :- 100 '$do_error'(type_error(predicate_indicator,Trash),module(Mod,[Trash])). 101 102% redefining a previously-defined file, no problem. 103'$add_preexisting_module_on_file'(F, F, Mod, Exports, R) :- !, 104 erase(R), 105 ( recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R), fail; true), 106 recorda('$module','$module'(F,Mod,Exports),_). 107'$add_preexisting_module_on_file'(F,F0,Mod,Exports,R) :- 108 repeat, 109 format(user_error, "The module ~a is being redefined.~n Old file: ~a~n New file: ~a~nDo you really want to redefine it? (y or n)",[Mod,F0,F]), 110 '$mod_scan'(C), !, 111 ( C is "y" -> 112 '$add_preexisting_module_on_file'(F, F, Mod, Exports, R) 113 ; 114 '$do_error'(permission_error(module,redefined,Mod),module(Mod,Exports)) 115 ). 116 117'$mod_scan'(C) :- 118 get0(C), 119 '$skipeol'(C), 120 (C is "y" ; C is "n"). 121 122'$import'([],_,_) :- !. 123'$import'([N/K|L],M,T) :- 124 integer(K), atom(N), !, 125 '$do_import'(N, K, M, T), 126 '$import'(L,M,T). 127'$import'([PS|L],_,_) :- 128 '$do_error'(domain_error(predicate_spec,PS),import([PS|L])). 129 130% $use_preds(Imports,Publics,Mod,M) 131'$use_preds'(Imports,Publics,Mod,M) :- var(Imports), !, 132 '$import'(Publics,Mod,M). 133'$use_preds'(M:L,Publics,Mod,_) :- 134 '$use_preds'(L,Publics,Mod,M). 135'$use_preds'([],_,_,_) :- !. 136'$use_preds'([P|Ps],Publics,Mod,M) :- !, 137 '$use_preds'(P,Publics,Mod,M), 138 '$use_preds'(Ps,Publics,Mod,M). 139'$use_preds'(N/K,Publics,M,Mod) :- 140 ( lists:memberchk(N/K,Publics) -> true ; 141 print_message(warning,import(N/K,Mod,M,private)) 142 ), 143 '$do_import'(N, K, M, Mod). 144 145 146'$do_import'(N, K, M, T) :- 147 functor(G,N,K), 148 '$follow_import_chain'(M,G,M0,G0), 149 functor(G0,N1,K), 150 ( '$check_import'(M0,T,N1,K) -> 151 ( T = user -> 152 ( recordzifnot('$import','$import'(M0,user,G0,G,N,K),_) -> true ; true) 153 ; 154 ( recordaifnot('$import','$import'(M0,T,G0,G,N,K),_) -> true ; true ) 155 ) 156 ; 157 true 158 ). 159 160'$follow_import_chain'(M,G,M0,G0) :- 161 recorded('$import','$import'(M1,M,G1,G,_,_),_), !, 162 '$follow_import_chain'(M1,G1,M0,G0). 163'$follow_import_chain'(M,G,M,G). 164 165'$check_import'(M,T,N,K) :- 166 recorded('$import','$import'(MI,T,_,_,N,K),R), 167 \+ '$module_produced by'(M,T,N,K), !, 168 format(user_error,"NAME CLASH: ~w was already imported to module ~w;~n",[MI:N/K,T]), 169 format(user_error," Do you want to import it from ~w ? [y or n] ",M), 170 repeat, 171 get0(C), '$skipeol'(C), 172 ( C is "y" -> erase(R), !; 173 C is "n" -> !, fail; 174 format(user_error, ' Please answer with ''y'' or ''n'' ',[]), fail 175 ). 176'$check_import'(_,_,_,_). 177 178'$module_produced by'(M,M0,N,K) :- 179 recorded('$import','$import'(M,M0,_,_,N,K),_), !. 180'$module_produced by'(M,M0,N,K) :- 181 recorded('$import','$import'(MI,M0,G1,_,N,K),_), 182 functor(G1, N1, K1), 183 '$module_produced by'(M,MI,N1,K1). 184 185 186% expand module names in a clause 187% A1: Input Clause 188% A2: Output Class to Compiler (lives in module HM) 189% A3: Output Class to clause/2 and listing (lives in module HM) 190% 191% modules: 192% A4: module for body of clause (this is the one used in looking up predicates) 193% A5: context module (this is the current context 194% A6: head module (this is the one used in compiling and accessing). 195% 196% 197'$module_expansion'((H:-B),(H:-B1),(H:-BOO),M,HM) :- !, 198 '$is_mt'(M, H, B, IB, MM), 199 '$module_u_vars'(H,UVars,M), % collect head variables in 200 % expanded positions 201 '$module_expansion'(IB,B1,BO,M,MM,HM,UVars), 202 ('$full_clause_optimisation'(H, M, BO, BOO) -> 203 true 204 ; 205 BO = BOO 206 ). 207% do not expand bodyless clauses. 208'$module_expansion'(H,H,H,_,_). 209 210 211'$trace_module'(X) :- 212 telling(F), 213 tell('P0:debug'), 214 write(X),nl, 215 tell(F), fail. 216'$trace_module'(_). 217 218'$trace_module'(X,Y) :- X==Y, !. 219'$trace_module'(X,Y) :- 220 telling(F), 221 tell('~/.dbg.modules'), 222 write('***************'), nl, 223 portray_clause(X), 224 portray_clause(Y), 225 tell(F),fail. 226'$trace_module'(_,_). 227 228 229% expand module names in a body 230% args are: 231% goals to expand 232% code to pass to listing 233% code to pass to compiler 234% current module for looking up preds M 235% default module DM 236% head module HM 237% 238% to understand the differences, you can consider: 239% 240% a:(d:b(X) :- g:c(X), d(X), user:hello(X)). 241% 242% when we process meta-predicate c, HM=d, DM=a, BM=a, M=g and we should get: 243% 244% d:b(X) :- g:c(g:X), a:d(X), user:hello(X). 245% 246% on the other hand, 247% 248% a:(d:b(X) :- c(X), d(X), d:e(X)). 249% 250% will give 251% 252% d:b(X) :- a:c(a:X), a:d(X), e(X). 253% 254% 255% head variables. 256% goals or arguments/sub-arguments? 257% I cannot use call here because of format/3 258'$module_expansion'(V,NG,NG,_,MM,_,HVars) :- 259 var(V), !, 260 ( '$not_in_vars'(V,HVars) 261 -> 262 NG = call(MM:V) 263 ; 264 NG = call(V) 265 ). 266'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,HM,HVars) :- !, 267 '$module_expansion'(A,A1,AO,M,MM,HM,HVars), 268 '$module_expansion'(B,B1,BO,M,MM,HM,HVars). 269'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,HM,HVars) :- var(A), !, 270 '$module_expansion'(A,A1,AO,M,MM,HM,HVars), 271 '$module_expansion'(B,B1,BO,M,MM,HM,HVars). 272'$module_expansion'((A*->B;C),(A1*->B1;C1),(yap_hacks:current_choicepoint(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),M,MM,HM,HVars) :- !, 273 '$module_expansion'(A,A1,AOO,M,MM,HM,HVars), 274 '$clean_cuts'(AOO, AO), 275 '$module_expansion'(B,B1,BO,M,MM,HM,HVars), 276 '$module_expansion'(C,C1,CO,M,MM,HM,HVars). 277'$module_expansion'((A;B),(A1;B1),(AO;BO),M,MM,HM,HVars) :- !, 278 '$module_expansion'(A,A1,AO,M,MM,HM,HVars), 279 '$module_expansion'(B,B1,BO,M,MM,HM,HVars). 280'$module_expansion'((A|B),(A1|B1),(AO|BO),M,MM,HM,HVars) :- !, 281 '$module_expansion'(A,A1,AO,M,MM,HM,HVars), 282 '$module_expansion'(B,B1,BO,M,MM,HM,HVars). 283'$module_expansion'((A->B),(A1->B1),(AO->BO),M,MM,HM,HVars) :- !, 284 '$module_expansion'(A,A1,AOO,M,MM,HM,HVars), 285 '$clean_cuts'(AOO, AO), 286 '$module_expansion'(B,B1,BO,M,MM,HM,HVars). 287'$module_expansion'(\+A,\+A1,\+AO,M,MM,HM,HVars) :- !, 288 '$module_expansion'(A,A1,AO,M,MM,HM,HVars). 289'$module_expansion'(not(A),not(A1),not(AO),M,MM,HM,HVars) :- !, 290 '$module_expansion'(A,A1,AO,M,MM,HM,HVars). 291'$module_expansion'(true,true,true,_,_,_,_) :- !. 292'$module_expansion'(fail,fail,fail,_,_,_,_) :- !. 293'$module_expansion'(false,false,false,_,_,_,_) :- !. 294% if I don't know what the module is, I cannot do anything to the goal, 295% so I just put a call for later on. 296'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !. 297'$module_expansion'(M:G,G1,GO,_,CM,_,HVars) :- !, 298 '$module_expansion'(G,G1,GO,M,M,HM,HVars). 299'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :- 300 % is this imported from some other module M1? 301 '$imported_pred'(G, CurMod, GG, M1), 302 !, 303 '$module_expansion'(GG, G1, GO, M1, MM, HM,HVars). 304'$module_expansion'(G, G1, GO, CurMod, MM, HM,HVars) :- 305 '$meta_expansion'(G, CurMod, MM, HM, GI, HVars), !, 306 '$complete_goal_expansion'(GI, CurMod, MM, HM, G1, GO, HVars). 307'$module_expansion'(G, G1, GO, CurMod, MM, HM, HVars) :- 308 '$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars). 309 310expand_goal(G, G) :- 311 var(G), !. 312expand_goal(M:G, M:NG) :- 313 '$do_expand'(G, M, NG), !. 314expand_goal(G, NG) :- 315 '$current_module'(Mod), 316 '$do_expand'(G, M, NG), !. 317expand_goal(G, G). 318 319'$do_expand'(G, _, G) :- var(G), !. 320'$do_expand'(M:G, CurMod, M:GI) :- !, 321 '$do_expand'(G, M, GI). 322'$do_expand'(G, CurMod, GI) :- 323 ( 324 '$pred_exists'(goal_expansion(G,GI), CurMod), 325 call(CurMod:goal_expansion(G, GI)) 326 -> 327 true 328 ; 329 recorded('$dialect',swi,_), 330 system:goal_expansion(G, GI) 331 -> 332 true 333 ; 334 user:goal_expansion(G, CurMod, GI) 335 -> 336 true 337 ; 338 user:goal_expansion(G, GI) 339 ), !. 340'$do_expand'(G, CurMod, NG) :- 341 '$is_metapredicate'(G,CurMod), !, 342 functor(G, Name, Arity), 343 prolog:'$meta_predicate'(Name,CurMod,Arity,PredDef), 344 G =.. [Name|GArgs], 345 PredDef =.. [Name|GDefs], 346 '$expand_args'(GArgs, CurMod, GDefs, NGArgs), 347 NG =.. [Name|NGArgs]. 348 349'$expand_args'([], _, [], []). 350'$expand_args'(A.GArgs, CurMod, 0.GDefs, NA.NGArgs) :- 351 '$do_expand'(A, CurMod, NA), !, 352 '$expand_args'(GArgs, CurMod, GDefs, NGArgs). 353'$expand_args'(A.GArgs, CurMod, _.GDefs, A.NGArgs) :- 354 '$expand_args'(GArgs, CurMod, GDefs, NGArgs). 355 356% args are: 357% goal to expand 358% current module for looking up pred 359% current module for looking up pred 360% current module from top-level clause 361% goal to pass to listing 362% goal to pass to compiler 363% head variables. 364'$complete_goal_expansion'(G, CurMod, MM, HM, G1, GO, HVars) :- 365% '$pred_goal_expansion_on', 366 '$do_expand'(G, CurMod, GI), 367 GI \== G, !, 368 '$module_expansion'(GI, G1, GO, CurMod, MM, HM, HVars). 369'$complete_goal_expansion'(G, M, CM, HM, G1, G2, HVars) :- 370 '$all_system_predicate'(G,M,ORIG), !, 371 % make built-in processing transparent. 372 '$match_mod'(G, M, ORIG, HM, G1), 373 '$c_built_in'(G1, M, Gi), 374 (Gi \== G1 -> 375 '$module_expansion'(Gi, G2, _, M, CM, HM, HVars) 376 ; 377 G2 = G1 378 ). 379'$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :- 380 '$match_mod'(G, GMod, GMod, HM, NG). 381 382%'$match_mod'(G, GMod, GMod, NG) :- !, 383% NG = G. 384'$match_mod'(G, _, SM, _, G) :- SM == prolog, nonvar(G), \+ '$is_multifile'(G,SM), !. % prolog: needs no module info. 385% same module as head, and body goal (I cannot get rid of qualifier before 386% meta-call. 387'$match_mod'(G, HMod, _, HM, G) :- HMod == HM, !. 388'$match_mod'(G, GMod, _, _, GMod:G). 389 390 391% be careful here not to generate an undefined exception. 392'$imported_pred'(G, ImportingMod, G0, ExportingMod) :- 393 '$enter_undefp', 394 '$undefined'(G, ImportingMod), 395 '$get_undefined_pred'(G, ImportingMod, G0, ExportingMod), 396 ExportingMod \= ImportingMod, !, 397 '$exit_undefp'. 398'$imported_pred'(G, ImportingMod, _, _) :- 399 '$exit_undefp', 400 fail. 401 402'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- 403 recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_), 404 '$continue_imported'(ExportingMod, ExportingModI, G0, G0I), !. 405% SWI builtin 406'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- 407 recorded('$dialect',Dialect,_), 408 Dialect \= yap, 409 functor(G, Name, Arity), 410 call(Dialect:index(Name,Arity,ExportingModI,_)), !, 411 '$continue_imported'(ExportingMod, ExportingModI, G0, G), !. 412'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :- 413 autoloader:autoload, 414 autoloader:find_predicate(G,ExportingModI), !, 415 '$continue_imported'(ExportingMod, ExportingModI, G0, G), !. 416'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :- 417 prolog:'$parent_module'(ImportingMod,ExportingModI), 418 '$continue_imported'(ExportingMod, ExportingModI, G0, G). 419 420'$continue_imported'(Mod,Mod,Pred,Pred) :- 421 \+ '$undefined'(Pred, Mod), !. 422'$continue_imported'(FM,Mod,FPred,Pred) :- 423 recorded('$import','$import'(IM,Mod,IPred,Pred,_,_),_), !, 424 '$continue_imported'(FM, IM, FPred, IPred). 425'$continue_imported'(FM,Mod,FPred,Pred) :- 426 prolog:'$parent_module'(Mod,IM), 427 '$continue_imported'(FM, IM, FPred, Pred). 428 429 430% module_transparent declaration 431% 432 433:- dynamic('$module_transparent'/4). 434 435'$module_transparent'((P,Ps), M) :- !, 436 '$module_transparent'(P, M), 437 '$module_transparent'(Ps, M). 438'$module_transparent'(M:D, _) :- !, 439 '$module_transparent'(D, M). 440'$module_transparent'(F/N, M) :- 441 '$module_transparent'(F,M,N,_), !. 442'$module_transparent'(F/N, M) :- 443 functor(P,F,N), 444 asserta(prolog:'$module_transparent'(F,M,N,P)), 445 '$flags'(P, M, Fl, Fl), 446 NFlags is Fl \/ 0x200004, 447 '$flags'(P, M, Fl, NFlags). 448 449'$is_mt'(M, H0, B, (context_module(CM),B), CM) :- 450 '$module_transparent'(_, M, _, H), !. 451'$is_mt'(M, _, B, B, M). 452 453% meta_predicate declaration 454% records $meta_predicate(SourceModule,Functor,Arity,Declaration) 455 456% directive now meta_predicate Ps :- $meta_predicate(Ps). 457 458:- dynamic('$meta_predicate'/4). 459 460:- multifile '$meta_predicate'/4. 461 462'$meta_predicate'(P, M) :- 463 var(P), 464 '$do_error'(instantiation_error,module(M)). 465'$meta_predicate'((P,Ps), M) :- !, 466 '$meta_predicate'(P, M), 467 '$meta_predicate'(Ps, M). 468'$meta_predicate'(M:D, _) :- !, 469 '$meta_predicate'(D, M). 470'$meta_predicate'(P, M1) :- 471 '$install_meta_predicate'(P, M1). 472 473 474'$install_meta_predicate'(P, M1) :- 475 functor(P,F,N), 476 ( M1 = prolog -> M = _ ; M1 = M), 477 ( retractall(prolog:'$meta_predicate'(F,M,N,_)), fail ; true), 478 asserta(prolog:'$meta_predicate'(F,M,N,P)), 479 '$flags'(P, M1, Fl, Fl), 480 NFlags is Fl \/ 0x200000, 481 '$flags'(P, M1, Fl, NFlags). 482 483% return list of vars in expanded positions on the head of a clause. 484% 485% these variables should not be expanded by meta-calls in the body of the goal. 486% 487'$module_u_vars'(H,UVars,M) :- 488 functor(H,F,N), 489 '$meta_predicate'(F,M,N,D), !, 490 '$module_u_vars'(N,D,H,UVars). 491'$module_u_vars'(_,[],_). 492 493'$module_u_vars'(0,_,_,[]) :- !. 494'$module_u_vars'(I,D,H,[Y|L]) :- 495 arg(I,D,X), ( X=':' ; integer(X)), 496 arg(I,H,Y), var(Y), !, 497 I1 is I-1, 498 '$module_u_vars'(I1,D,H,L). 499'$module_u_vars'(I,D,H,L) :- 500 I1 is I-1, 501 '$module_u_vars'(I1,D,H,L). 502 503% expand arguments of a meta-predicate 504% $meta_expansion(ModuleWhereDefined,CurrentModule,Goal,ExpandedGoal,MetaVariables) 505 506'$meta_expansion'(G,Mod,MP,HM,G1,HVars) :- 507 functor(G,F,N), 508 '$meta_predicate'(F,Mod,N,D), !, 509% format(user_error,'[ ~w ',[G]), 510 functor(G1,F,N), 511 '$meta_expansion_loop'(N, D, G, G1, HVars, Mod, MP, HM). 512% format(user_error,' gives ~w]`n',[G1]). 513 514% expand argument 515'$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !. 516'$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :- 517 arg(I,D,X), (X==':' ; integer(X)), 518 arg(I,G,A), '$do_expand'(A,HVars), 519 !, 520 arg(I,NG,M:A), 521 I1 is I-1, 522 '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). 523'$meta_expansion_loop'(I, D, G, NG, HVars, CurMod, M, HM) :- 524 arg(I,G,A), 525 arg(I,NG,A), 526 I1 is I-1, 527 '$meta_expansion_loop'(I1, D, G, NG, HVars, CurMod, M, HM). 528 529% check if an argument should be expanded 530'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars). 531'$do_expand'(_:_,_) :- !, fail. 532'$do_expand'(_,_). 533 534'$not_in_vars'(_,[]). 535'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L). 536 537current_module(Mod) :- 538 '$all_current_modules'(Mod), 539 \+ '$system_module'(Mod). 540 541current_module(Mod,TFN) :- 542 '$all_current_modules'(Mod), 543 ( recorded('$module','$module'(TFN,Mod,_Publics),_) -> true ; TFN = user ). 544 545source_module(Mod) :- 546 '$current_module'(Mod). 547 548% comma has its own problems. 549:- '$install_meta_predicate'((0,0), prolog). 550 551:- meta_predicate 552 abolish(:), 553 abolish(:,+), 554 all(?,0,-), 555 assert(:), 556 assert(:,+), 557 assert_static(:), 558 asserta(:), 559 asserta(:,+), 560 asserta_static(:), 561 assertz(:), 562 assertz(:,+), 563 assertz_static(:), 564 bagof(?,0,-), 565 bb_get(:,-), 566 bb_put(:,+), 567 bb_delete(:,?), 568 bb_update(:,?,?), 569 call(0), 570 call(1,?), 571 call(2,?,?), 572 call(3,?,?,?), 573 call_with_args(0), 574 call_with_args(1,?), 575 call_with_args(2,?,?), 576 call_with_args(3,?,?,?), 577 call_with_args(4,?,?,?,?), 578 call_with_args(5,?,?,?,?,?), 579 call_with_args(6,?,?,?,?,?,?), 580 call_with_args(7,?,?,?,?,?,?,?), 581 call_with_args(8,?,?,?,?,?,?,?,?), 582 call_with_args(9,?,?,?,?,?,?,?,?,?), 583 call_cleanup(0,0), 584 call_cleanup(0,?,0), 585 call_residue(0,?), 586 call_residue_vars(0,?), 587 call_shared_object_function(:,+), 588 catch(0,?,0), 589 clause(:,?), 590 clause(:,?,?), 591 compile(:), 592 consult(:), 593 current_predicate(:), 594 current_predicate(?,:), 595 depth_bound_call(0,+), 596 discontiguous(:), 597 ensure_loaded(:), 598 findall(?,0,-), 599 findall(?,0,-,?), 600 forall(0,0), 601 format(+,:), 602 format(+,+,:), 603 freeze(?,0), 604 hide_predicate(:), 605 if(0,0,0), 606 ignore(0), 607 incore(0), 608 listing(:), 609 multifile(:), 610 nospy(:), 611 not(0), 612 once(0), 613 phrase(2,?), 614 phrase(2,?,+), 615 predicate_property(:,?), 616 predicate_statistics(:,-,-,-), 617 on_exception(+,0,0), 618 reconsult(:), 619 retract(:), 620 retract(:,?), 621 retractall(:), 622 reconsult(:), 623 setof(?,0,-), 624 setup_call_cleanup(0,0,0), 625 setup_call_catcher_cleanup(0,0,?,0), 626 spy(:), 627 unknown(+,:), 628 use_module(:), 629 use_module(:,?), 630 use_module(?,:,?), 631 when(+,0), 632 with_mutex(+,0), 633 with_output_to(?,0), 634 (0 -> 0), 635 (0 *-> 0), 636 (0 ; 0), 637 ^(+,0), 638 \+ 0 . 639 640% 641% get rid of a module and of all predicates included in the module. 642% 643abolish_module(Mod) :- 644 recorded('$module','$module'(_,Mod,_),R), erase(R), 645 fail. 646abolish_module(Mod) :- 647 recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R), 648 fail. 649abolish_module(Mod) :- 650 '$current_predicate'(Mod,Na,Ar), 651 abolish(Mod:Na/Ar), 652 fail. 653abolish_module(_). 654 655'$reexport'(ModuleSource, Spec, Module) :- 656 nb_getval('$consulting_file',TopFile), 657 ( 658 Spec == all 659 -> 660 Goal = reexport(ModuleSource) 661 ; 662 Goal = reexport(ModuleSource,Spec) 663 ), 664 absolute_file_name(ModuleSource, File, [access(read),file_type(source),file_errors(fail),solutions(first)]), 665 '$load_files'(File, [if(not_loaded),imports([])], Goal), 666 recorded('$module', '$module'(FullFile, Mod, Exports),_), 667 atom_concat(File, _, FullFile), !, 668 '$convert_for_reexport'(Spec, Exports, Tab, MyExports, Goal), 669 '$add_to_imports'(Tab, Module, Mod), 670 recorded('$lf_loaded','$lf_loaded'(TopFile,TopModule,_,_),_), 671 recorded('$module', '$module'(CurrentFile, Module, ModExports), Ref), 672 erase(Ref), 673 lists:append(ModExports, MyExports, AllExports), 674 recorda('$module', '$module'(CurrentFile, Module, AllExports), _), 675 '$import'(MyExports, Module, TopModule). 676 677'$convert_for_reexport'(all, Exports, Tab, MyExports, _) :- 678 '$simple_conversion'(Exports, Tab, MyExports). 679'$convert_for_reexport'([P1|Ps], Exports, Tab, MyExports, Goal) :- 680 '$clean_conversion'([P1|Ps], Exports, Tab, MyExports, Goal). 681'$convert_for_reexport'(except(List), Exports, Tab, MyExports, Goal) :- 682 '$neg_conversion'(Exports, List, Tab, MyExports, Goal). 683 684'$simple_conversion'([], [], []). 685'$simple_conversion'([P|Exports], [P-P|Tab], [P|MyExports]) :- 686 '$simple_conversion'(Exports, Tab, MyExports). 687 688'$clean_conversion'([], _, [], [], _). 689'$clean_conversion'([P1|Ps], List, [P1-P1|Tab], [P1|MyExports], Goal) :- 690 lists:memberchk(P1, List), !, 691 '$clean_conversion'(Ps, List, Tab, MyExports, Goal). 692'$clean_conversion'([(N1/A1 as N2)|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- 693 lists:memberchk(N1/A1, List), !, 694 '$clean_conversion'(Ps, List, Tab, MyExports, Goal). 695'$clean_conversion'([P|_], _List, _, _, Goal) :- 696 '$do_error'(domain_error(module_reexport_predicates,P), Goal). 697 698'$neg_conversion'([], _, [], [], _). 699'$neg_conversion'([P1|Ps], List, Tab, MyExports, Goal) :- 700 lists:memberchk(P1, List), !, 701 '$neg_conversion'(Ps, List, Tab, MyExports, Goal). 702'$neg_conversion'([N1/A1|Ps], List, [N1/A1-N2/A1|Tab], [N2/A1|MyExports], Goal) :- 703 lists:memberchk(N1/A1 as N2, List), !, 704 '$neg_conversion'(Ps, List, Tab, MyExports, Goal). 705'$neg_conversion'([P|Ps], List, [P-P|Tab], [P|MyExports], Goal) :- 706 '$neg_conversion'(Ps, List, Tab, MyExports, Goal). 707 708'$add_to_imports'([], _, _). 709'$add_to_imports'([N0/K0-N1/K1|Tab], Mod, ModR) :- 710 functor(G,N0,K0), 711 G=..[N0|Args], 712 G1=..[N1|Args], 713 recordaifnot('$import','$import'(ModR,Mod,G,G1,N0,K0),_), !, 714 '$add_to_imports'(Tab, Mod, ModR). 715 716% I assume the clause has been processed, so the 717% var case is long gone! Yes :) 718'$clean_cuts'(G,(yap_hacks:current_choicepoint(DCP),NG)) :- 719 '$conj_has_cuts'(G,DCP,NG,OK), OK == ok, !. 720'$clean_cuts'(G,G). 721 722'$conj_has_cuts'(V,_,V, _) :- var(V), !. 723'$conj_has_cuts'(!,DCP,'$$cut_by'(DCP), ok) :- !. 724'$conj_has_cuts'((G1,G2),DCP,(NG1,NG2), OK) :- !, 725 '$conj_has_cuts'(G1, DCP, NG1, OK), 726 '$conj_has_cuts'(G2, DCP, NG2, OK). 727'$conj_has_cuts'((G1;G2),DCP,(NG1;NG2), OK) :- !, 728 '$conj_has_cuts'(G1, DCP, NG1, OK), 729 '$conj_has_cuts'(G2, DCP, NG2, OK). 730'$conj_has_cuts'((G1->G2),DCP,(G1;NG2), OK) :- !, 731 % G1: the system must have done it already 732 '$conj_has_cuts'(G2, DCP, NG2, OK). 733'$conj_has_cuts'((G1*->G2),DCP,(G1;NG2), OK) :- !, 734 % G1: the system must have done it already 735 '$conj_has_cuts'(G2, DCP, NG2, OK). 736'$conj_has_cuts'(if(G1,G2,G3),DCP,if(G1,NG2,NG3), OK) :- !, 737 % G1: the system must have done it already 738 '$conj_has_cuts'(G2, DCP, NG2, OK), 739 '$conj_has_cuts'(G3, DCP, NG3, OK). 740'$conj_has_cuts'(G,_,G, _). 741 742set_base_module(ExportingModule) :- 743 var(ExportingModule), 744 '$do_error'(instantiation_error,set_base_module(ExportingModule)). 745set_base_module(ExportingModule) :- 746 atom(ExportingModule), !, 747 '$current_module'(Mod), 748 retractall(prolog:'$parent_module'(Mod,_)), 749 asserta(prolog:'$parent_module'(Mod,ExportingModule)). 750set_base_module(ExportingModule) :- 751 '$do_error'(type_error(atom,ExportingModule),set_base_module(ExportingModule)). 752 753import_module(Mod, ImportModule) :- 754 var(Mod), 755 '$do_error'(instantiation_error,import_module(Mod, ImportModule)). 756import_module(Mod, ImportModule) :- 757 atom(Mod), !, 758 prolog:'$parent_module'(Mod,ImportModule). 759import_module(Mod, EM) :- 760 '$do_error'(type_error(atom,Mod),import_module(Mod, EM)). 761 762add_import_module(Mod, ImportModule, Pos) :- 763 var(Mod), 764 '$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)). 765add_import_module(Mod, ImportModule, Pos) :- 766 var(Pos), 767 '$do_error'(instantiation_error,add_import_module(Mod, ImportModule, Pos)). 768add_import_module(Mod, ImportModule, start) :- 769 atom(Mod), !, 770 retractall(prolog:'$parent_module'(Mod,ImportModule)), 771 asserta(prolog:'$parent_module'(Mod,ImportModule)). 772add_import_module(Mod, ImportModule, end) :- 773 atom(Mod), !, 774 retractall(prolog:'$parent_module'(Mod,ImportModule)), 775 assertz(prolog:'$parent_module'(Mod,ImportModule)). 776add_import_module(Mod, ImportModule, Pos) :- 777 \+ atom(Mod), !, 778 '$do_error'(type_error(atom,Mod),add_import_module(Mod, ImportModule, Pos)). 779add_import_module(Mod, ImportModule, Pos) :- 780 '$do_error'(domain_error(start_end,Pos),add_import_module(Mod, ImportModule, Pos)). 781 782delete_import_module(Mod, ImportModule) :- 783 var(Mod), 784 '$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)). 785delete_import_module(Mod, ImportModule) :- 786 var(ImportModule), 787 '$do_error'(instantiation_error,delete_import_module(Mod, ImportModule)). 788delete_import_module(Mod, ImportModule) :- 789 atom(Mod), 790 atom(ImportModule), !, 791 retractall(prolog:'$parent_module'(Mod,ImportModule)). 792delete_import_module(Mod, ImportModule) :- 793 \+ atom(Mod), !, 794 '$do_error'(type_error(atom,Mod),delete_import_module(Mod, ImportModule)). 795delete_import_module(Mod, ImportModule) :- 796 '$do_error'(type_error(atom,ImportModule),delete_import_module(Mod, ImportModule)). 797