[comp.lang.prolog] PROLOG Digest V5 #64

PROLOG-REQUEST@SUSHI.STANFORD.EDU.UUCP (09/23/87)

PROLOG Digest           Thursday, 24 Sep 1987      Volume 5 : Issue 64

Today's Topics:
                     LP Library - stddef & stdio
----------------------------------------------------------------------

Date: Sun, 13 Sep 87 22:41:59 PDT
From: Edouard Lagache <lagache@violet.Berkeley.EDU>
Subject: stddef.pro

/* FILE: STDDEF.PRO */
/******************************************************************************/
/*                                                                            */
/*             Standard PROLOG Predicate and data definition file             */
/*                                                                            */
/*          This file contains predicates and data which effectively extend   */
/*      the PROLOG environment.  These extensions are in the area of          */
/*      arithmetic predicates, and predicates to convert matching into other  */
/*      useful forms such as lists, sums, or counts of frequency.             */
/*                                                                            */
/*               E. Lagache,  Version - 1.40,  July  - 1987                   */
/*               Copyright(C) 1986,1987, ALL RIGHTS RESERVED                  */
/*                                                                            */
/******************************************************************************/

/* Adapt A.D.A. PROLOG to run C&M standard programs */
call(X) :- X.

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'concat' concatenates to atom names into   */
/*  a new atom.                                */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Jul - 87     */
/*                                             */
/* Note: A more powerful variant of this       */
/*      predicate is built-in to A.D.A. PROLOG */
/* * * * * * * * * * * * * * * * * * * * * * * */
concat(Name1,Name2,Result) :- name(Name1,Stg1),name(Name2,Stg2),
                              append(Stg1,Stg2,Stg3), name(Result,Stg3).


/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'countmatch' returns the number of         */
/*  distinct matches of a variable X in a      */
/*  predicate 'Pred'.                          */
/*                                             */
/*     E. Lagache,  Vers. - 1.10, Jul - 87     */
/* * * * * * * * * * * * * * * * * * * * * * * */
countmatch(Pred,_):- asserta(current_count(0)),
                    call(Pred),         /* Satisfy Pred */
                    update_countmatch,  /* and increment counter */
                    fail.       /* fail to try to resatisfy */
/* Catch failure of above clause, and return count */
countmatch(_,Count):- current_count(Count), retract(current_count(Count)),!.

/* Increment counter */
update_countmatch:- current_count(I), J is I+1, retract(current_count(I)),
                    asserta(current_count(J)), !.

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'evenp' is true for even numbers.          */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Dec - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
evenp(I):- integer(I), J is I mod 2, J == 0.

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'findall' returns a list of all the        */
/*  matches to the variable 'X' in the         */
/*  predicate 'Pred'.                          */
/*                                             */
/*  From Clocksin and Mellish p 162            */
/*                                             */
/*     E. Lagache,  Vers. - 1.01, Dec - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
findall(X,Pred,_):- asserta(found('Do not use this symbol!')),
                 call(Pred),    /* Call predicate and store matches */
                 asserta(found(X)), fail.   /* fail to force resatisfying */
/* This clause will be true when above has failed */
findall(_,_,Result):- collect_found([],Matchlist), !,   /* Collect list */
                      Result = Matchlist. /* remove mark, and retract mark */

/* Collect matches in database and put on list */
collect_found(Partial,Matchlist) :- getnext(Item), !,
                              collect_found([Item|Partial],Matchlist).
collect_found(Matchlist,Matchlist).

/* Retrieve matches placed in database */
getnext(Item):- retract(found(Item)), !, Item \== 'Do not use this symbol!'.

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'gensym' is used to generate new constant  */
/*  symbols.  This predicate takes a seed name */
/*  and appends a number to differentiate      */
/*  between successive calls.                  */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Mar - 87     */
/*                                             */
/*  Clocksin and Mellish pp 159-162            */
/* * * * * * * * * * * * * * * * * * * * * * * */
 gensym(Root,Atom)  :-   get_next_num(Root,Num),  /* get next number */
                         name(Root,Name1),        /* make root a string */
                         integer_name(Num,Name2), /* make number a string */
                         append(Name1,Name2,Name), /* Concat strings */
                         name(Atom, Name).        /* create symbol */

/* >>> predicate 'get_next_num' retrieves next number in the sequence <<< */
/* >>> Called from 'gensym'  <<< */
get_next_num(Root,New) :-    retract(current_index_num(Root,Num)), !,
                             New is Num + 1,
                             asserta(current_index_num(Root,New)).
get_next_num(Root,1) :-      asserta(current_index_num(Root,1)).


/* >>> predicate 'integer_name' converts numbers to ASCII strings <<< */
/* >>> Called from 'gensym' <<< */
 integer_name(Int,List) :-    integer_name(Int,[],List).
 integer_name(I,Sofar,[C|Sofar]) :-  I < 10, !, C is I + 48.
 integer_name(I, Sofar, List) :-   Tophalf is I/10,
                                   Bothalf is I mod 10,
                                   C is Bothalf + 48,
                                   integer_name(Tophalf,[C|Sofar],List).

/*      Solution using ADA specific predicates */
/*      NOTE: 'get_next_num' is needed from above */
/* gensym(Root,Atom) :-    get_next_num(Root,Num),  /* get a new number */
/*                         atoi(Symbol,Num),       /* make a symbol out of it */
/*                         concat(Atom,[Root,Symbol]). /* concat symbols */

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'interval' generates all integers          */
/*  between 'Num1' and 'Num2'.                 */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Nov - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
interval(Num1,Num1,Num2). /* Select base of interval */
interval(Num0,Next,Num2):- Num0 < Num2,  Num1 is Num0 + 1, /* Increment base */
                        interval(Num1,Next,Num2).          /* of interval */

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'max' returns the largest of two numbers   */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Apr - 87     */
/* * * * * * * * * * * * * * * * * * * * * * * */
max(Number1,Number2,Number1) :- Number1 >= Number2, !.
max(Number1,Number2,Number2).

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'min' returns the smaller of two numbers   */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Apr - 87     */
/* * * * * * * * * * * * * * * * * * * * * * * */
min(Number1,Number2,Number1) :- Number1 =< Number2, !.
min(Number1,Number2,Number2).

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'oddp' is true for odd numbers.            */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Nov - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
oddp(I):- integer(I), J is I mod 2, J \== 0.

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'stringp' tests to see if the item is a    */
/*  string.  Since all strings are lists of    */
/*  ASCII codes, the predicate just tests if   */
/*  item is a list.                            */
/*                                             */
/*     E. Lagache,  Vers. - 1.10, Jul - 87     */
/* * * * * * * * * * * * * * * * * * * * * * * */
stringp([]).
stringp([_|_]).

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'sum_match' returns the sum of an          */
/*  numerical field of predicate 'Pred'.       */
/*  The field name must be instantiated to     */
/*  'X'.  The result is returned in 'Sum'.     */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Nov - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
/* Start by finding all values of 'X' and maintaining a running total in */
/* 'current_sum' */
sum_match(X,Pred,_):- assertz(current_sum(0)),  /* Store 0 */
                      call(Pred),               /* Try to satisfy */
                      update_sum_match(X),      /* if possible store result */
                      fail.                     /* fail to try to resatisfy */

/* when first rule fails this rule will recover sum */
sum_match(_,_,Sum):- current_sum(Sum), retract(current_sum(Sum)), !.

/* This rule computes and stores running total in database */
update_sum_match(X):- integer(X),current_sum(I), J is I+X,
                      retract(current_sum(I)),assertz(current_sum(J)), !.

/* end file: STDDEF.PRO */

------------------------------

Date: Sun, 13 Sep 87 22:42:57 PDT
From: Edouard Lagache <lagache@violet.Berkeley.EDU> 
Subject: stdio.pro

/* FILE: STDIO.PRO */
/******************************************************************************/
/*                                                                            */
/*             Standard PROLOG input/output predicate definition file         */
/*                                                                            */
/*          This file contains predicates and data which provide commonly     */
/*      needed input/output capabilities for interactive programming.         */
/*                                                                            */
/*               E. Lagache,  Version - 1.03,  July - 1987                    */
/*                   Copyright(C) 1987, ALL RIGHTS RESERVED                   */
/*                                                                            */
/*      Note: These predicates assume nothing more intelligent than a         */
/*            generic dumb terminal.  For more intelligent terminal           */
/*            use the predicate library contained in the file 'ANSI-IO.PRO'   */
/*                                                                            */
/******************************************************************************/

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'center_stg' prints out a string centered  */
/*  on an 80 column terminal screen.           */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Nov - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
center_stg(String):- comp_tabs(String,Tabs), tab(Tabs),p_stg(String), nl.

/*##> 'comp_tabs' computes the number of    <##*/
/*##> spaced needed to center the string.   <##*/
/*##>                                       <##*/
/*##> Used by Predicate: 'center_stg'       <##*/
comp_tabs(String,Tabs):- length(String,Length), X is 80-Length, evenp(X),
                         Tabs is X/2, !.
comp_tabs(String,Tabs):- length(String,Length), X is 79-Length, evenp(X),
                         Tabs is X/2, !.


/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'clear_screen' does a "poor mans" screen   */
/*  clearing by sending newlines.  The         */
/*  directly send the required lines to        */
/*  increase speed.                            */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Dec - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
clear_screen:- nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,
               nl,nl,nl,nl,nl.


/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'prtstr' provides efficient writing of     */
/*  strings by converting them to atom names   */
/*  and using 'write'                          */
/*                                             */
/*   Note: This predicate is builtin to ADA    */
/*   PROLOG.                                   */
/*                                             */
/*     E. Lagache,  Vers. - 1.01, Jul - 87     */
/* * * * * * * * * * * * * * * * * * * * * * * */
prtstr(String):- name(Atom,String), write(Atom).

/* * * * * * * * * * * * * * * * * * * * * * * */
/*  'push_up' sends the requested number of    */
/*  newlines to output.                        */
/*                                             */
/*     E. Lagache,  Vers. - 1.00, Dec - 86     */
/* * * * * * * * * * * * * * * * * * * * * * * */
push_up(0):- !.
push_up(I):- J is I-1, nl,push_up(J).

/* End file: STDIO.PRO */

------------------------------

End of PROLOG Digest
********************