07.363 Logic Programming: Lecture 11

Term Expansion

  
  Specialist notations (e.g. circuits, tic-tac-toe patterns) can
    be compiled into Prolog
  Often, this compilation is on a term-by-term basis
  Prolog provides a ``term expansion'' hook for this purpose
  

	term_expansion( Head if Pattern, (H:-P) ) :-
	    term_append(Head, [Board], H),
	    compile_ttt(Pattern, Board, P).
  

How the hook works

  When Prolog loads a file, it does

	repeat,
	    read(Term),
	    expand_term(Term, Clause),
	    process(Clause),
	!
  
  So all terms pass through expand_term/2 when they are read.

  expand_term/2 calls term_expansion/2 if it is defined.
  If it succeeds, that translation is used.  Else it tries any standard
  translations.



Handling State

  Prolog does not handle state very well, but term expansion can be used
  to overcome this defect.

  Two kinds of state: mutable and immutable.

  Immutable state is when you pass the same value to each goal.

  Mutable state is when a predicate takes one value and returns another
  (``updated'' version).




Immutable State

  Aka non-local variables (Prolog does not possess such things; Gofer
  and other functional languages do).

  
	f( ..., S, ... ) :-
	    g( ..., S, ... ),
	    ...
	    h( ..., S, ... ).

 
  E.g. 
 
    match( P1 & P2, Board ) :-
        match( P1, Board ),
        match( P2, Board ).



Mutable State

  Pass ``old value'' -- ``new value'' pairs.  These are sometimes called
  accumulator pairs, or (when used with lists) difference lists.

  

	f( ..., S0, Sn, ... ) :-
	    g( ..., S0, S1, ... ),
	    ...
	    h( ..., Sm, Sn, ... ).


  Example: length/3
  
    length( [], L, L ).
    length( [_|List], L0, L ) :-
        L1 is L0 + 1,
        length( List, L1, L ).
  


Non-Local State and Multiple Accumulators in Prolog

	compile_stmt( while(E,S), Env,
	              Regs0,Regs,
	              Code0,Code,
	              Size0,Size ) :-
	    Code0 = [goto(L2),label(L1)Code1],
	    Size1 is Size0 + 6,
	    compile_stmt( E, Env,
	                  Regs0,Regs1,
	                  Code1,Code2,
	                  Size1,Size2 ),
	    Code2 = [label(L2)Code3],
	    Size3 is Size2 + 3,
	    compile_stmt( S, Env,
	                  Regs1,Regs,
	                  Code3,Code4,
	                  Size3,Size4 ),
	    Code4 = [brtrue(L1)Code],
	    Size is Size4 + 3.
  


EDCGs --- Hiding State

  Adding state arguments is a mechanical process.  Doing it manually is
  error prone, and makes the code difficult to read.

  Most Prologs support a ``grammar rule'' notation that adds a single
  accumulator pair to goals in a clause.  This is good for parsing;
  called Definite Clause Grammars (DCGs).

  Extended DCGs let you add any number of accumulator pairs and state
  arguments.

  With EDCGs, you need to declare accumulator types and list the
  accumulators and state pairs for each predicate.




Specifying an Accumulator

   Accumulator is specified by a predicate that relates a current value
   (In) and an increment (X) to a new value (Out).

   E.g. length/3 could be written like this:

  
    acc_info( total, X, In, Out, Out is In+X ).
    pred_info( length, 1, [total] ).

    length( [] ) -->> [].
    length( [_L] ) -->>
        [1]:total,
        length(L).
  

  A goal of the form List:accumulator is replaced by the
  accumulator expression.



Specifying Passed State

  
	pass_info( board ).

	pred_info( win,   3, [board] ).
	pred_info( line,  3, [board] ).
	pred_info( line,  4, [board] ).
	pred_info( blank, 3, [board] ).

	win(P,R,C) -->>
	    line(Line,P,2),
	    blank(Line,R,C).

	line( Line, P, Count ) -->>
	    line(Line, A,B,C),
	    { count(Count, P, A,B,C) }.
  


Preventing Expansion

  In the previous example, count/5 didn't want to know about the
  board.  We want this goal to appear unchanged in the translated
  clause.  Indicate this by enclosing it in curly braces  .

  Expansion is

  
	line( Line, P, Count, Board ) :-
	    line(Line, A,B,C, Board),
	    count(Count, P, A,B,C).
  
  


Summary of EDCG Notation

    In/accum
        Bind In to the current (input) value of the accumulator
        
    accum/Out
        Bind Out to the next (output) value of the accumulator
        
    In/accum/Out
        Bind both 

    Goal
        Expand goal with relevant accumulators 

    { Goal }
        Don't translate Goal 

    [X] : accum
        Insert the accumulator relation here 

    Goal : [accum(In)]
        Expand Goal with initial value for accum set to In 

    Goal : [accum(In,Out)]
        Expand Goal with bindings for initial and final
           values of accum


Using EDCGs in your programs:

    Start any file that uses the EDCG extension with these lines:

	:- ensure_loaded(library(edcg)).
	:- multifile pass_info/1, acc_info/5, pred_info/3.
	:- dynamic pass_info/1, acc_info/5, pred_info/3.

    This should work under both Quintus and SICStus prolog.