🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.prolog
Article #2160

Prolog to SQL compiler v. 1.1 (part 2/2)

#2160
From: Christoph Draxler
Date: Tue, 22 Dec 1992 12:50
687 lines
17483 bytes
% --- CODE for SQL compiler continued from part 1/2 ---------


%
--------------------------------------------------------------------------------------
%
% Output to screen predicates - rather crude at the moment
%
%
--------------------------------------------------------------------------------------


% --- printqueries(Code)
---------------------------------------------------------------

printqueries([Query]):-
   nl,
   print_query(Query),
   write(';'),
   nl,
   nl.

printqueries([Query|Queries]):-
   not (Queries = []),
   nl,
   print_query(Query),
   nl,
   write('UNION'),
   nl,
   printqueries(Queries).



% --- print_query(QueryCode)
-----------------------------------------------------------

print_query(query([agg_query(Function,Select,From,Where,Group)],_,_)):-
   % --- ugly rule here: aggregate function only in SELECT Part of query
----
   !,
   print_query(agg_query(Function,Select,From,Where,Group)).

print_query(query(Select,From,Where)):-
   print_clause('SELECT',Select,','),
   nl,
   print_clause('FROM',From,','),
   nl,
   print_clause('WHERE',Where,'AND'),
   nl.

print_query(agg_query(Function,Select,From,Where,Group)):-
   print_clause('SELECT',Function,Select,','),
   nl,
   print_clause('FROM',From,','),
   nl,
   print_clause('WHERE',Where,'AND'),
   nl,
   print_clause('GROUP BY',Group,',').

print_query(negated_existential_subquery(Select,From,Where)):-
   write('NOT EXISTS'),
   nl,
   write('('),
   print_clause('SELECT',Select,','),
   nl,
   print_clause('FROM',From,','),
   nl,
   print_clause('WHERE',Where,'AND'),
   nl,
   write(')').




% --- print_clause(Keyword,ClauseCode,Separator)
---------------------------------------
%
% with 
% Keyword    one of SELECT, FROM, WHERE, or GROUP BY, 
% ClauseCode the code corresponding to the appropriate clause of an SQL
query, and 
% Separator  indicating the character(s) through which the items of a
clause
%            are separated from each other (',' or 'AND').
% 
%
--------------------------------------------------------------------------------------

print_clause(Keyword,[],_).

print_clause(Keyword,[Column|RestColumns],Separator):-
   write(Keyword),
   write(' '),
   print_clause([Column|RestColumns],Separator).

print_clause(Keyword,Function,[Column],Separator):-
   write(Keyword),
   write(' '),
   write(Function),
   write('('),
   print_clause([Column],Separator),
   write(')').





% --- print_clause(ClauseCode,Separator)
-----------------------------------------------

print_clause([Item],_):-
   print_column(Item).

print_clause([Item,NextItem|RestItems],Separator):-
   print_column(Item),
   write(' '),
   write(Separator),
   write(' '),
   print_clause([NextItem|RestItems],Separator).




% --- print_column(ColumnCode) --------------------------------

print_column('*'):-
   write('*').

print_column(att(RangeVar,Attribute)):-
   write(RangeVar),
   write('.'),
   write(Attribute).

print_column(rel(Relation,RangeVar)):-
   write(Relation),
   write(' '),
   write(RangeVar).

print_column(const(String)):-
   get_type(const(String),string),
   write('"'),
   write(String),
   write('"').

print_column(const(Number)):-
   get_type(const(Number),NumType),
   type_compatible(NumType,number),
   write(Number).

print_column(comp(LeftArg,Operator,RightArg)):-
   print_column(LeftArg),
   write(' '),
   write(Operator),
   write(' '),
   print_column(RightArg).

print_column(LeftExpr * RightExpr):-
   print_column(LeftExpr),
   write('*'),
   print_column(RightExpr).

print_column(LeftExpr / RightExpr):-
   print_column(LeftExpr),
   write('/'),
   print_column(RightExpr).

print_column(LeftExpr + RightExpr):-
   print_column(LeftExpr),
   write('+'),
   print_column(RightExpr).

print_column(LeftExpr - RightExpr):-
   print_column(LeftExpr),
   write('-'),
   print_column(RightExpr).

print_column(agg_query(Function,Select,From,Where,Group)):-
   nl,
   write('('),
   print_query(agg_query(Function,Select,From,Where,Group)),
   write(')').

print_column(negated_existential_subquery(Select,From,Where)):-
   print_query(negated_existential_subquery(Select,From,Where)).





% --- queries_atom(Queries,QueryAtom) ---------------------------- 
%
% queries_atom(Queries,QueryAtom) returns in its second argument
% the SQL query as a Prolog atom. For efficiency reasons, a list
% of ASCII codes is ceated as a difference list, and it is then 
% transformed to an atom by name/2
% ---------------------------------------------------------------- 


queries_atom(Queries,QueryAtom):-
   queries_atom(Queries,QueryList,[]),
   name(QueryAtom,QueryList).



queries_atom([Query],QueryList,Diff):-
   query_atom(Query,QueryList,Diff).

queries_atom([Query|Queries],QueryList,Diff):-
   Queries \= [],
   query_atom(Query,QueryList,X1),
   column_atom('UNION',X1,X2),
   queries_atom(Queries,X2,Diff).



% --- query_atom(QueryCode) --------------------------------

query_atom(query([agg_query(Function,Select,From,Where,Group)],_,_),QueryList,Diff):-
   % --- ugly rule here: aggregate function only in SELECT Part of query
----
   !,
   query_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff).

query_atom(query(Select,From,Where),QueryList,Diff):-
   clause_atom('SELECT',Select,',',QueryList,X1),
   clause_atom('FROM',From,',',X1,X2),
   clause_atom('WHERE',Where,'AND',X2,Diff).

query_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff):-
   clause_atom('SELECT',Select,',',QueryList,X1),
   clause_atom('FROM',From,',',X1,X2),
   clause_atom('WHERE',Where,'AND',X2,X3),
   clause_atom('GROUP BY',Group,',',X3,Diff).

query_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff):-
   column_atom('NOT EXISTS(',QueryList,X1),   
   clause_atom('SELECT',Select,',',X1,X2),
   clause_atom('FROM',From,',',X2,X3),
   clause_atom('WHERE',Where,'AND',X3,X4),
   column_atom(')',X4,Diff).




% --- clause_atom(Keyword,ClauseCode,Junctor,CurrAtom,QueryAtom)
-------------
%
% with 
% Keyword    one of SELECT, FROM, WHERE, or GROUP BY, 
% ClauseCode the code corresponding to the appropriate clause of an SQL
query, and 
% Junctor    indicating the character(s) through which the items of a
clause
%            are separated from each other (',' or 'AND').

clause_atom(Keyword,[],_,QueryList,QueryList).

clause_atom(Keyword,[Column|RestColumns],Junctor,QueryList,Diff):-
   column_atom(Keyword,QueryList,X1),
   column_atom(' ',X1,X2),
   clause_atom([Column|RestColumns],Junctor,X2,X3),
   column_atom(' ',X3,Diff).

clause_atom(Keyword,Function,[Column],Junctor,QueryList,Diff):-
   column_atom(Keyword,QueryList,X1),
   column_atom('(',X1,X2),
   clause_atom([Column],Junctor,X2,X3),
   column_atom(')',X3,Diff).






% --- clause_atom(ClauseCode,Junctor) --------------------------------

clause_atom([Item],_,QueryList,Diff):-
   column_atom(Item,QueryList,Diff).

clause_atom([Item,NextItem|RestItems],Junctor,QueryList,Diff):-
   column_atom(Item,QueryList,X1),
   column_atom(' ',X1,X2),
   column_atom(Junctor,X2,X3),
   column_atom(' ',X3,X4),
   clause_atom([NextItem|RestItems],Junctor,X4,Diff).





column_atom(att(RangeVar,Attribute),QueryList,Diff):-
   column_atom(RangeVar,QueryList,X1),
   column_atom('.',X1,X2),
   column_atom(Attribute,X2,Diff).

column_atom(rel(Relation,RangeVar),QueryList,Diff):-
   column_atom(Relation,QueryList,X1),
   column_atom(' ',X1,X2),
   column_atom(RangeVar,X2,Diff).

column_atom(const(String),QueryList,Diff):-
   get_type(const(String),string),
   column_atom('"',QueryList,X1),
   column_atom(String,X1,X2),
   column_atom('"',X2,Diff).

column_atom(const(Number),QueryList,Diff):-
   get_type(const(Number),NumType),
   type_compatible(NumType,number),
   column_atom(Number,QueryList,Diff).

column_atom(comp(LeftArg,Operator,RightArg),QueryList,Diff):-
   column_atom(LeftArg,QueryList,X1),
   column_atom(' ',X1,X2),
   column_atom(Operator,X2,X3),
   column_atom(' ',X3,X4),
   column_atom(RightArg,X4,Diff).

column_atom(LeftExpr * RightExpr,QueryList,Diff):-
   column_atom(LeftExpr,QueryList,X1),
   column_atom('*',X1,X2),
   column_atom(RightExpr,X2,Diff).

column_atom(LeftExpr + RightExpr,QueryList,Diff):-
   column_atom(LeftExpr,QueryList,X1),
   column_atom('+',X1,X2),
   column_atom(RightExpr,X2,Diff).

column_atom(LeftExpr - RightExpr,QueryList,Diff):-
   column_atom(LeftExpr,QueryList,X1),
   column_atom('-',X1,X2),
   column_atom(RightExpr,X2,Diff).

column_atom(LeftExpr / RightExpr,QueryList,Diff):-
   column_atom(LeftExpr,QueryList,X1),
   column_atom('/',X1,X2),
   column_atom(RightExpr,X2,Diff).

column_atom(agg_query(Function,Select,From,Where,Group),QueryList,Diff):-
   column_atom('(',QueryList,X1),
   query_atom(agg_query(Function,Select,From,Where,Group),X1,X2),
   column_atom(')',X2,Diff).

column_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff):-
  
query_atom(negated_existential_subquery(Select,From,Where),QueryList,Diff).


column_atom(Atom,List,Diff):-
   atom(Atom),
   name(Atom,X1),
   append(X1,Diff,List).






% --- benchmarks of sample queries
--------------------------------------------
%
% benchmark(N,No,Duration) runs the query No N times and returns the
runtime
%
% To run each benchmark once, enter ?- benchmark(1,No,D). and type ; after
% a solution has been returned.
%
%
-----------------------------------------------------------------------------

benchmark(N,1,D):-
   cpu_time(N,
     (translate(flight(No,Dep,Dest,Type),flight(No,Dep,Dest,Type),Code),
	  printqueries(Code)),
   D).

benchmark(N,2,D):-
   cpu_time(N,
     (translate(capacity(No,Dep,Dest,Type,Seats),
	    (flight(No,Dep,Dest,Type),
		 plane(Type,Seats),
		 Type='b-737'),Code),
	   printqueries(Code)),
   D).

benchmark(N,3,D):-
   cpu_time(N,
      (translate(no_planes(No,Dep,Dest,Type),
	      (flight(No,Dep,Dest,Type),
		   not plane(Type,Seats)),Code),
	   printqueries(Code)),
	D).

benchmark(N,4,D):-
   cpu_time(N,(translate(X,X is
count(S,plane(P,S)),Code),printqueries(Code)),D).

benchmark(N,5,D):-
   cpu_time(N,
      (translate(big_planes(munich,Dest,Type,Seats),
	      FNo^(flight(FNo,munich,Dest,Type),
		       plane(Type,Seats),
			   Seats > avg(S, T^plane(T,S))),Code),
	  printqueries(Code)),
   D).

benchmark(N,6,D):-
   cpu_time(N,(
     translate(big_planes(munich,Dest,Type,Seats),
	     FNo^(flight(FNo,munich,Dest,Type),
		      plane(Type,Seats),
			  Seats > avg(S, T^plane(T,S))),Code),
		 printqueries(Code)),
   D).

benchmark(N,7,D):-
   cpu_time(N,(
     translate(big_planes(munich,Dest,Type,Seats),
	     FNo^(flight(FNo,munich,Dest,Type),
		      plane(Type,Seats),
			  Seats > avg(S, T^plane(T,S))),Code),
		 queries_atom(Code,SQLQueryAtom),
		 writeq(query_atom(SQLQueryAtom)),
		 nl),
   D).




% --- gensym(Root,Symbol)
----------------------------------------------------
%
% SEPIA 3.0.7. version - other Prolog implementations provide gensym/2
% and init_gensym/1 as built-ins. */
%
% (C) Christoph Draxler, Aug. 1992
%
% 

gensym(Root,Symbol):-
   not var(Root),
   var(Symbol),

   incval(Root),
   getval(Root,Counter),

   % --- create char list of root and counter ---
   name(Root,RootList),
   name(Counter,CounterList),

   % --- append RootList and CounterList ---
   append(RootList,CounterList,SymbolList),

   % --- create atom from SymbolList ---
   name(Symbol,SymbolList).


init_gensym(Root):-
   not var(Root),
   setval(Root,0).



% --- auxiliary predicates
-----------------------------------------------------
%
% Some Prologs have Bem, some donBt. 
%
%
------------------------------------------------------------------------------

append([],L,L).
append([H1|L1],L2,[H1|L3]):-
   append(L1,L2,L3).



member(X,[X|_]).
member(X,[_|T]):-
   member(X,T).



repeat_n(N):-
   integer(N),
   N > 0,
   repeat_1(N).

repeat_1(1):-!.
repeat_1(_).
repeat_1(N):-
   N1 is N-1,
   repeat_1(N1).



% --- benchmark programs for translation of database goals ---------------
%
% taken from R. O'Keefe: The Craft of Prolog, MIT Press 1990
%
% Sepia Prolog version

cpu_time(Time):-
   cputime(Time).


cpu_time(Goal,Duration):-
   !,
   cputime(T1),
   (call(Goal) -> true; true),
   cputime(T2),
   Duration is T2 - T1.

cpu_time(N,Goal,Duration):-
   !,
   cpu_time((repeat_n(N),(Goal -> fail);true),D1),
   cpu_time((repeat_n(N),(true -> fail);true),D2),
   Duration is D1 - D2.



% --- set_difference(SetA,SetB,Difference)
--------------------------------------------
%
% SetA - SetB = Difference

set_difference([],_,[]).

set_difference([Element|RestSet],Set,[Element|RestDifference]):-
   not member(Element,Set),
   set_difference(RestSet,Set,RestDifference).

set_difference([Element|RestSet],Set,RestDifference):-
   member(Element,Set),
   set_difference(RestSet,Set,RestDifference).




% --- Meta Database for schema definition of SQL DB in Prolog
--------------------------
%
% maps Prolog predicates to SQL table names, Prolog predicate argument
positions to SQL
% attributes, and Prolog operators to SQL operators. 
%
% ATTENTION! It is assumed that the arithmetic operators in Prolog and SQL
are the same,
% i.e. + is addition in Prolog and in SQL, etc. If this is not the case,
then a mapping
% function for arithmetic operators is necessary too.
%
% CHANGE THIS TO MEET YOUR DATABASE SCHEMA!
%
%
--------------------------------------------------------------------------------------


% --- relation(PrologFunctor,Arity,SQLTableName)
---------------------------------------

relation(flight,4,'FLIGHT').
relation(plane,2,'PLANE').


% --- attribute(PrologArgumentPosition,SQLTableName,SQLAttributeName)
------------------

attribute(1,'FLIGHT','FLIGHT_NO',string).
attribute(2,'FLIGHT','DEPARTURE',string).
attribute(3,'FLIGHT','DESTINATION',string).
attribute(4,'FLIGHT','PLANE_TYPE',string).


attribute(1,'PLANE','TYPE',string).
attribute(2,'PLANE','SEATS',integer).


% --- Mapping of Prolog operators to SQL operators
-------------------------------------

comparison(=,=).
comparison(<,<).
comparison(>,>).
comparison(@<,<).
comparison(@>,>).


negated_comparison(=,'<>').
negated_comparison(\=,=).
negated_comparison(>,=<).
negated_comparison(=<,>).
negated_comparison(<,>=).
negated_comparison(>=,<).


% --- aggregate_function(PrologFunctor,SQLFunction) -----------------

aggregate_functor(avg,'AVG').
aggregate_functor(min,'MIN').
aggregate_functor(max,'MAX').
aggregate_functor(sum,'SUM').
aggregate_functor(count,'COUNT').



% --- type system
--------------------------------------------------------------
%
% A rudimentary type system is provided for consistency checking during the
% translation and for output formatting
%
% The basic types are string and number. number has the subtypes integer
and
% real.
%
%
------------------------------------------------------------------------------


type_compatible(Type,Type):-
   is_type(Type).
type_compatible(SubType,Type):-
   subtype(SubType,Type).
type_compatible(Type,SubType):-
   subtype(SubType,Type).


% --- subtype(SubType,SuperType)
-----------------------------------------------
%
% Simple type hierarchy checking
%
%
------------------------------------------------------------------------------

subtype(SubType,SuperType):-
   is_subtype(SubType,SuperType).

subtype(SubType,SuperType):-
   is_subtype(SubType,InterType),
   subtype(InterType,SuperType).



% --- is_type(Type)
------------------------------------------------------------
%
% Type names
%
%
------------------------------------------------------------------------------

is_type(number).
is_type(integer).
is_type(real).
is_type(string).
is_type(natural).


% --- is_subtype(SubType,SuperType)
--------------------------------------------
%
% Simple type hierarchy for numeric types
%
%
------------------------------------------------------------------------------

is_subtype(integer,number).
is_subtype(real,number).
is_subtype(natural,integer).


% --- get_type(Constant,Type)
--------------------------------------------------
%
% Prolog implementation specific definition of type retrieval
% sepia Prolog version given here
%
%
------------------------------------------------------------------------------

get_type(const(Constant),integer):-
   number(Constant).

get_type(const(Constant),string):-
   atom(Constant).
Technical Details
Message-ID: <draxler-221292135550@mac_server.cis.uni-muenchen.de>
Path: arc1-ca.pugleaf.net!sparky!uunet!dtix!darwin.sura.net!jvnc.net!yale.edu!ira.uka.de!fauern!lrz-muenchen.de!mac_server.cis.uni-muenchen.de!user

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!sparky!uunet!dtix!darwin.sura.net!jvnc.net!yale.edu!ira.uka.de!fauern!lrz-muenchen.de!mac_server.cis.uni-muenchen.de!user
From: draxler@cis.uni-muenchen.de (Christoph Draxler)
Newsgroups: comp.lang.prolog
Subject: Prolog to SQL compiler v. 1.1 (part 2/2)
Message-ID: <draxler-221292135550@mac_server.cis.uni-muenchen.de>
Date: 22 Dec 92 12:50:31 GMT
Sender: news@news.lrz-muenchen.de (Mr. News)
Followup-To: comp.lang.prolog
Organization: CIS - Centrum fuer Informations- und Sprachverarbeitung
Lines: 687