1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module(general, [
   15	mgh/2,
   16	built_in/1,
   17	repeat_n_times/2,
   18	repeat_n_times_loop/2,
   19	all/1,
   20	prolog_iteration_via_backtracking/1,
   21	has_property/3,
   22	iso_predicate/4
   23]).   24
   25:- use_module(library(apply)).   26:- use_module(library(charsio)).   27
   28/*
   29 * mgh(+Literal, ?MostGeneralLiteral)
   30 *
   31 * Arg2 is the most general form of the literal in Arg1
   32 */
   33mgh(Mod:Term, Mod:Term_mgh):-
   34    !,
   35    functor(Term, Functor, Arity),
   36    functor(Term_mgh, Functor, Arity).
   37
   38mgh(Term, Term_mgh):-
   39    functor(Term, Functor, Arity),
   40    functor(Term_mgh, Functor, Arity).
   41
   42
   43/*
   44 * built_in(?Head)
   45 *
   46 * Check whether the specified term is the head of a built-in
   47 * predicate or enumerate all built-in predicates (if called 
   48 * with a free argument).
   49 */     
   50built_in(Head) :-
   51    predicate_property(Head, built_in).    
   52    
   53    
   54/*
   55 * repeat_n_times(+Goal,+N)
   56 */
   57repeat_n_times(Goal,N) :-             % initialize loop counter
   58  nb_setval(repeat_counter,0),            
   59  repeat_n_times_loop(Goal,N).
   60  
   61repeat_n_times_loop(_,N) :-        % stop if counter = N
   62  nb_getval(repeat_counter,V),
   63  V == N,
   64  !.
   65repeat_n_times_loop(Goal,N) :-        % loop
   66  once(Goal),                           % execute Goal once
   67  nb_getval(repeat_counter, I),
   68  I2 is I + 1,
   69  nb_setval(repeat_counter,I2),           % increment counter
   70  repeat_n_times_loop(Goal,N).          % repeat
   71
   72   
   73:- module_transparent prolog_iteration_via_backtracking/1, all/1.   74
   75all(G) :- prolog_iteration_via_backtracking(G) .
   76
   77prolog_iteration_via_backtracking(G) :- (call(G), fail) ; true .
   78
   79
   80/*
   81 * has_property(+Pred, ?Prop, ?HasProp) is det
   82 * 
   83 * Arg3 is 1 if the predicate referenced by Arg1 has the predicate of Arg2.
   84 * Else Arg3 is 0. 
   85 */
   86has_property(Pred,Prop,1) :- 
   87	predicate_property(Pred,Prop),
   88	!.
   89has_property(_Pred,_Prop,0).
   90
   91
   92%:- use_module(library(apply)).
   93%    
   94%get_var_names(Goal, _) :-
   95%    not(atomic(Goal)),
   96%    !,
   97%    throw('first argument has to be atomic').
   98%    
   99%get_var_names(Goal, VarNames) :-
  100%    format(atom(Query), '~w.', [Goal]),
  101%    open_chars_stream(Query,Stream),
  102%    read_term(Stream,_,[variable_names(VarNameList)]),
  103%    maplist(extract_var_name, VarNameList, ExtractedList),
  104%    list_2_comma_separated_list(ExtractedList,VarNames).
  105%    
  106%extract_var_name(=(VarName, _), VarName) :- !.
  107%extract_var_name(VarName, VarName) :- !.
  108    
  109iso_predicate(Name, Arity, Head, MetaHead) :-
  110	iso_predicate_(Name, Arity, Head, MetaHead).
  111
  112:- dynamic(iso_predicate_/4). % (Name, Arity, Head, MetaHead)
  113
  114collect_iso_predicates :-
  115	retractall(iso_predicate_(_, _, _, _)),
  116	current_predicate(Name/Arity),
  117	Name \== (:),
  118	functor(Head, Name, Arity),
  119	predicate_property(Head, iso),
  120	(	predicate_property(Head, meta_predicate(MetaHead))
  121	->	true
  122	;	MetaHead = []
  123	),
  124	(	iso_predicate_(Name, Arity, _, _)
  125	->	true
  126	;	assertz(iso_predicate_(Name, Arity, Head, MetaHead))
  127	),
  128	fail.
  129collect_iso_predicates.
  130
  131:- initialization(collect_iso_predicates).