1% MODULE flatten EXPORTS 2:- module( flatten, 3 [ flatten_term/7, 4 flatten_term/2, 5 flatten_literal/6, 6 flatten_literal/2, 7 flatten_clause/6, 8 unflatten_clause/2, 9 flatten_clause/2, 10 unflatten_clause/3 ]). 11 12% IMPORTS 13:- use_module(home(div_utils), 14 [clist_to_prolog/2, 15 list_to_struct/2]). 16:- use_module_if_exists(library(basics), 17 [member/2]). 18:- use_module_if_exists(library(strings), 19 [concat_atom/3, 20 midstring/6, 21 substring/5]). 22:- use_module_if_exists(library(occurs), 23 [sub_term/2, 24 contains_var/2]). 25 26% METAPREDICATES 27% none 28 29 30%*********************************************************************** 31%* 32%* module: flatten.pl 33%* 34%* author: B.Jung, M.Mueller, I.Stahl, B.Tausend date:12/92 35%* 36%* changed: 37%* 38%* description: Rouveirol's representation change to function free 39%* Horn clauses. 40%* Shared variables are deteced. 41%* Following the later versions of flattening('90,'91) 42%* identical terms are only represented once thru a 43%* new body literal. The older version (1989) introduced 44%* for each occurence of a term a unique new body literal. 45%* ( the newer approach might not always be more adequate) 46%* 47%* peculiarities: In the process of flattening all literals that are 48%* introduced for functions end with the suffix "_p". 49%* In return, when unflattening a clause it is assumed 50%* that every predicate symbol ending in "_p" stems from 51%* a function. This assumption is made because the names 52%* for functions and predicates need to be distinct. 53%* 54%* DON'T FLATTEN ANY CLAUSE CONTAINING LITERALS ENDING IN "_p" !!! 55%* 56%* see also: 57%* 58%*********************************************************************** 59 60 61%*********************************************************************** 62%* 63%* predicate: flatten_term/7 64%* 65%* syntax: flatten_term(+Term, +NewVar , +OldSubstituion, 66%* -NewSubstitution,+OldBackground, 67%* -NewBackground, -Literals) 68%* 69%* args: Term: term to be replace by NewVar, e.g. [a,b] 70%* NewVar: new variable 71%* OldSubstitution: list of substitutions that have already 72%* been performed while flattening a clause. 73%* This way shared variables / terms are detected. 74%* e.g. [], [ X/a , Y/[b] ] 75%* NewSubstitution: = OldSubstitution + [ NewVar/Term ] 76%* OldBackground: old list of predicate definitions 77%* NewBackground: new ... 78%* motivation: e.g. let term be "red". 79%* the resulting literal is " red(X) " which is 80%* true iff X=red. Therefore 81%* NewBackground = OldBackground + [ red(red) ] 82%* Literals: list of literals to replace function 83%* 84%* description: 85%* 86%* example: 87%* 88%* peculiarities: can't flatten integers 89%* 90%* see also: 91%* 92%*********************************************************************** 93 94flatten_term(Lin,Lout):- 95 flatten_term(Lin,_,[],_,[],_,Lout). 96 97% flatten_term(+,-,+,-,+,-,-) 98 99% known terms % change: represent only vars once 100flatten_term(Term,Var,S,S,Bg,Bg,[]):- 101 % var(Term), % new !!! 102 member( (Var/Term1),S ), 103 Term == Term1,!. 104 105% Variables 106%flatten_term( X, V, S,[(V/X)|S],[]):- var(X),!. 107flatten_term( X, X, S, S,Bg,Bg,[]):- var(X),!. 108 109% empty list 110flatten_term([],V,S, [(V/[])|S] , Bg, [ nil_p([]) | Bg], [ nil_p(V) ]):-!. 111 112% other atoms 113flatten_term( A, V, S,[V/A|S],Bg,[ B|Bg],[L]):- 114 atom(A),!, 115 concat_atom([A,p],'_',Functor), 116 L =.. [Functor,V], 117 B =.. [Functor,A]. 118 119% integers 120flatten_term( Int,V,S,[V/Int|S],Bg,[B|Bg],[L]):- 121 integer(Int),!, 122 map_function_to_pred(Int,PredName), 123 L =.. [PredName,V], 124 B =.. [PredName,Int]. 125 126 127% list 128flatten_term([A|B],V,S,Snew,Bg, [ cons_p(A,B,[A|B]) | Bg2],Literals):- 129 !, 130 flatten_term(A,V1,S,S1,Bg,Bg1,Literals1), 131 flatten_term(B,V2,S1,Snew1,Bg1,Bg2,Literals2), 132 Snew = [ (V/[A|B]) | Snew1], 133 append(Literals1,Literals2,Literals3), 134 Literals = [ cons_p(V1,V2,V) | Literals3 ]. 135 136 137% other functions 138flatten_term( Function, V, S,Snew,Bg, [ BgPredicate|Bg1 ],Literals):- 139 Function =.. [ Functor|Args ], 140 flatten_args(Args,Vs,S,Snew1,Bg,Bg1,Literals1), 141 Snew = [ V/Function | Snew1], 142 append(Vs,[V],NewArgs), 143 concat_atom([Functor,p],'_',NewFunctor), 144 Predicate =.. [ NewFunctor|NewArgs], % build new predicate of arity n+1 145 append( Args,[Function],BgArgs), 146 BgPredicate =.. [NewFunctor|BgArgs], 147 Literals = [Predicate|Literals1]. 148 149 150flatten_args([],[],S,S,Bg,Bg,[]). 151flatten_args([A|Args],[V|Vars],S,Snew,Bg,Bg1,Literals):- 152 flatten_term(A,V,S,Snew1,Bg,Bg2,L1), 153 flatten_args(Args,Vars,Snew1,Snew,Bg2,Bg1,L2), 154 append(L1,L2,Literals). 155 156 157%*********************************************************************** 158%* 159%* predicate: flatten_literal/2 160%* 161%* syntax: flatten_literal(+Lit,-Lit_list) 162%* 163%* args: Lit .. Literal, Lit_list .. list of literals 164%* 165%* description: returns the list of literals Lit has to be replaced with 166%* 167%* example: 168%* 169%* peculiarities: none 170%* 171%* see also: 172%* 173%*********************************************************************** 174 175flatten_literal(In,Out):- 176 flatten_literal( In,[],_,[],_,Out). 177 178 179% flatten_literal(+,+,-,+,-,-) 180 181flatten_literal(true,S,S,Bg,Bg,[]):- !. 182 183flatten_literal( Predicate,S,Snew,Bg,Bg1,Literals):- 184 Predicate =.. [ Functor|Args ], 185 flatten_args( Args,Vars,S,Snew,Bg,Bg1,Literals1), 186 NewPredicate =.. [Functor|Vars], 187 Literals = [NewPredicate|Literals1]. 188 189 190%*********************************************************************** 191%* 192%* predicate: flatten_literals/2 193%* 194%* syntax: flatten_literals(+Body,+OldSubst,-NewSubst, 195%* +OldBackground,-NewBackground,-Literals) 196%* 197%* args: Body.. clause body 198%* OldSubst: list of substitutions that have already 199%* been performed. 200%* NewSubst: = OldSubst + additional substitutions for Body 201%* OldBackground: old list of predicate definitions 202%* NewBackground: new ... 203%* Literals: list of literals to replace Body 204%* 205%* description: flattens clause body 206%* 207%* example: 208%* 209%* peculiarities: none 210%* 211%* see also: 212%* 213%*********************************************************************** 214 215flatten_literals( (A,B),S,Snew,Bg,Bg1,Literals):- 216 !, % cut, to prevent 2nd clause 217 flatten_literal( A,S,Snew1,Bg,Bg2,Literals1), 218 flatten_literals( B,Snew1,Snew,Bg2,Bg1,Literals2), 219 append(Literals1,Literals2,Literals). 220 221flatten_literals(A,S,Snew,Bg,Bg1,Literals):- 222 flatten_literal(A,S,Snew,Bg,Bg1,Literals). 223 224 225%*********************************************************************** 226%* 227%* predicate: flatten_clause/2 228%* 229%* syntax: flatten_clause(+ClauseIn,-ClauseOut) 230%* 231%* args: clauses in prolog notation, i.e. ( head :- body ) 232%* or list notation, i.e. [ head:p , b1:n, b2:n, ... ] 233%* 234%* description: flatten a clause 235%* 236%* example: 237%* 238%* peculiarities: none 239%* 240%* see also: 241%* 242%*********************************************************************** 243 244flatten_clause(In,Out):- 245 In = [ _:p | _ ],!, % list notation 246 clist_to_prolog(In, F), 247 flatten_clause(F,G), 248 clist_to_prolog(Out,G),!. 249 250flatten_clause(In,Out):- 251 flatten_clause(In,[],_,[],_,Out),!. 252 253flatten_clause( Clause,S,Snew,Bg,Bg1,ClauseOut):- 254 Clause =.. [':-',Head,Body], 255 256 % flatten head 257 Head =.. [Functor|Args], 258 flatten_args(Args,Vars,S,Snew1,Bg,Bg2,Literals1), 259 NewHead =.. [Functor|Vars], 260 261 % flatten body 262 flatten_literals(Body,Snew1,Snew,Bg2,Bg1,Literals2), 263 264 append(Literals1,Literals2,Literals), 265 list_to_struct(Literals,StrucLits), 266 ClauseOut =.. [':-',NewHead,StrucLits]. 267 268 269%************************************************************************ 270%* 271%* predicates: substitute_in_literals/4 272%* substitute_in_literal/4 273%* substitute_args/4 274%* syntax: substitute_in_literals(+Var,+Term,+OldLiterals,-NewLiterals) 275%* substitute_in_literal(+Var,+Term,+OldLiteral,-NewLiteral) 276%* substitute_args(+Var,+Term,+OldArgs,-NewArgs) 277%* 278%* args: 279%* 280%* description: replaces all occurences of Var in OldLiterals with Term 281%* and outputs NewLiterals. 282%* Note that also occurences of Var in subterms of args are 283%* detected. 284%* 285%* example: 286%* 287%* peculiarities: 288%* 289%* 290%* see also: 291%* 292%*********************************************************************** 293 294% substitute all occurences of Var in LiteralIn by Term 295substitute_in_literals(_Var,_Term, [],[]). 296substitute_in_literals(Var,Term, [Lit1|Lits],[Lit1new|Litsnew]):- 297 !, 298 substitute_in_literal(Var,Term,Lit1,Lit1new), 299 substitute_in_literals(Var,Term,Lits,Litsnew). 300 301substitute_in_literal(Var,Term,LiteralIn,LiteralOut):- 302 LiteralIn =.. [Functor|Vars], 303 substitute_args(Var,Term,Vars,Args), 304 LiteralOut =.. [Functor|Args]. 305 306% substitute variables Vars in argument positions by Term if identical to Var 307substitute_args( Var, Term, [ V|Vs ], [ Term|Args]):- 308 Var == V,!, 309 substitute_args( Var, Term, Vs, Args). 310 311substitute_args( Var, Term, [ V|Vs ], [ Arg|Args]):- 312 contains_var(Var,V), % Var is subterm of V 313 !, 314 V =.. [ Functor | SubVars ], 315 substitute_args(Var,Term,SubVars,SubArgs), 316 Arg =.. [ Functor | SubArgs ], 317 substitute_args( Var, Term, Vs, Args). 318 319substitute_args( Var, Term, [ V|Vs ], [ V |Args ]):- 320 substitute_args( Var, Term, Vs, Args). 321 322substitute_args(_Var, _Term, [],[]). 323 324 325%******************************************************************************* 326%* 327%* predicate: unflatten_clause/2 328%* 329%* syntax: unflatten_clause(+FlatClause,-UnFlatClause) 330%* 331%* args: FlatClause : flattened clause (either in list or prolog notation) 332%* UnFlatClause : unflattened clause 333%* 334%* description: Algorithm for unflattening: (Rouveirol,91.p131) 335%* for each flattened predicate f_p(t1,..,tn,X) in the body of clause C 336%* substitute all occurences of X by the functional term f(t1,..tn) 337%* & drop f_p(t1,...,tn,X) 338%* 339%* example: 340%* 341%* peculiarities: 342%* 343%* 344%* see also: 345%* 346%******************************************************************************* 347 348unflatten_clause((Head:-Body) ,(Head1:-Body1)):- 349 list_to_struct(BodyListIn,Body), 350 unflatten_clause1( Head,[],BodyListIn, 351 Head1, BodyListOut,[], []), 352 list_to_struct(BodyListOut,Body1), 353 !. 354 355 356unflatten_clause(In,Out):- 357 In = [ _:p | _ ],!, % list notation 358 clist_to_prolog(In, F), 359 unflatten_clause(F,G), 360 clist_to_prolog(Out,G),!. 361 362 363%******************************************************************************* 364%* 365%* predicate: unflatten_clause/3 366%* 367%* syntax: unflatten_clause(+FlatClause,?Bg,-UnFlatClause) 368%* 369%* args: FlatClause = ( Head:-Body) : flattened clause 370%* Bg : optional background facts - not used yet 371%* UnFlatClause : unflattened clause 372%* 373%* description: Algorithm for unflattening: (Rouveirol,91.p131) 374%* for each flattened predicate f_p(t1,..,tn,X) in the body of clause C 375%* substitute all occurences of X by the functional term f(t1,..tn) 376%* & drop f_p(t1,...,tn,X) 377%* 378%* example: 379%* 380%* peculiarities: 381%* 382%* 383%* see also: 384%* 385%******************************************************************************* 386 387unflatten_clause((Head:-Body) , Bg, (Head1:-Body1)):- 388 list_to_struct(BodyListIn,Body), 389 unflatten_clause1( Head,[],BodyListIn, 390 Head1, BodyListOut,[], Bg), 391 list_to_struct(BodyListOut,Body1). 392 393 394%**************************************************************** 395%* 396%* predicate: unflatten_clause1/7 397%* 398%* syntax: unflatten_clause1(+HeadIn,+BodyIn1,+BodyIn2,-HeadOut,-BodyOut1, 399%* -BodyOut2,?Bg) 400%* 401%* args: +HeadIn (function free) head of flattened clause 402%* +BodyIn1 403%* +BodyIn2 difference lists of body literals (flattened) 404%* -HeadOut head of unflattened clause 405%* -BodyOut1 406%* -BodyOut2 difference lists of body literals (unflattened) 407%* ?Bg optional background knowledge - not used yet 408%* 409%* description: unflattens a clause ; 410%* some variables are replaced by functions & 411%* certain literals are dumped 412%* 413%* example: 414%* 415%* peculiarities: 416%* 417%* 418%* see also: 419%* 420%**************************************************************** 421 422unflatten_clause1( HeadIn,BodyIn1,[Literal|Rest],HeadOut,BodyOut1,BodyOut2,Bg ):- 423 Literal =.. [ PredFunctor | Args], 424 map_function_to_pred(Functor,PredFunctor) , 425 % Literal was introduced by flattening 426 !, 427 append( Fargs,[Var],Args), % get first n args (Fargs) 428 Function =.. [Functor|Fargs], 429 % substitute Var by Function in whole clause 430 substitute_in_literal(Var,Function,HeadIn, HeadInt), 431 substitute_in_literals(Var,Function,BodyIn1, BodyInt1), 432 substitute_in_literals(Var,Function,Rest, BodyInt2), 433 unflatten_clause1(HeadInt,BodyInt1,BodyInt2, 434 HeadOut,BodyOut1,BodyOut2,Bg). 435 436 437unflatten_clause1( HeadIn,BodyIn1,[Literal|Rest],HeadOut,BodyOut1,BodyOut2,Bg):- 438 !, 439 append(BodyIn1,[Literal],BodyInt1), 440 unflatten_clause1(HeadIn,BodyInt1,Rest,HeadOut,BodyOut1,BodyOut2,Bg). 441 442 443 444unflatten_clause1(Head,Body,[],Head,Body,[],_Bg). 445 446 447%*********************************************************************** 448%* 449%* predicate: map_function_to_pred/2 450%* 451%* syntax: map_function_to_pred(+Function_symbol,-PredName) 452%* 453%* args: 454%* 455%* description: constructs a PredName Function_symbol_p for flattening 456%* 457%* example: 458%* 459%* peculiarities: none 460%* 461%* see also: 462%* 463%*********************************************************************** 464 465map_function_to_pred([],nil_p):-!. % [] -> nil 466map_function_to_pred('.',cons_p):-!. % lists 467map_function_to_pred(Integer,PredName):- % integers , e.g. 15 -> integer_15_p 468 integer(Integer),var(PredName), 469 % spypoint, 470 number_chars(Integer,String),atom_chars(Atom,String), 471 concat_atom([integer, Atom,p],'_',PredName), 472 !. 473map_function_to_pred(Integer,PredName):- % integer_15_p -> 15 474 var(Integer),nonvar(PredName), 475 midstring(PredName,S,'integer__p',8,_,2), 476 name(S,List), 477 number_chars(Integer,List), 478 integer(Integer),!. 479map_function_to_pred(FunctionName,PredName):- % function symbols 480 atom(FunctionName),var(PredName), 481 concat_atom([FunctionName,'_p'],PredName), 482 !. 483map_function_to_pred(FunctionName,PredName):- 484 atom(PredName),var(FunctionName), 485 midstring(PredName,'_p',FunctionName,_,2,0), 486 !