1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1992-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): ECRC GmbH 21% Contributor(s): IC-Parc, Imperal College London 22% 23% END LICENSE BLOCK 24% 25% System: ECLiPSe Constraint Logic Programming System 26% Version: $Id: db.pl,v 1.1 2008/06/30 17:43:45 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29/******************************************************************* 30 31File : db.pl 32Author : Jorge Bocca, Michael Dahmen, Michael Stillger 33Content: The Relational Algebra of MegaLog 34 35Note : This file is for the MegaLog-Sepia integration. It was forked 36 from "@(#)rel_alg.pl 1.10 2/26/92" 37 38 The file has been modified such that the MegaLog compatibility 39 package for Sepia (megalog.pl) is not needed. 40 41Usage : In client module do 42 43:- use_module(library(db)). 44 45*******************************************************************/ 46 47:- module_interface(db). 48 49:- op(950, yfx, 'ondb'), % db handle specification 50 op(900, xfx, '<=>'), % schema declare/query 51 op(900, xfx, '<@>'), % schema compatibility 52 op(900, xfx, '<->'), % frame declare/query 53 op(900, xfx, 'isr'), % relational algebra query sub-language 54 op(900, xfx, '<++'), % relational algebra insert sub-language 55 op(900, xfx, '<--'), % relational algebra delete sub-language 56 op(900, xfx, '++>'), % relational algebra set retrieval 57 op(800, yfx, ':^:'), % projection 58 op(750, yfx, 'where'), % restriction 59 op(750, yfx, ':*:'), % join - 2 60 op(750, yfx, ':+:'), % union 61 op(750, yfx, ':-:'), % difference 62 op(720, yfx, 'and'), % in condition - and 63 op(720, yfx, 'or'). % in condition - or 64 65 66:- begin_module(db). 67 68:- use_module(library(database_kernel)). 69 70:- pragma(system). 71:- pragma(nodebug). 72 73:- tool((ondb)/2, (ondb)/3). 74 75:- export (<=>)/2, (<@>)/2, (<->)/2, (isr)/2, (<++)/2, (<--)/2, (++>)/2. 76 77:- export 78 (ondb)/2, (ondb)/3, 79 arity/2, cardinality/2, del_tup/1, del_tup/2, del_tup/3, 80 helpdb/0, helprel/1, ins_tup/1, ins_tup/2, printrel/1, 81 rename_attributes/2, rename_relation/2, 82 retr_tup/1, retr_tup/2, retr_tup/3. 83 84:- export /* for module kb only */ 85 'KB_real_rname'/2, 'KB_get_all_formats'/2, 'KB_is_attribute'/4, 86 'KB_print_header_rel'/4. 87 88:- import import_body/2, is_predicate_/2 from sepia_kernel. 89 90/* 91** Modules and meta calls : 92** 93** This file defines no predicate that uses meta calls 94*/ 95 96/* not a Sepia predicate, but often used */ 97list([_|_]) ?- true. 98 99/* make frame for descriptor */ 100?- dynamic 'KB_synonym'/2. 101 102 103/* 104** Synonym 105** 106** A way of using pseudo names for relations. 107** 108** expr <-> [] ==> remove all synonyms 109** expr <-> atom ==> add a synonym 110** expr <-> var ==> enumerate all synonyms 111** var <-> atom ==> get real name (only one) 112** 113** where expr is atom old(atom) new(atom) 114*/ 115 116/* remove all 'KB_synonym'(s) of a real relation name */ 117<->( Rel, Synonym) :- 118 <->( Rel, Synonym, 0). 119 120<->( Rel, Synonym, _Database) :- 121 Synonym == [], 122 version_free_name( Rel, _), 123 !, 124 retract_all( 'KB_synonym'( _, Rel)), 125 !. 126 127/* set up a synonym */ 128<->( Rel, Synonym, Database) :- 129 atom(Synonym), 130 version_free_name( Rel, RRel), 131 !, 132 bang_existrel_db(RRel, Database), 133 retract_all( 'KB_synonym'( Synonym, _)), 134 assert( 'KB_synonym'( Synonym, Rel)), 135 !. 136 137/* obtain 'KB_synonym'(s) of a real relation name */ 138<->( Rel, Synonym, Database) :- 139 var(Synonym), 140 version_free_name( Rel, RRel), 141 !, 142 bang_existrel_db(RRel, Database), 143 'KB_synonym'( Synonym, Rel). 144 145/* obtain real name for a given synonym */ 146<->( Rel, Synonym, _Database) :- 147 var(Rel), 148 atom(Synonym), 149 'KB_synonym'( Synonym, Rel), 150 !. 151 152/* --- Support --- */ 153 154 155/* find the name which is free of old, new functor */ 156 157version_free_name( old(Rel), Rel) :- atom(Rel). 158version_free_name( new(Rel), Rel) :- atom(Rel). 159version_free_name( Rel, Rel) :- atom(Rel). 160 161/* obtain real name of a relation i.e. resolves synonyms */ 162/* does not check whether relation really exists */ 163/* performs a syntactically check */ 164 165'KB_real_rname'( old(Rel), old(RRel)) :- 166 'KB_real_rname1'( Rel, RRel), 167 !. 168'KB_real_rname'( new(Rel), new(RRel)) :- 169 'KB_real_rname1'( Rel, RRel), 170 !. 171'KB_real_rname'( Rel, RRel) :- 172 'KB_real_rname1'( Rel, RRel). 173 174 175'KB_real_rname1'( Synonym, Rel) :- 176 'KB_synonym'( Synonym, Rel), 177 !. 178'KB_real_rname1'( Rel, Rel) :- 179 atom(Rel). 180 181 182 183/* 184** Schema querying 185*/ 186 187/* Print the names of all relations in the database. */ 188 189helpdb :- helpdb(0). 190 191helpdb(Database) :- 192 writeln("Permanent relations in database"), 193 writeln("-------------------------------"), 194 current_relation(Name/Arity, Database), 195 writeln(Name/Arity), 196 fail. 197helpdb(Database) :- 198 nl, 199 writeln("Temporary relations in database"), 200 writeln("-------------------------------"), 201 current_temp_relation(Name/Arity, Database), 202 writeln(Name/Arity), 203 fail. 204helpdb(_Database). 205 206/* Give info about the schema of relation 'Rel' */ 207helprel (Rel) :- helprel(Rel, 0). 208 209helprel( Rel, Database ) :- 210 'KB_real_rname'( Rel, RRel1), 211 bang_arity_db( RRel1, Arity, Database), 212 version_free_name(RRel1, RRel2), 213 <=>( RRel2, Format,Database), 214 'KB_print_header_rel'( Rel, RRel2, Arity, Format), 215 'KB_print_tail_rel'( RRel1, Database). 216 217/* Give info about the schema of relation 'Rel' and print content */ 218printrel( Rel) :- printrel( Rel, 0). 219 220printrel( Rel, Database) :- 221 'KB_real_rname'( Rel, RRel1), 222 bang_arity_db( RRel1, Arity, Database), 223 version_free_name(RRel1, RRel2), 224 <=>( RRel2, Format, Database), 225 'KB_print_header_rel'( Rel, RRel2, Arity, Format), 226 'KB_print_tups_rel'( RRel1, Database), 227 'KB_print_tail_rel'( RRel1, Database). 228 229 230/* arity of relation */ 231arity(Rel, Arity) :- 232 arity( Rel, Arity, 0). 233 234arity( Rel, Arity, Database) :- 235 'KB_real_rname'( Rel, RRel), 236 bang_arity_db( RRel, Arity, Database). 237 238/* cardinality of relation */ 239cardinality( Rel, Ntups) :- 240 cardinality( Rel, Ntups, 0). 241 242cardinality( Rel, Ntups, Database) :- 243 'KB_real_rname'( Rel, RRel), 244 bang_cardinality_db( RRel, Ntups, Database). 245 246 247/* --- Support --- */ 248 249'KB_print_header_rel'( Rel, RRel, Arity, Format) :- 250 nl, nl, 251 write( 'RELATION : '), 252 write(Rel), write(' [real name: '), write(RRel), write(']'), nl, nl, 253 write('ARITY: '), write(Arity), nl, nl, 254 write('ATTRIBUTES :'), nl, 255 'KB_print_atts'(Format), nl. 256 257'KB_print_atts'([]) :- !. 258'KB_print_atts'([Format | MFs]) :- 259 write(' '), write(Format), nl, 260 'KB_print_atts'( MFs). 261 262'KB_print_tups_rel'( RRel, Database) :- 263 write( 'TUPLES :'), nl, !, 264 'KB_print_tat'( RRel, Database), nl. 265 266'KB_print_tat'( RRel, Database) :- 267 retr_tup_db( RRel, Tup, Database), write(' '), write( Tup), nl, fail. 268'KB_print_tat'( _, _Database) :- !. 269 270/* 'KB_print_tail_rel' is only used in helprel, printrel */ 271'KB_print_tail_rel'( RRel, Database) :- 272 bang_cardinality_db( RRel, Cardinality, Database), 273 write('NUMBER OF TUPLES : '), write(Cardinality), nl, nl. 274 275 276 277/* 278** Create/Format/Remove relation 279** 280** atom <=> list ==> verify format if relation exists 281** atom <=> list ==> create permanent relation 282** var <=> list ==> create temporary relation 283** atom <=> var ==> obtain relation's format 284** atom <=> [] ==> remove relation 285*/ 286 287/* verify relation's format if relation exist */ 288<=>( Rel, Format) :- 289 <=>( Rel, Format, 0). 290 291<=>( Rel, Format, Database) :- 292 atom(Rel), 293 list(Format), 294 'KB_real_rname'(Rel, RRel), % fails silienty 295 bang_existrel_db(RRel, Database), 296 !, 297 bang_format_db( RRel, Format, Database). 298 299/* create permanent relation */ 300<=>( Rel, Format, Database) :- 301 atom(Rel), 302 list(Format), 303 !, 304 /* Note : bang_createrel/3 checks format for 305 - format is a list 306 - each list element has functor integer/3, real/3, atom/3 307 - attribute name is atom or string 308 - length is legal integer or variable 309 - key is '+', '-' or variable 310 It's not checked that all attribute names are different 311 */ 312 bang_createrel_db( Rel, Format, [permanent], Database). 313 314/* create temporary relation */ 315<=>( Rel, Format, Database) :- 316 var(Rel), 317 list(Format), 318 !, 319 /* Note : bang_createrel/3 checks format (see above) */ 320 bang_createrel_db( Rel, Format, [temporary], Database). 321 322/* obtain relation's format */ 323<=>( Rel, Format, Database) :- 324 atom(Rel), 325 var(Format), 326 !, 327 'KB_real_rname'(Rel, RRel), 328 bang_format_db( RRel, Format, Database). 329 330/* remove relation */ 331<=>( Rel, [], Database) :- 332 atom(Rel), 333 'KB_real_rname'(Rel, RRel), 334 bang_destroyrel_db( RRel, Database), 335 retract_all('KB_synonym'( _, RRel)), 336 !. 337 338 339/* --- Support --- */ 340 341/* Internal formats for a list of real or pseudo relations is used */ 342 343'KB_get_all_formats'( MRels, MRFs) :- 344 'KB_get_all_formats'( MRels, MRFs, 0). 345 346 347 348'KB_get_all_formats'( [], [], _Database) :- !. 349 350'KB_get_all_formats'( [Rel | MRels], [Rel, RRF| MRFs], Database) :- 351 'KB_real_rname'( Rel, RR), 352 bang_format_db( RR, RRF, Database), 353 'KB_get_all_formats'( MRels, MRFs, Database). 354 355 356/* 357** Schema Compatibility 358** 359** R1 and R2 have combatible schemas iff there corresponding 360** attributes have same type and length. 361*/ 362 363<@>( Rel1, Rel2) :- 364 <@>( Rel1, Rel2, 0). 365 366<@>( Rel1, Rel2,Database) :- 367 'KB_real_rname'( Rel1, RRel11), 368 version_free_name(RRel11, RRel12), 369 'KB_real_rname'( Rel2, RRel21), 370 version_free_name(RRel21, RRel22), 371 <=> (RRel12, F1, Database), % get format for Rel1 372 <=> (RRel22, F2, Database), % get format for Rel2 373 'KB_compatible_formats'( F1, F2), 374 !. 375 376 377 378/* --- Support --- */ 379 380'KB_compatible_formats'( [], []) :- !. 381 382'KB_compatible_formats'([integer(_, Sz, _)| MF1s], [integer(_, Sz, _)| MF2s]) :- 383 'KB_compatible_formats'( MF1s, MF2s). 384 385'KB_compatible_formats'([ real( _, Sz, _) | MF1s], [ real( _, Sz, _) | MF2s]) :- 386 'KB_compatible_formats'( MF1s, MF2s). 387 388'KB_compatible_formats'([ atom( _, Sz, _) | MF1s], [ atom( _, Sz, _) | MF2s]) :- 389 'KB_compatible_formats'( MF1s, MF2s). 390 391'KB_compatible_formats'([ term( _, _, _) | MF1s], [ term( _, _, _) | MF2s]) :- 392 'KB_compatible_formats'( MF1s, MF2s). 393 394'KB_compatible_formats'([ code( _, _, _) | MF1s], [ code( _, _, _) | MF2s]) :- 395 'KB_compatible_formats'( MF1s, MF2s). 396 397 398/* 399** Tuple at a time 400** 401** ins_tup( rel( a1, ..., an)). % inserts one tuple in rel 402** ins_tup( rel, [ a1, ..., an]). % inserts one tuple in rel 403** 404** del_tup( rel( a1, ..., an)). % deletes one tuple in rel 405** del_tup( rel, [ a1, ..., an]). % deletes one tuple in rel 406** del_tup( rel, [ a1, ..., an], Cond). % deletes one tuple in rel 407** 408** retr_tup( rel( A1, ..., An)). % Tuple at a time retrieval 409** retr_tup( rel, [ A1, ..., An]). % Tuple at a time retrieval 410** retr_tup( rel, [ A1, ..., An], Cond). % Tuple at a time retrieval 411*/ 412/* The predicates ins_tup/1,2; del_tup/1,2 and retr_tup/1,2,3 413** remain for compatibility, but are mapped to the 414** internal new format of the buildins. The new predicates are called 415** <old_name>_db like bang_select * see database_kernel.pl * 416*/ 417 418ins_tup( Term) :- 419 ins_tup_db( Term, 0). 420 421ins_tup( Rel, Tuple) :- 422 ins_tup_db( Rel, Tuple, 0). 423 424ins_tup_db( Term, Database) :- 425 compound(Term), 426 Term \= [_|_], % Sepia compound include list 427 Term =.. [Rel | Tuple], 428 ins_tup_db( Rel, Tuple, Database). 429 430ins_tup_db( Rel, Tuple, Database) :- 431 'KB_real_rname'( Rel, RRel), 432 bang_insert_db( RRel, Tuple, Database). 433 434 435/* retrieve using relname + list of atts + cond */ 436del_tup( Term) :- 437 del_tup_db( Term, 0 ). 438 439del_tup( Rel, Tuple) :- 440 del_tup_db( Rel, Tuple, 0). 441 442del_tup( Rel, Tuple, Cond) :- 443 del_tup_db( Rel, Tuple, Cond, 0). 444 445del_tup_db( Term, Database ) :- 446 compound(Term), 447 Term \= [_|_], % Sepia compound include list 448 Term =.. [Rel | Tuple], 449 del_tup_db( Rel, Tuple, Database). 450 451del_tup_db( Rel, Tuple, Database) :- 452 'KB_real_rname'( Rel, RRel), 453 bang_retrieve_delete_db( RRel, Tuple, true, Database). 454 455del_tup_db( Rel, Tuple, Cond, Database) :- 456 'KB_real_rname'( Rel, RRel), 457 'KB_cond_parse'( Cond, [RRel], CondT, Database), 458 bang_retrieve_delete_db( RRel, Tuple, CondT, Database). 459 460 461/* retrieve using a structure */ 462retr_tup( Rel, Tuple, Cond) :- 463 retr_tup_db( Rel, Tuple, Cond, 0). 464 465/* retrieve using relname + list of atts */ 466retr_tup( Rel, Tuple) :- 467 retr_tup_db( Rel, Tuple, 0). 468 469/* retrieve using a structure */ 470retr_tup( Term) :- 471 retr_tup_db( Term , 0). 472 473retr_tup_db( Term , Database) :- 474 compound(Term), 475 Term \= [_|_], % Sepia compound include list 476 Term =.. [Rel | Tuple], 477 retr_tup_db( Rel, Tuple, Database). 478 479/* retrieve using relname + list of atts */ 480retr_tup_db( Rel, Tuple, Database) :- 481 'KB_real_rname'( Rel, RRel), 482 bang_retrieve_db( RRel, Tuple, true, Database). 483 484/* retrieve using relname + list of atts + cond */ 485retr_tup_db( Rel, Tuple, Cond, Database) :- 486 'KB_real_rname'( Rel, RRel), 487 'KB_cond_parse'( Cond, [RRel], CondT, Database), 488 bang_retrieve_db( RRel, Tuple, CondT, Database). 489 490 491/* 492** Set at a time 493** 494** expression ++> List % retrieve result of evaluation 495** 496** RelName isr expression % create for result of evaluation 497** 498** relname <++ [Tuple1, Tuple2, ... ] % insert tuple list 499** relname <++ expression % insert result of evalutation 500** 501** relname <-- Tuple1, Tuple2, ... ] % delete tuple list 502** relname <-- expression % delete result of evalutation 503** 504** An expression is one of 505** 506** [A1, .., Am] :^: Rel where Cond % selection with projection 507** [A1, .., Am] :^: R1 :*: R2 where Cond % join with proj. 508** [A1, .., Am] :^: R1 :+: R2 where Cond % union with projection 509** [A1, .., Am] :^: R1 :-: R2 where Cond % difference with projection 510** 511** both projection and condition are optional 512** 513** where Cond is: 514** Att < Cte (or Cte > Att) % less than 515** Att =< Cte (or Cte >= Att) % less or equal than 516** Att == Cte (or Cte == Att) % equal than 517** Att >= Cte (or Cte =< Att) % greater or equal than 518** Att > Cte (or Cte < Att) % greater than 519** At1 == At2 % attributes' equality 520** Cond and Cond % logical and 521** 522** Att is an unambiguous attribute name. Ambiguous attribute names 523** are disambiguated by prefixing them with <relation name>^. Thus, 524** 525** Rel^Att 526** 527** For example: employee^salary 528*/ 529 530Expr ++> List :- 531 ++>(Expr, List , 0). 532 533++>(Rel where Cond, List, Database) :- 534 'KB_real_rname'( Rel, RRel), 535 !, 536 'KB_cond_parse'( Cond, [RRel], CondT, Database), 537 bang_retrieve_list_db( RRel, CondT, List, Database). 538++>(Rel, List, Database) :- 539 'KB_real_rname'( Rel, RRel), 540 version_free_name( RRel, _), 541 !, 542 bang_retrieve_list_db( RRel, true, List, Database). 543++>(Expr, List, Database) :- 544 isr(Y,Expr, Database), 545 bang_retrieve_list_db( Y, true, List, Database), 546 <=> (Y,[], Database). 547 548 549OutRel isr Expr :- 550 isr (OutRel, Expr, 0). 551 552isr(OutRel, Expr, Database) :- 553 insert_set_expression( OutRel, Expr, Database). 554 555 556OutRel <++ Expr :- 557 <++ (OutRel, Expr, 0). 558 559<++(OutRel, Expr, Database) :- 560 list(Expr), 561 !, 562 'KB_real_rname'( OutRel, ORR), 563 'KB_insert_tups'( ORR, Expr, Database). 564<++(OutRel, Expr, Database) :- 565 'KB_real_rname'( OutRel, ORR), 566 version_free_name( ORR, Rel), 567 bang_existrel_db(Rel, Database), 568 !, 569 insert_set_expression( ORR, Expr, Database). 570<++(OutRel, Expr, _) :- 571 error(303, OutRel <++ Expr). 572 /* ERROR_CODE(303) : RELATION DOES NOT EXIST */ 573 574 575OutRel <-- Expr :- 576 <-- (OutRel, Expr , 0). 577 578<-- (OutRel, Expr , Database) :- 579 list(Expr), 580 !, 581 'KB_real_rname'( OutRel, ORR), 582 'KB_delete_tuples'( ORR, Expr, Database). 583<-- (OutRel, Expr , Database) :- 584 'KB_real_rname'( OutRel, ORR), 585 version_free_name( ORR, Rel), 586 bang_existrel_db(Rel, Database), 587 !, 588 delete_set_expression( ORR, Expr, Database). 589<-- (OutRel, Expr , _) :- 590 error(303, OutRel <-- Expr). 591 /* ERROR_CODE(303) : RELATION DOES NOT EXIST */ 592 593/*--------------------------------------------------------*/ 594/* --- Support --- */ 595 596'KB_insert_tups'( _, [], _Database) :- !. 597'KB_insert_tups'( X, [ Tuple | Tuples], Database) :- 598 bang_insert_db(X, Tuple, Database), 599 'KB_insert_tups'( X, Tuples, Database). 600 601/* delete all tuples matching one in a list of tuples from relation */ 602 603'KB_delete_tuples'( _, [], _Database) :- !. 604'KB_delete_tuples'( X, [ Tuple | _ ], Database) :- 605 bang_retrieve_delete_db( X, Tuple, true, Database), 606 fail. 607'KB_delete_tuples'( X, [ _ | Tuples], Database) :- 608 'KB_delete_tuples'( X, Tuples, Database). 609 610 611 612/* R1 <-- R2 remove tuples in Expr (relation) from OutRel */ 613delete_set_expression( OutRel, Expr, Database) :- 614 version_free_name(Expr,_), 615 !, 616 delete_set_kernel( Expr, true, OutRel, Database). 617 618/* R1 <-- R2 where C delete result of selection */ 619delete_set_expression( OutRel,R where Cond, Database) :- 620 !, 621 delete_set_kernel( R, Cond, OutRel, Database). 622 623/* R1 <-- RelExpr delete result of general query */ 624delete_set_expression( OutRel, Expr, Database) :- 625 isr (Y, Expr, Database), 626 delete_set_kernel( Y, true, OutRel, Database), 627 <=>(Y, [], Database). 628 629 630 631/* --- Support --- */ 632 633/* R <-- R where C i.e. delete from same relation (no difference) */ 634delete_set_kernel( R, Cond, OutRel, Database) :- 635 'KB_real_rname'( R, RR), 636 'KB_real_rname'( OutRel, ORR), 637 RR == ORR, 638 !, 639 'KB_cond_parse'( Cond, [R], CondT, Database), 640 bang_delete_db( RR, CondT, Database). 641 642/* R1 <-- R2 where C i.e. difference operation */ 643delete_set_kernel( R, Cond, OutRel, Database) :- 644 'KB_real_rname'( R, RR), 645 'KB_real_rname'( OutRel, ORR), 646 'KB_cond_parse'( Cond, [R], CondT, Database), 647 ( 648 ( bang_retrieve_db(RR, Tuple, CondT, Database), 649 bang_retrieve_delete( ORR, Tuple, true, Database), 650 fail 651 ) 652 ; 653 true 654 ). 655/* Note bang_diff can not be used, cause it requires three different rels */ 656 657 658 659 660 661 662/* 663** optional projection and conditions surrounding a algebra kernel 664** 665** default for missing projection is copy all (denoted by []) 666** default for missing condition is no selection (denoted by true) 667*/ 668 669insert_set_expression( OutRel, ProjL :^: Expr where Cond, Database) :- 670 !, 671 insert_set_kernel( Expr, Cond, ProjL, OutRel, Database). 672insert_set_expression( OutRel, ProjL :^: Expr, Database) :- 673 !, 674 insert_set_kernel( Expr, true, ProjL, OutRel, Database). 675insert_set_expression( OutRel, Expr where Cond, Database) :- 676 !, 677 insert_set_kernel( Expr, Cond, [], OutRel, Database). 678insert_set_expression( OutRel, Expr, Database) :- 679 insert_set_kernel( Expr, true, [], OutRel, Database). 680 681 682 683/* 684** the kernel of a relational expression is one of 685** R1 :+: R2 union 686** R1 :-: R2 difference 687** R1 :*: R2 join 688** R simple select/project 689*/ 690 691insert_set_kernel( R1 :+: R2, Cond, ProjL, OutRel, Database) :- 692 !, 693 insert_set_kernel(R1, Cond, ProjL, OutRel, Database), 694 insert_set_kernel(R2, Cond, ProjL, OutRel, Database). 695 696insert_set_kernel( R1 :-: R2, Cond, ProjL, OutRel, Database) :- 697 'KB_real_rname'( R1, RR1), 698 'KB_real_rname'( R2, RR2), 699 !, 700 'KB_cond_parse'( Cond, [R1, R2], CondT, Database), 701 'KB_project'( ProjL, [R1], CProjL, Database), % only RR1 !! 702 bang_diff_db( RR1, RR2, CondT, CProjL, OutRel, Database). 703 704insert_set_kernel( R1 :*: R2, Cond, ProjL, OutRel, Database) :- 705 'KB_real_rname'( R1, RR1), 706 'KB_real_rname'( R2, RR2), 707 !, 708 'KB_cond_parse'( Cond, [R1, R2], CondT, Database), 709 'KB_project'( ProjL, [R1, R2], CProjL, Database), 710 bang_join_db( RR1, RR2, CondT, CProjL, OutRel, Database). 711 712insert_set_kernel( R, Cond, ProjL, OutRel, Database) :- 713 'KB_real_rname'( R, RR), 714 !, 715 'KB_cond_parse'( Cond, [R], CondT, Database), 716 'KB_project'( ProjL, [R], CProjL, Database), 717 bang_select_db( RR, CondT, CProjL, OutRel, Database). 718 719insert_set_kernel( R, Cond, ProjL, OutRel, _) :- 720 error(5, OutRel <++ ProjL :^: R where Cond). 721 722 723/* 724** Projection list handling 725** 726** From a list of attribute name i.e. AttName or RelName ^ AttName 727** build a list of AttId i.e. att(RelNo,AttNo) 728*/ 729 730'KB_project'( [], _, [], _) :- !. 731 732'KB_project'( ProjL, Rels, CProjL, Database) :- 733 'KB_get_all_formats'( Rels, RFs, Database), 734 'KBX_project'( RFs, ProjL, CProjL), 735 !. 736'KB_project'( ProjL, _, _, _) :- 737 error(321, ProjL), 738 !, 739 fail. 740 /* ERROR_CODE(321) : BAD ATTRIBUTE IN PROJECTION LIST */ 741 742 743 744'KBX_project'( _, [], []) :- !. 745 746'KBX_project'( RFs, [ A| ProjL], [ AttId |TProjL]) :- 747 'KB_is_attribute'( RFs, 1, A, AttId), 748 'KBX_project'( RFs, ProjL, TProjL). 749 750 751/* 752** Condition tree handling 753** 754** From a condition tree in relational algebra format build the 755** corresponding tree in internal BANG format. 756*/ 757 758'KB_cond_parse'( true, _, true, _) :- !. 759 760'KB_cond_parse'( Cond, Rs, CondT, Database) :- 761 'KB_get_all_formats'( Rs, RFs, Database), 762 'KBX_cond_parse'( Cond, RFs, CondT). 763 764 765/* --- [H] Support --- */ 766 767'KBX_cond_parse'( true, _Rs, true) :- !. 768 769/* 770'KBX_cond_parse'( false, _Rs, false) :- !. 771 772'KBX_cond_parse'( not C, Rs, not( TC)) :- 773 !, 774 'KBX_cond_parse'( C, Rs, TC). 775*/ 776 777'KBX_cond_parse'( C1 and C2, Rs, and( TC1, TC2)) :- 778 !, 779 'KBX_cond_parse'( C1, Rs, TC1), 780 'KBX_cond_parse'( C2, Rs, TC2). 781 782/* 783'KBX_cond_parse'( C1 or C2, Rs, or( TC1, TC2)) :- 784 !, 785 'KBX_cond_parse'( C1, Rs, TC1), 786 'KBX_cond_parse'( C2, Rs, TC2). 787*/ 788 789'KBX_cond_parse'( SimpleComp, Rs, Expr) :- 790 SimpleComp =.. [Comparator, Arg1, Arg2], 791 'KBX_cond_arg'( Arg1, Rs, ConvArg1), 792 'KBX_cond_arg'( Arg2, Rs, ConvArg2), 793 'KBX_cond_op'( Comparator, ConvArg1, ConvArg2, Expr), 794 !. 795'KBX_cond_parse'( SimpleComp, _, _) :- 796 error(322, SimpleComp), 797 !, 798 fail. 799 /* ERROR_CODE(322) : BAD COMPARISON IN WHERE EXPRESSION */ 800 801 802/* 803** mode('KBX_cond_arg'(in,in,out)) 804** solve(once_or_fail) 805*/ 806 807'KBX_cond_arg'( Att, Rs, AttId) :- 808 'KB_is_attribute'( Rs, 1, Att, AttId), 809 /* AttId = att(RelNo,AttPos) */ 810 !. 811'KBX_cond_arg'( Constant, _, Constant) :- 812 atomic( Constant). 813 814/* 815** construct a simple condition from a comparison operator and two operands 816** the BANG builtins require that 817** - functor is eq, diff, less, greater, less_eq, greater_eq 818** - on attribute - constant comparisons the attribute comes first 819** - attribute - attribute comparsions are allowed with all comperators 820** both within one or between the two relations (join, diff) 821** 822** mode('KBX_cond_op'(in,in,in,out)) 823** solve(several) 824*/ 825 826'KBX_cond_op'( '==' , X, Y, eq(X,Y)) :- X = att(_,_). 827'KBX_cond_op'( '==' , X, Y, eq(Y,X)) :- Y = att(_,_). 828'KBX_cond_op'( '\\==', X, Y, diff(X,Y)) :- X = att(_,_). 829'KBX_cond_op'( '\\==', X, Y, diff(Y,X)) :- Y = att(_,_). 830'KBX_cond_op'( '<' , X, Y, less(X,Y)) :- X = att(_,_). 831'KBX_cond_op'( '<' , X, Y, greater(Y,X)) :- Y = att(_,_). 832'KBX_cond_op'( '=<' , X, Y, less_eq(X,Y)) :- X = att(_,_). 833'KBX_cond_op'( '=<' , X, Y, greater_eq(Y,X)) :- Y = att(_,_). 834'KBX_cond_op'( '>' , X, Y, greater(X,Y)) :- X = att(_,_). 835'KBX_cond_op'( '>' , X, Y, less(Y,X)) :- Y = att(_,_). 836'KBX_cond_op'( '>=' , X, Y, greater_eq(X,Y)) :- X = att(_,_). 837'KBX_cond_op'( '>=' , X, Y, less_eq(Y,X)) :- Y = att(_,_). 838 839 840 841 842 843/* 844** Give a unique identifier to an attribute - if exists : att(Rno, Pos) 845** Find the position of an attribute in a relation 846** 847** mode('KB_is_attribute'(in,in,in,out)) 848** solve(once_or_fail) 849*/ 850 851'KB_is_attribute'( [ R, RF | _], Rno, R1 ^ Att, att(Rno, AttNo)) :- 852 R1 == R, 853 atom(Att), 854 !, 855 'KBS_in_position'( Att, RF, 1, AttNo). 856 857'KB_is_attribute'( [ _R, RF | _], Rno, Att, att(Rno, AttNo)) :- 858 atom(Att), 859 'KBS_in_position'( Att, RF, 1, AttNo), 860 !. 861 862'KB_is_attribute'( [ _, _ | MRs], Rno, Att, AttId) :- 863 Rno1 is Rno + 1, 864 'KB_is_attribute'( MRs, Rno1, Att, AttId). 865 866 867/* 868** look for an attribute name in a relation's format and return position 869** 870** type('KBS_in_position'(atom, format, integer, integer)) 871** mode('KBS_in_position'(in,in,in,out)) 872** solve(once_or_fail) 873*/ 874 875'KBS_in_position'( AttName, [ AttFormat| _], N, N) :- 876 arg(1,AttFormat,AttName), 877 !. 878'KBS_in_position'( X, [ _| T], M, N) :- 879 M1 is M + 1, 880 'KBS_in_position'( X, T, M1, N). 881 882 883 884 885 886/* 887** rename relation 888*/ 889 890rename_attributes( Rel, NewNames) :- 891 rename_attributes( Rel, NewNames, 0). 892 893rename_attributes( Rel, NewNames, Database) :- 894 'KB_real_rname'( Rel, RRel), 895 bang_arity_db( RRel, Arity, Database), 896 length( NewNames, Arity), 897 bang_renamerel_db( RRel, RRel, NewNames, Database). 898 899rename_relation( Rel, NewRel) :- 900 rename_relation( Rel, NewRel, 0). 901 902rename_relation( Rel, NewRel, Database) :- 903 bang_renamerel_db( Rel, NewRel, Database). 904 905 906 907/* 908** DBoperation ondb DBhandle 909*/ 910 911ondb(Op, DB, _) :- var(Op), !, error(4, ondb(Op, DB)). 912 913ondb(Rel ++> List, DB, _) :- !, ++>(Rel, List, DB). 914ondb(OutRel <++ Expr, DB, _) :- !, <++(OutRel, Expr, DB). 915ondb(OutRel <-- Expr, DB, _) :- !, <-- (OutRel, Expr , DB). 916ondb(Rel1<@> Rel2, DB, _) :- !, <@>( Rel1, Rel2,DB). 917ondb(Rel <-> Synonym, DB, _) :- !, <->( Rel, Synonym, DB). 918ondb(Rel <=> Format, DB, _) :- !, <=>( Rel, Format, DB). 919ondb(OutRel isr Expr, DB, _) :- !, isr(OutRel, Expr, DB). 920ondb(arity(Rel, Arity), DB, _) :- !, arity( Rel, Arity, DB). 921ondb(cardinality(Rel, Arity), DB, _) :- !, cardinality( Rel, Arity, DB). 922ondb(del_tup(Term), DB, _) :- !, del_tup_db( Term, DB). 923ondb(del_tup(Rel, Tuple), DB, _) :- !, del_tup_db( Rel, Tuple, DB). 924ondb(del_tup(Rel, Tuple, Cond), DB, _) :- !, del_tup_db(Rel, Tuple, Cond, DB). 925ondb(helpdb, DB, _) :- !, helpdb(DB). 926ondb(helprel(Rel), DB, _) :- !, helprel(Rel, DB). 927ondb(ins_tup(Term), DB, _) :- !, ins_tup_db( Term, DB). 928ondb(ins_tup(Rel, Tuple), DB, _) :- !, ins_tup_db( Rel, Tuple, DB). 929ondb(printrel(Rel), DB, _) :- !, printrel( Rel, DB). 930ondb(rename_attributes(Rel, NewNames), DB, _) :- !, 931 rename_attributes(Rel, NewNames, DB). 932ondb(rename_relation(Rel, NewNames), DB, _) :- !, 933 rename_relation(Rel, NewNames, DB). 934ondb(retr_tup(Term), DB, _) :- !, retr_tup_db( Term, DB). 935ondb(retr_tup(Rel, Tuple), DB, _) :- !, retr_tup_db( Rel, Tuple, DB). 936ondb(retr_tup(Rel, Tuple, Cond), DB, _) :- !, 937 retr_tup_db( Rel, Tuple, Cond, DB). 938ondb(closedb, DB, _) :- !, closedb(DB). 939ondb(createdb(A), DB, _) :- !, createdb(A,DB). 940ondb(current_relation(A), DB, _) :- !, current_relation(A,DB). 941ondb(current_temp_relation(A), DB, _) :- !, current_temp_relation(A,DB). 942ondb(destroydb, DB, _) :- !, destroydb(DB). 943ondb(destroy_temprels, DB, _) :- !, destroy_temprels(DB). 944ondb(opendb(A), DB, _) :- !, opendb(A,DB). 945ondb(statistics_desc, DB, _) :- !, statistics_desc(DB). 946ondb(statistics_relation(A), DB, _) :- !, statistics_relation(A,DB). 947 948ondb(bang_arity(A,B), DB, _) :- !, bang_arity_db(A,B,DB). 949ondb(bang_attribute(A,B,C), DB, _) :- !, bang_attribute_db(A,B,C,DB). 950ondb(bang_cardinality(A,B), DB, _) :- !, bang_cardinality_db(A,B,DB). 951ondb(bang_createrel(A,B,C), DB, _) :- !, bang_createrel_db(A,B,C,DB). 952ondb(bang_delete(A,B), DB, _) :- !, bang_delete_db(A,B,DB). 953ondb(bang_delete_tup(A,B), DB, _) :- !, bang_delete_tup_db(A,B,DB). 954ondb(bang_delete_tup(A,B,C), DB, _) :- !, bang_delete_tup_db(A,B,C,DB). 955ondb(bang_destroyrel(A), DB, _) :- !, bang_destroyrel_db(A,DB). 956ondb(bang_diff(A,B,C,D,E), DB, _) :- !, bang_diff_db(A,B,C,D,E,DB). 957ondb(bang_diff(A,B,C,D,E,F), DB, M) :- !, bang_diff_db_body(A,B,C,D,E,F,DB,M). 958ondb(bang_exist(A,B), DB, _) :- !, bang_exist_db(A,B,DB). 959ondb(bang_existrel(A), DB, _) :- !, bang_existrel_db(A,DB). 960ondb(bang_format(A,B), DB, _) :- !, bang_format_db(A,B,DB). 961ondb(bang_format(A,B,C), DB, _) :- !, bang_format_db(A,B,C,DB). 962ondb(bang_insert(A,B), DB, _) :- !, bang_insert_db(A,B,DB). 963ondb(bang_insert(A,B,C), DB, _) :- !, bang_insert_db(A,B,C,DB). 964ondb(bang_join(A,B,C,D,E), DB, _) :- !, bang_join_db(A,B,C,D,E,DB). 965ondb(bang_join(A,B,C,D,E,F), DB, M) :- !, bang_join_db_body(A,B,C,D,E,F,DB,M). 966ondb(bang_free_cursor, DB, _) :- !, bang_free_cursor_db(DB). 967ondb(bang_register(A,B), DB, _) :- !, bang_register_db(A,B,DB). 968ondb(bang_renamerel(A,B), DB, _) :- !, bang_renamerel_db(A,B,DB). 969ondb(bang_renamerel(A,B,C), DB, _) :- !, bang_renamerel_db(A,B,C,DB). 970ondb(bang_retrieve(A,B,C), DB, _) :- !, bang_retrieve_db(A,B,C,DB). 971ondb(bang_retrieve_delete(A,B,C), DB, _) :- !, 972 bang_retrieve_delete_db(A,B,C,DB). 973ondb(bang_retrieve_delete(A,B,C,D), DB, M) :- !, 974 bang_retrieve_delete_db_body(A,B,C,D,DB,M). 975ondb(bang_retrieve_lazy(A,B,C), DB, _) :- !, bang_retrieve_lazy_db(A,B,C,DB). 976ondb(bang_retrieve_list(A,B,C), DB, _) :- !, bang_retrieve_list_db(A,B,C,DB). 977ondb(bang_select(A,B,C,D), DB, _) :- !, bang_select_db(A,B,C,D,DB). 978ondb(bang_select(A,B,C,D,E), DB, M) :- !, bang_select_db_body(A,B,C,D,E,DB,M). 979 980ondb(Op, DB, _) :- error(60, ondb(Op, DB)). 981