🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Thread View: comp.lang.prolog
1 messages
1 total messages Started by Christoph Draxler Tue, 22 Dec 1992 12:50
Prolog to SQL compiler v. 1.1 (part 2/2)
#2160
Author: 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).
Thread Navigation

This is a paginated view of messages in the thread with full content displayed inline.

Messages are displayed in chronological order, with the original post highlighted in green.

Use pagination controls to navigate through all messages in large threads.

Back to All Threads