[comp.lang.prolog] Clause fusion

ok@quintus.UUCP (Richard A. O'Keefe) (05/16/88)

Recently someone asked me a question about the capabilities of the
Quintus Prolog compiler.  There was a fairly obvious optimisation,
and he wondered whether the compiler did it or whether he would be
rewarded with a speedup if he rewrote the code himself.  My answer
was that the compiler *doesn't* do this optimisation.  I think it
may be of interest to this newsgroup to see what the question was
and why an incremental Prolog compiler *can't* do the optimisation.
I hope we'll get some discussion about what conditions *would*
permit the optimisation, and how a compiler can check them.

The original code was

	association(Stack, Key, Val, absent) :-
		is_empty(Stack),
		!.
	association(Stack, Key, Val, Result) :-
		pop_stack(Key1, Val1, Stack, Stack1),
		Key1 \== Key,
		!,
		association(Stack1, Key, Val, Result).
	association(Stack, Key, Val, present) :-
		pop_stack(Key1, Val1, Stack, Stack1),
		Key1 == Key,
		Val1 = Val,
		!.
	association(Stack, Key, Val, conflict).


The revised code was

	assocation(Stack, Key, Val, absent) :-
		is_empty(Stack),
		!.
	association(Stack, Key, Val, Result) :-
		pop_stack(Key1, Val1, Stack, Stack1),
		(   Key1 \== Key ->
		    association(Stack1, Key, Val, Result)
		;   Val1 = Val ->
		    Result = present
		;   Result = conflict
		).

The question was whether the Quintus Prolog compiler was smart enough
to perform this optimisation.  The answer is that it isn't.

Why not?

The answer is simple:  the two versions of the code are not equivalent.
Amongst other things, the query assocation(S,K,V,conflict) will always
succeed for the first version (the predicate is not steadfast).

Let's avoid questions of soundness by supposing that Stack, Key, and
Val are always ground, and that pop_stack/4 always returns ground
values for Key1, Val1, and Stack1, and let's avoiding questions of
steadfastness by supposing that association/4 is always called with
its last argument a variable.  Let's assume that is_empty is trivial:
	is_empty(empty).
The two versions *still* aren't equivalent.

Suppose pop_stack/4 is defined thus:
	pop_stack(K, V, stack(K,V,S), S) :-
		write('pop_stack/4 called'), nl.
and suppose that we call
	| ?- association(stack(a,1,empty), a, 2, Result).

Then the first version will print "pop_stack/4 called" twice, while the
second version will print it only once.

Suppose that the compiler has processed the definition of pop_stack/4
and knows that it is free of side effects.  [In the absence of call/1,
this is trivially easy to determine.]  The two versions *still* aren't
equivalent.

Suppose pop_stack/4 is defined thus:
	pop_stack(K, V, stack(K,V,S), S).
	pop_stack(K, V, stack(J,U,S1), stack(J,U,S2)) :-
		pop_stack(K, V, S1, S2).

Then the query
	| ?- association(stack(a,1,stack(a,2,empty)), a, 2, X).
will report X=present if the first version is called, but
will report X=conflict if the second version is called.

In this particular case, I think it suffices to know that pop_stack/4
is both side-effect-free and determinate.  In general, even that isn't
enough; the main predicate may still have the same solutions after
this optimisation, but they may not be found in the same order.  It
seems that we need a weaker notion of equivalence than is usual in
programming languges: in order to perform optimisations like this
automatically a compiler needs to be licensed to treat predicates
according to their declarative reading rather than according to the
strict behaviour of a Prolog interpreter.  (This is not unlike
allowing a Fortran compiler to pretend that X+Y+Z = Y+Z+X in
Fortran, it _isn't_ but it _ought_ to be (:-).)

debray@arizona.edu (Saumya Debray) (05/17/88)

In article <983@cresswell.quintus.UUCP>, Richard A. O'Keefe writes
about the "obvious" optimization of clause fusion:

> The original code was
> 
> 	association(Stack, Key, Val, absent) :-
> 		is_empty(Stack),
> 		!.
> 	association(Stack, Key, Val, Result) :-
> 		pop_stack(Key1, Val1, Stack, Stack1),
> 		Key1 \== Key,
> 		!,
> 		association(Stack1, Key, Val, Result).
> 	association(Stack, Key, Val, present) :-
> 		pop_stack(Key1, Val1, Stack, Stack1),
> 		Key1 == Key,
> 		Val1 = Val,
> 		!.
> 	association(Stack, Key, Val, conflict).

Richard points out several problems with a proposed solution.  It
turns out, however, that the problems are not with Clause Fusion itself,
but rather with some subsequent transformations involving moving cuts
around a clause.  It shouldn't be surprising that this is not an easy
thing to do in general.

It's interesting to transform this code a little at a time, to
see what assumptions are necessary at each step in order to preserve
equivalence.  To reduce clutter as far as possible in what follows,
I'll consider only the clauses that Richard fused, and ignore the first
clause in this definition.
--------------------
STEP 1: No assumptions: all we can do is move some arguments
from the head to just beyond the neck of the clause, to get:

 	association(Stack, Key, Val, Result) :-
 		(pop_stack(Key1, Val1, Stack, Stack1),
 		 Key1 \== Key,
 		 !,
 		 association(Stack1, Key, Val, Result)
		) ;
	     (Result = present,	  		     
 		 pop_stack(Key1, Val1, Stack, Stack1),
 		 Key1 == Key,
 		 Val1 = Val,
 		 !
		) ;
		Result = conflict.
--------------------
STEP 2: Assume that association/4 is always called with its
last argument free.  This allows us to delay the unification
"Result = present" in the second disjunct, to get the disjuncts:

   (pop_stack( ... ), Key1 \== Key, ... ) ;
   (pop_stack( ... ), Key1 == Key, Val1 = Val, !, Result = present) ;
   Result = conflict.
--------------------
STEP 3: Assume pop_stack/4 is free of side effects.  This allows us to
factor the literal for pop_stack/4 in the disjunct, producing

 	association(Stack, Key, Val, Result) :-
          (pop_stack(Key1, Val1, Stack, Stack1),
 		 (Key1 \== Key,
 		  !,
 		  association(Stack1, Key, Val, Result)
		 ) ;
	      ( /* Key1 == Key, */
 		  Val1 = Val,
 		  !
            Result = present
		 )			
          ) ;
          Result = conflict.

We can't do much more at this point.  Note that the inner disjunction
can't really be converted to an if-then-else, because the cut is necessary
to cut away the alternative "Result = conflict" in the outer disjunct.
Notice also that even if pop_stack/4 is known to be deterministic, we can't
transform this to

	   pop_stack( ... ) ->
	        ( ... ) ;
		   Result = conflict.

(Consider the case where pop_stack/4 succeeds, "Key1 \== Key" fails, and
 "Val1 = Val" fails.)
--------------------
STEP 4: Richard assumed, in addition, that association/4 is always called
with its first three arguments ground terms.  Looking at the code, it seems
to me that the predicate is intended to search a (given) stack for a value
associated with a (given) key, so I think it's more reasonable to assume
that the third argument to association/4 is also free in each call to it.
If we make this assumption, then the unification "Val1 = Val" (after
"Key1 == Key") can also be delayed until after the cut.  This transforms
the inner disjunct to

	   	  (Key1 \== Key, !, association( ... ) ) ;
	   	  (!, Val1 = Val, Result = present)

This, with some easy massaging, yields

 	association(Stack, Key, Val, Result) :-
          (pop_stack(Key1, Val1, Stack, Stack1),
 		 (Key1 \== Key ->
 		     association(Stack1, Key, Val, Result) ;
			(Val1 = Val,
                Result = present
			)
		 ),
		 !
          ) ;
          Result = conflict.
--------------------
STEP 5: Assume that association/4 is deterministic.  This allows us to
bubble the cut backwards, eventually yielding

 	association(Stack, Key, Val, Result) :-
          (pop_stack(Key1, Val1, Stack, Stack1),
		 !,
 		 (Key1 \== Key ->
 		     association(Stack1, Key, Val, Result) ;
			(Val1 = Val,
                Result = present
			)
		 )
          ) ;
          Result = conflict.

It's now a simple matter to reformat this to

 	association(Stack, Key, Val, Result) :-
        pop_stack(Key1, Val1, Stack, Stack1) ->
		 (Key1 \== Key ->
 		     association(Stack1, Key, Val, Result) ;
			(Val1 = Val,
                Result = present
			)
		 ) ;
           Result = conflict.
--------------------
[ If we don't want to assume that association/4 is always called with
  its third argument uninstantiated, then different (and, in my opinion,
  less reasonable) assumptions are necessary to take the transformation
  beyond step 3 above.  This article's getting too long for that. ]

The resulting code is seen to be quite different from the proposed

> 	association(Stack, Key, Val, Result) :-
> 		pop_stack(Key1, Val1, Stack, Stack1),
> 		(   Key1 \== Key ->
> 		    association(Stack1, Key, Val, Result)
> 		;   Val1 = Val ->
> 		    Result = present
> 		;   Result = conflict
> 		).

To sum up: the problems mentioned by Richard are not with clause fusion
per se, but rather with some subsequent transformations involving 
moving cuts around a clause.  Not surprisingly, this is nontrivial
in general.
-- 
Saumya Debray		CS Department, University of Arizona, Tucson

     internet:   debray@arizona.edu
     uucp:       {allegra, cmcl2, ihnp4} !arizona!debray

debray@arizona.edu (Saumya Debray) (05/17/88)

In article <983@cresswell.quintus.UUCP>, Richard A. O'Keefe writes,
regarding the obvious optimization of "clause fusion":

> In general ... the main predicate may still have the same solutions
> after this optimisation, but they may not be found in the same order.

I'm not sure I see that.  Clause fusion is simply the transformation of
a pair of clauses of the form

	   p( Args ) :- Body1.
	   p( Args ) :- Body2.

where both clauses have the identical argument tuple in the head, to

	   p( Args ) :- Body1 ; Body2.

Note: it's enough to have the argument tuples in the head subsume
each other, i.e. be alphabetic variants, but then renaming may be
necessary before the fusion step.

Now assuming that the search strategy remains the same, the only way to
change the order of solutions found is to change the shape of the (ordered)
SLD-tree.  As far as I can see, there are only two ways of doing this:
either change the order of clauses for some predicate, or change the
order of literals in some clause.  Comments:

(1) Clause fusion has nothing to say about reordering clauses or literals:
    you can fuse clauses without doing any reordering; and you can reorder
    without doing any fusing.  The two transformations are orthogonal in
    general.

(2) Reordering clauses and literals is MESSY!  In the general case, you
    have to worry about termination issues -- probably not the sort
    of thing a compiler would like to get involved with.  Notice that
    even if we're given two literals
    
	       	   		 p(X), q(Y)

    that are guaranteed to be independent, we can't reorder them in
    general (consider the case where p fails and q loops).  Even if
    termination is guaranteed, you have to worry about side effects and
    metalanguage features like var/1, nonvar/1, ==/2, etc.  Finally,
    as Richard pointed out, there's the problem of order of solutions.
    There are, of course, special cases that one can try to identify,
    such as deterministic predicates that are guaranteed to terminate.
    E.g., suppose p/1 is a deterministic predicate, then
    
    	   Lits1, p(Arg), !, Lits2

    is equivalent to

    	   Lits1, !, p(Arg), Lits2.
-- 
Saumya Debray		CS Department, University of Arizona, Tucson

     internet:   debray@arizona.edu
     uucp:       {allegra, cmcl2, ihnp4} !arizona!debray

debray@arizona.edu (Saumya Debray) (05/17/88)

In article <5502@megaron.arizona.edu>, I wrote:

>     E.g., suppose p/1 is a deterministic predicate, then
>     
>     	   Lits1, p(Arg), !, Lits2
> 
>     is equivalent to
> 
>     	   Lits1, !, p(Arg), Lits2.

This statement, made in a moment of optimism, is of course false.  There
are at least two reasons for this:

(i) suppose p/1 is defined as
	   
	   p(a).
	   p(X) :- p(f(X)).

    Then p/1 generates at most one solution to any query, and hence is
    deterministic.  The goal
    
    	   ?- p(X), !, fail.

    clearly doesn't behave the same way as
   
   	   ?- !, p(X), fail.

(ii) In

 	   Lits1, p(X), !, Lits2
	   
	choice points for  Lits1  are discarded only _after_ p/1 succeeds; in
	
	   Lits1, !, p(X), Lits2

    choice points for Lits2 are discarded _before_ p/1 is executed.  This
    can cause a difference in behavior if Lits1 generates more than one
    solution, and p/1 fails the first time through.

Sorry about that.
-- 
Saumya Debray		CS Department, University of Arizona, Tucson

     internet:   debray@arizona.edu
     uucp:       {allegra, cmcl2, ihnp4} !arizona!debray

lee@mulga.oz (Lee Naish) (05/17/88)

In article <983@cresswell.quintus.UUCP> ok@quintus.UUCP (Richard A. O'Keefe) writes:
>in order to perform optimisations like this
>automatically a compiler needs to be licensed to treat predicates
>according to their declarative reading rather than according to the
>strict behaviour of a Prolog interpreter.

NU-Prolog allows procedures to be declared "pure" for precisely this
reason.  One of the problems with Prolog as a logic programming language
is that it is impossible to avoid over-specification when writing a
program.  Whatever logic you write also has a fixed procedural
interpretation.  This means that even with very smart compilers,
parallel machines etc, the scope for optimization is quite limited.
It also means that programmers must consider the control component of
their programs.

Logical NU-Prolog constructs normally have both declarative and
procedural meanings: "A;B" means "A or B" declaratively and "execute A
and, on backtracking, execute B" procedurally.  If a procedure is
declared pure, only the declarative meaning is defined.  Currently, the
transformations done by the compiler are quite simple.  However, the
compiler can be extended and the declarations can be used for other
tools which transform programs (eg, adding control information, magic
sets, fold/unfold,...).

One of the problems with the idea is that we cant have 100% confidence
in such a system.  The undecidability of the halting problem means that
no matter how smart logic programming systems are, programmers will
still need to consider procedural factors in some cases.  I think the
difference between logic programming and automated theorem proving is
that in logic programming, programmers are responsible for infinite
loops.

	Lee Naish

anjo@swivax.UUCP (Anjo Anjewierden) (05/18/88)

The two programs presented in the original "clause fusion" posting
are different and it does not make much sense to talk about one being
the optimisation of the other.  I propose to consider the revised
and optimized version of the program as the one for study:

	%  Optimised program.

        assocation(Stack, Key, Val, absent) :-
                is_empty(Stack),
                !.
        association(Stack, Key, Val, Result) :-
                pop_stack(Key1, Val1, Stack, Stack1),
                (   Key1 \== Key ->
                    association(Stack1, Key, Val, Result)
                ;   Val1 = Val ->
                    Result = present
                ;   Result = conflict
                ).

The program suffers from clause fusion.  Given a personal
interpretation of the program's intended purpose I would
write it down like this (note that I'm not too fuzzy about
the groundedness of variables):

	%  Human-readable program.

	association( Stack,Key,Val,absent ) :-
		is_empty( Stack ), !.
	association( Stack,Key,Val,Result ) :-
		pop_stack( Key1,Val1,Stack,Stack1 ),
		assoc_test( Key,Key1,Val,Val1,Stack1,Result ).

	assoc_test( Key,Key,Val,Val,_,present ) :- !.
	assoc_test( Key,Key,_,_,_,conflict ) :- !.
	assoc_test( Key,_,Val,_,Stack,Result ) :-
		association( Stack,Key,Val,Result ).

If my interpretation of when the program should say "present" or
"conflict" is incorrect then the author can rewrite the clauses for
assoc_test/6 as necessary.

[[ If you feel that the "human-readable" version is not human-readable
   at all, or that the "optimized" version is more human-readable, then
   by all means flame. ]]

If we agree that these two programs are functionally equivalent,
we can ask two questions:

	a) Is the human-readable program really slower than
	   the optimized one?

	b) Given that the optimized program is faster, can
	   a Prolog compiler generate the optimized program
	   from the human-readable program?

I benchmarked both versions with Quintus Prolog, C-Prolog 1.5 and a
custom WAM based Prolog compiler.  The benchmarks were performed with
the following definitions (from original posting):

	pop_stack( K,V,stack(K,V,S),S ).
	pop_stack( K,V,stack(J,U,S1),stack(J,U,S2) ) :-
		pop_stack( K,V,S1,S2 ).

	is_empty(empty).

And the following goal:

	loop( 0 ).
	loop( N ) :-
		association( stack(a,1,stack(a,2,empty)),a,2,X ),
		NewN is N-1,
		loop( NewN ).

These are the results for: loop(1000). Times are in seconds after
subtracting the cost of the loop, by replacing assoc... by true.
All on a Sun-3/75 with 12Mb:

			"Optimized"	"Human-Readable"

Quintus Prolog 2.0:	2.5		2.5	(interpreted)
Quintus Prolog 2.0:	0.6		0.6	(compiled)
C-Prolog 1.5:		2.6		1.3
Custom WAM:		1.9		0.9

My conclusions are as follows:

1) The "human-readable" program is not slower than the "optimized" one
   for the Prolog implementations I tested this on.

2) Quintus Prolog seems to generate better code for the ; and -> constructs,
   than the two other Prolog's.  It would be interesting to hear
   about a Prolog for which the optimized version is significantly
   faster than the human-readable one.

3) Clause fusion sometimes results in slower programs, and is
   therefore not a generally useful technique for optimizing Prolog programs.

micha@ecrcvax.UUCP (Micha Meier) (05/19/88)

Actually I don't want to contribute to this very topic, Saumya has analyzed
it in detail. What I'm concerned with is the indentation of disjunctions.
Two forms which were presented are
>
> 	association(Stack, Key, Val, Result) :-
>        pop_stack(Key1, Val1, Stack, Stack1) ->
>		 (Key1 \== Key ->
> 		     association(Stack1, Key, Val, Result) ;
>			(Val1 = Val,
>                Result = present
>			)
>		 ) ;
>           Result = conflict.
>--------------------
>
>
>> 	association(Stack, Key, Val, Result) :-
>> 		pop_stack(Key1, Val1, Stack, Stack1),
>> 		(   Key1 \== Key ->
>> 		    association(Stack1, Key, Val, Result)
>> 		;   Val1 = Val ->
>> 		    Result = present
>> 		;   Result = conflict
>> 		).

I find the two unreadable - what is the best way to indent the disjunctions
so that the resulting clause is easy to read and understand?

The general form of an if-then-else construct in a clause is

	p :-
		a, b, c,
		((q, r, s) -> (t, u, v);(w, x, y)),
		d, e, f.

Some of the parentheses can be omitted, but should they?
Richard proposes that nested if-then-else's are treated at the same level,
which leads to confusions since then the indentation is context dependent
(an if-then-else inside another one cannot be indented independently).
I have tried several variants, I have also seen various programs from
other people but I'm still searching. Isn't this problem a topic
for the standardization committee? The way if-then-else's and disjunctions
are written influences greatly the readability of the programs, if you
do it the wrong way round it's almost guaranteed that no-one will
notice any 'declarative meaning' of the program.

--Micha

ok@quintus.UUCP (Richard A. O'Keefe) (05/20/88)

In article <532@swivax.UUCP>, anjo@swivax.UUCP (Anjo Anjewierden) writes:
:         assocation(Stack, Key, Val, absent) :-
:                 is_empty(Stack),
:                 !.
:         association(Stack, Key, Val, Result) :-
:                 pop_stack(Key1, Val1, Stack, Stack1),
:                 (   Key1 \== Key ->
:                     association(Stack1, Key, Val, Result)
:                 ;   Val1 = Val ->
:                     Result = present
:                 ;   Result = conflict
:                 ).
: 
: 	%  Human-readable program.
: 
: 	association( Stack,Key,Val,absent ) :-
: 		is_empty( Stack ), !.
: 	association( Stack,Key,Val,Result ) :-
: 		pop_stack( Key1,Val1,Stack,Stack1 ),
: 		assoc_test( Key,Key1,Val,Val1,Stack1,Result ).
: 
: 	assoc_test( Key,Key,Val,Val,_,present ) :- !.
: 	assoc_test( Key,Key,_,_,_,conflict ) :- !.
: 	assoc_test( Key,_,Val,_,Stack,Result ) :-
: 		association( Stack,Key,Val,Result ).
: 
: If we agree that these two programs are functionally equivalent,
: we can ask two questions:

To the best of my belief I am human, and I think *both* versions are
readable.  (Why would anyone who puts *extra* space with parentheses
leave out the space which normally follows commas in punctuation?
Jamming the arguments into one black blob -vs- separating them clearly
is a much bigger readability issue to me than if-then-else -vs- several
clauses.  But I repeat, both versions can be read.)

However, the two versions are *NOT* equivalent!  If we call
	association({...key->val...}, key, val, conflict)
the first version will fail (because key==key and val=val) but the
second version will succeed.  That is to say (assuming that is_empty/1
and pop_stack/4 cannot both succeed for the same instantiated Stack)
the first version is _steadfast_ and the second isn't.  They are not
identical for another reason:  the first version uses == for key
comparison, and the second uses = .

Which version is faster depends entirely on whether the Prolog implementor
in question has chosen to put some work into if-then-elses or not.  I may
tend to over-use if-then-elses these days, but I like their transparent
honesty.  The fact that the "obvious" code using if-then-else was
steadfast and the "obvious" code using cuts wasn't would be a good reason
to prefer if-then-elses even if they were slower.

ok@quintus.UUCP (Richard A. O'Keefe) (05/20/88)

In article <539@ecrcvax.UUCP>, micha@ecrcvax.UUCP (Micha Meier) writes:
> Richard proposes that nested if-then-else's are treated at the same level,
> which leads to confusions since then the indentation is context dependent
> (an if-then-else inside another one cannot be indented independently).

I DO NOT!  I use exactly the same rule for indenting if->then;elses in
Prolog that I use in Fortran 77, Pop, ADA, Algol 68, et cetera.  Namely

	<IF> <condition> <THEN>
	[1 indent] <body>
	<ELIF> <condition> <THEN>
	[1 indent] <body>
	...
	<ELSE>
	[1 indent] <body>
	<ENDIF>

Fortran 77          Pop               Algol 68       Algol 68   Prolog
IF (...) THEN       if ... then       if ... then    (  ... |   ( ... ->
ELSE IF (...) THEN  elseif ... then   elif ... then  |: ... |   ; ... ->
ELSE                else              else           |:         ;
END IF              close             fi             )          )

This style is officially recommended for ADA.

I think of and perceive
	( test1 ->
	    body1
	; test2 ->
	    body2
	; /*otherwise*/
	    body3
	)
as if-then-else structure, not two.  There is no nesting here (unless
one of test1, body1, test2, body2, body3 contains an if-then-else).
Ok, there are nested terms, but do you also regard (a,b,c) as nested
conjunctions?  It could be indented as two structures, but why go out
of your way to spread the code across the page?  Note that this approach
puts the semicolons at the beginning of the lines, where it is difficult
to mistake them for commas.

> Isn't this problem a topic for the standardization committee?

Not the committee we've got.  To be perfectly frank, I'll defend my style
with teeth and nails, if necessary, but there are enough competent Prolog
people out there with styles different from mine (such as Saumya Debray)
who use a very different style that I would not like to see my layout
rules become part of a standard.  It isn't hard to write an 'indent'
utility for Prolog, so while I find Debray's layout, um, unfamiliar,
that doesn't stop me reading his code _as if_ he had used my style.

What we need from the committee is a sufficiently clear and concise
definition of a large enough language with enough attention to
portability concerns that I could develop a public-domain version of a
Prolog indenter in Prolog on a Sun and expect it to work on a Mac and a
370 with very little change.  I do not believe that we shall get this.

micha@ecrcvax.UUCP (Micha Meier) (05/25/88)

In article <1001@cresswell.quintus.UUCP> ok@quintus.UUCP (Richard A. O'Keefe) writes:
>In article <539@ecrcvax.UUCP>, micha@ecrcvax.UUCP (Micha Meier) writes:
>> Richard proposes that nested if-then-else's are treated at the same level,
>> which leads to confusions since then the indentation is context dependent
>> (an if-then-else inside another one cannot be indented independently).
>
>I DO NOT!  I use exactly the same rule for indenting if->then;elses in
>Prolog that I use in Fortran 77, Pop, ADA, Algol 68, et cetera.  Namely
>
>	<IF> <condition> <THEN>
>	[1 indent] <body>
>	<ELIF> <condition> <THEN>
>	[1 indent] <body>
>	...
>	<ELSE>
>	[1 indent] <body>
>	<ENDIF>
>
	The problem with Prolog is that any of the term can be
	a conjunction, disjunction or if-then-else. What about

	(	(	C1 ->
			B1
		;
			B2
		) ->
		(	C2 ->
			B3
		;
			B4
		),
		B5
	;	B6,
		B7
	)

	I find it not much readable when the condition is difficult
	to distinguish from the other code.

>	( test1 ->
>	    body1
>	; test2 ->
>	    body2
>	; /*otherwise*/
>	    body3
>	)

	Here it is different - how exactly do you indent your procedures?
	This problem might seem to be a minor one, but should not there
	be at least a recommendation from the standard or from somebody
	else? Prolog does not have many syntactical structures and therefore
	it is extremely important to keep some programming style, e.g.
	to use names_like_that for procedures and LikeThat for variables,
	to put each goal on a separate line etc. I've been trying to
	port various external programs to Sepia and sometimes it's rather
	difficult to realize what the author really meant.

--Micha

ok@quintus.UUCP (Richard A. O'Keefe) (05/27/88)

In article <548@ecrcvax.UUCP>, micha@ecrcvax.UUCP (Micha Meier) writes:
> 	The problem with Prolog is that any of the term(s in an if->then;else)
>	can be a conjunction, disjunction or if-then-else.  What about
>       (   (   C1 ->
>               B1
>           ;
>               B2
>           ) ->
>           (   C2 ->
>               B3
>           ;
>               B4
>           ),
>           B5
> 	;   B6,
>           B7
> 	)
Algol 60, Algol 68, Lisp, Pop, Bourne shell, C shell, ML, ... have
exactly the same problem.  There's nothing special about Prolog in this
respect.  The answer is that it isn't a problem to have another if in a
then-part or else-part, and that programmers who care about readability
don't put ifs in if-parts.  The big lesson for Prolog programmers is
"don't be scared of introducing new predicates". Programmers who do not
care about readability will find obfuscatory ways despite standards.
(The famous "Indian Hills style sheet" for C has led to some of the most
unreadable C code it has ever been my misfortune to try to read.)

I basically agree with Meier's concern for readability.  But I think the
layout of the Prolog code as such is not the most important aspect.  It
is easy to write a reformatter (the editor I'm using to write this has one).
You can fix what is there, the trouble is what _isn't_ there.  I have
recently had occasion to look at two people's programs.  One of them
I repeatedly misunderstood because it was doing some very tricky things
in its control flow and had essentially no comments.  The other I still
do not understand because it is doing non-obvious things with its data
structures and has essentially no comments.

Rules of thumb for comments:
(1) Describe all major data structures.
(2) Comment every control trick.

mccaugh@uiucdcsm.cs.uiuc.edu (05/28/88)

/* Written  3:43 am  May 25, 1988 by micha@ecrcvax.UUCP in uiucdcsm:comp.lang.prolog */
/* ---------- "Re: Clause fusion (Disjunctions)" ---------- */
In article <1001@cresswell.quintus.UUCP> ok@quintus.UUCP (Richard A. O'Keefe) writes:
>In article <539@ecrcvax.UUCP>, micha@ecrcvax.UUCP (Micha Meier) writes:
>> Richard proposes that nested if-then-else's are treated at the same level,
>> which leads to confusions since then the indentation is context dependent
>> (an if-then-else inside another one cannot be indented independently).
>
>I DO NOT!  I use exactly the same rule for indenting if->then;elses in
>Prolog that I use in Fortran 77, Pop, ADA, Algol 68, et cetera.  Namely
>
>	<IF> <condition> <THEN>
>	[1 indent] <body>
>	<ELIF> <condition> <THEN>
>	[1 indent] <body>
>	...
>	<ELSE>
>	[1 indent] <body>
>	<ENDIF>
>
	The problem with Prolog is that any of the term can be
	a conjunction, disjunction or if-then-else. What about

	(	(	C1 ->
			B1
		;
			B2
		) ->
		(	C2 ->
			B3
		;
			B4
		),
		B5
	;	B6,
		B7
	)

	I find it not much readable when the condition is difficult
	to distinguish from the other code.

>	( test1 ->
>	    body1
>	; test2 ->
>	    body2
>	; /*otherwise*/
>	    body3
>	)

	Here it is different - how exactly do you indent your procedures?
	This problem might seem to be a minor one, but should not there
	be at least a recommendation from the standard or from somebody
	else? Prolog does not have many syntactical structures and therefore
	it is extremely important to keep some programming style, e.g.
	to use names_like_that for procedures and LikeThat for variables,
	to put each goal on a separate line etc. I've been trying to
	port various external programs to Sepia and sometimes it's rather
	difficult to realize what the author really meant.

--Micha
/* End of text from uiucdcsm:comp.lang.prolog */

mccaugh@uiucdcsm.cs.uiuc.edu (05/28/88)

/* Written  1:14 am  May 28, 1988 by mccaugh@uiucdcsm.cs.uiuc.edu in uiucdcsm:comp.lang.prolog */
/* Written  3:43 am  May 25, 1988 by micha@ecrcvax.UUCP in uiucdcsm:comp.lang.prolog */
/* ---------- "Re: Clause fusion (Disjunctions)" ---------- */
In article <1001@cresswell.quintus.UUCP> ok@quintus.UUCP (Richard A. O'Keefe) writes:
>In article <539@ecrcvax.UUCP>, micha@ecrcvax.UUCP (Micha Meier) writes:
>> Richard proposes that nested if-then-else's are treated at the same level,
>> which leads to confusions since then the indentation is context dependent
>> (an if-then-else inside another one cannot be indented independently).
>
>I DO NOT!  I use exactly the same rule for indenting if->then;elses in
>Prolog that I use in Fortran 77, Pop, ADA, Algol 68, et cetera.  Namely
>
>	<IF> <condition> <THEN>
>	[1 indent] <body>
>	<ELIF> <condition> <THEN>
>	[1 indent] <body>
>	...
>	<ELSE>
>	[1 indent] <body>
>	<ENDIF>
>
	The problem with Prolog is that any of the term can be
	a conjunction, disjunction or if-then-else. What about

	(	(	C1 ->
			B1
		;
			B2
		) ->
		(	C2 ->
			B3
		;
			B4
		),
		B5
	;	B6,
		B7
	)

	I find it not much readable when the condition is difficult
	to distinguish from the other code.

>	( test1 ->
>	    body1
>	; test2 ->
>	    body2
>	; /*otherwise*/
>	    body3
>	)

	Here it is different - how exactly do you indent your procedures?
	This problem might seem to be a minor one, but should not there
	be at least a recommendation from the standard or from somebody
	else? Prolog does not have many syntactical structures and therefore
	it is extremely important to keep some programming style, e.g.
	to use names_like_that for procedures and LikeThat for variables,
	to put each goal on a separate line etc. I've been trying to
	port various external programs to Sepia and sometimes it's rather
	difficult to realize what the author really meant.

--Micha
/* End of text from uiucdcsm:comp.lang.prolog */
/* End of text from uiucdcsm:comp.lang.prolog */