SGI: Development

swi-prolog

PymbleSoftware
From P.O. Box 529, Gordon, Sydney, NSW 2072, Australia.
Who joined July 15, 2008, 5:48 p.m.
Wrote the following at April 16, 2011, 10:19 p.m...
I just built swi-prolog 5.2.13 ... later versions looked like becoming a nightmare.
I notice that the web site: http://www.swi-prolog.org appears to be offline as I write this.

To build it I had to #undef offsetof in pl-threads.c just before the "#ifndef offsetof" and I had to make sure that "-I/usr/nekoware/include" was in the CFLAGS...

If someone wants to make a nekoware package out of it... go for it.

To install it, I commented out the $(RANLIB) lines from the make file and did a gmake install.
I did a configure --prefix /usr/nekoware so everything appears to have ended up in the right place. :D

R.
死の神はりんごだけ食べる

開いた括弧は必ず閉じる -- あるプログラマー

:Tezro: :Tezro: :Onyx2R: :Onyx2RE: :Onyx2: :O3x04R: :O3x0: :O200: :Octane: :Octane2: :O2: :O2: :Indigo2IMP: :PI: :PI: :1600SW: :1600SW: :Indy: :Indy: :Indy: :Indy: :Indy:
:hpserv: J5600, 2 x Mac, 3 x SUN, Alpha DS20E, Alpha 800 5/550, 3 x RS/6000, Amiga 4000 VideoToaster, Amiga4000 -030, 733MHz Sam440 AmigaOS 4.1 update 1.

Sold: :Indy: :Indy: :Indy: :Indigo: Tandem Himalaya S-Series Nonstop S72000 ServerNet.

Twitter @PymbleSoftware
Current Apps (iOS) -> https://itunes.apple.com/au/artist/pymb ... d553990081
(Android) https://play.google.com/store/apps/deve ... +Ltd&hl=en
(Onyx2) Cortex ---> http://www.facebook.com/pages/Cortex-th ... 11?sk=info
(0300s) Minnie ---> http://www.facebook.com/pages/Minnie-th ... 02?sk=info
Github ---> https://github.com/pymblesoftware
PymbleSoftware
From P.O. Box 529, Gordon, Sydney, NSW 2072, Australia.
Who joined July 15, 2008, 5:48 p.m.
Wrote the following at April 16, 2011, 11:27 p.m...
An example run..

pl -s prolog/eliza.pl


Hello. I am ELIZA. How can I help you?
> I am bored.

Is it because you are bored that you came to me?
> yes

You seem quite positive.
> I am

How long have you been?
> forever, I am imortal.

Do you believe it normal to be imortal?
> no.

Are you saying no just to be negative?
> I am not.

Do you enjoy being not?
> quit

Goodbye. My secretary will send you a bill.
>

% prolog/eliza.pl compiled 0.05 sec, 117,648 bytes
Welcome to SWI-Prolog (Multi-threaded, Version 5.2.13)
Copyright (c) 1990-2003 University of Amsterdam.
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit http://www.swi-prolog.org for details.

For help, use ?- help(Topic). or ?- apropos(Word).

?-
% halt



Code: Select all

/*****************************************************************************/
/* ELIZA in Prolog                                                           */
/*                                                                           */
/*    Viren Patel                                                            */
/*    Artificial Intelligence Programs                                       */
/*    University of Georgia, Athens, Georgia                                 */
/*    Email: [email protected]                                        */
/*                                                                           */
/*    minor changes by Frank Schilder (FS)                                   */
/*    Email: [email protected]                              */
/* Reference                                                                 */
/*                                                                           */
/*    Weizenbaum, J., (1966) ELIZA - A computer program for the study of     */
/*    natural language communication between man and machine. Communications */
/*    of the ACM, 9.1:36-45.                                                 */
/*                                                                           */
/* Acknowledgments                                                           */
/*                                                                           */
/*    read_atomics/1 and suporting clauses are courtesy of Dr. Michael A.    */
/*    Covington, AI Programs, University of Georgia, Athens, Georgia from    */
/*    his forthcoming book, Natural language processing for Prolog           */
/*    programmers.                                                           */
/*                                                                           */
/*    match/2 and its supporting clauses make up the pattern matcher. The    */
/*    basic code for the pattern matcher was obtained from the book by       */
/*    R. A. O'Keefe, The craft of Prolog.                                    */
/*                                                                           */
/* Requires: Quintus Prolog                                                  */
/* changed version runs on SWI-PROLOG                                        */
/*                                                                           */
/* To run:  ?- consult(eliza).                                               */
/* To stop: > quit (`>' is the Eliza prompt)                                 */
/*                                                                           */
/* Last Revised: April 10, 1992                                              */
/*                                                                           */
/*****************************************************************************/

/*****************************************************************************/
% simplification rules

sr([do,not|X],[dont|Y],X,Y).
sr([can,not|X],[cant|Y],X,Y).
sr([cannot|X],[cant|Y],X,Y).
sr([will,not|X],[wont|Y],X,Y).
sr([dreamed|X],[dreamt|Y],X,Y).
sr([dreams|X],[dream|Y],X,Y).
sr([how|X],[what|Y],X,Y).
sr([when|X],[what|Y],X,Y).
sr([alike|X],[dit|Y],X,Y).
sr([same|X],[dit|Y],X,Y).
sr([certainly|X],[yes|Y],X,Y).
sr([maybe|X],[perhaps|Y],X,Y).
sr([deutsch|X],[xfremd|Y],X,Y).
sr([francais|X],[xfremd|Y],X,Y).
sr([espanol|X],[xfremd|Y],X,Y).
sr([machine|X],[computer|Y],X,Y).
sr([machines|X],[computer|Y],X,Y).
sr([computers|X],[computer|Y],X,Y).
sr([am|X],[are|Y],X,Y).
sr([your|X],[my|Y],X,Y).
sr([were|X],[was|Y],X,Y).
sr([me|X],[you|Y],X,Y).
sr([you,are|X],[im|Y],X,Y).      % im = i'm = i am
sr([i,am|X],[youre|Y],X,Y).      % youre = you're = you are =\= your
sr([myself|X],[yourself|Y],X,Y).
sr([yourself|X],[myself|Y],X,Y).
sr([mom|X],[mother|Y],X,Y).
sr([dad|X],[father|Y],X,Y).
sr([i|X],[you|Y],X,Y).
sr([you|X],[i|Y],X,Y).
sr([my|X],[your|Y],X,Y).
sr([everybody|X],[everyone|Y],X,Y).
sr([nobody|X],[everyone|Y],X,Y).


/*****************************************************************************/
% Make the rule base modifiable
%    this is specific to Quintus Prolog

:- dynamic(rules/1).


/*****************************************************************************/
% The rule base
%    The format of the rules is:
%
% rules([[keyword, importance of keyword],[
%         [pattern #, [the pattern], last response used,
%             [response 1],
%             [response 2],
%             ...
%             [response n]]]]).

rules([[sorry,0],[
[1,[_],0,
[please,do,not,apologize,.],
[apologies,are,not,necessary,.],
[what,feelings,do,you,have,when,you,apologize,?],
['I',have,told,you,that,apologies,are,not,required,.]]]]).

rules([[remember,5],[
[1,[_,you,remember,Y],0,
[do,you,often,think,of,Y,?],
[does,thinking,of,Y,bring,anything,else,to,mind,?],
[what,else,do,you,remember,?],
[why,do,you,remember,Y,just,now,?],
[what,in,the,present,situation,reminds,you,of,Y,?],
[what,is,the,connection,between,me,and,Y,?]],
[2,[_,do,i,remember,Y],0,
[did,you,think,'I',would,forget,Y,?],
[why,do,you,think,i,should,recall,Y,now,?],
[what,about,Y,?],
[equal,[what,0]],
[you,mentioned,Y,.]],
[3,[_],0,
[newkey]]]]).

rules([[if,3],[
[1,[_,if,Y],0,
[do,you,think,it,is,likely,that,Y,?],
[do,you,wish,that,Y,?],
[what,do,you,think,about,Y,?],
[really,',',if,Y,?]]]]).

rules([[dreamt,4],[
[1,[_,you,dreamt,Y],0,
[really,',',Y,?],
[have,you,ever,fantasied,Y,while,you,were,awake,?],
[have,you,dreamt,Y,before,?],
[equal,[dream,3]],
[newkey]]]]).

rules([[dream,3],[
[1,[_],0,
[what,does,that,dream,suggest,to,you,?],
[do,you,dream,often,?],
[what,persons,appear,in,your,dreams,?],
[do,you,believe,that,dreaming,has,something,to,do,with,your,problem,?],
[newkey]]]]).

rules([[none,0],[
[1,[_],0,
['I',am,not,sure,'I',understand,you,fully,.],
[please,go,on,.],
[what,does,that,suggest,to,you,?],
[do,you,feel,strongly,about,discussing,such,things,?]]]]).

rules([[perhaps,0],[
[1,[_],0,
[you,do,not,seem,quite,certain,.],
[why,the,uncertain,tone,?],
[can,you,not,be,more,positive,?],
[you,are,not,sure,?],
[do,you,not,know,?]]]]).

rules([[name,15],[
[1,[_],0,
['I',am,not,interested,in,names,.],
['I',have,told,you,before,',','I',do,not,care,about,names,.],
[please,continue,.]]]]).

rules([[xfremd,75],[
[1,[_],0,
['I',am,sorry,',','I',only,speak,'English',.]]]]).

rules([[hello,0],[
[1,[_],0,
[how,do,you,do,'.','Please',state,your,problem,.]]]]).

rules([[computer,50],[
[1,[_],0,
[do,computers,worry,you,?],
[why,do,you,mention,computers,?],
[what,do,you,think,machines,have,to,do,with,your,problem,?],
[do,you,not,think,computers,can,help,people,?],
[what,about,machines,worries,you,?],
[what,do,you,think,about,machines,?]]]]).

rules([[are,0],[
[1,[_,are,you,Y],0,
[do,you,believe,you,are,Y,?],
[would,you,want,to,be,Y,?],
[you,wish,'I',would,tell,you,you,are,Y,?],
[what,would,it,mean,if,you,were,Y,?],
[equal,[what,0]]],
[2,[_,are,i,Y],0,
[why,are,you,interested,in,whether,'I',am,Y,or,not,?],
[would,you,prefer,if,'I',were,not,Y,?],
[perhaps,'I',am,Y,in,your,fantasies,.],
[do,you,sometimes,think,'I',am,Y,?],
[equal,[what,0]]],
[3,[_,are,Y],0,
[did,you,think,they,might,not,be,Y,?],
[would,you,like,it,if,they,were,not,Y,?],
[what,if,they,were,not,Y,?],
[possibly,they,are,Y,.]],
[4,[_],0,
[why,do,you,say,am,?],
['I',do,not,understand,that,.]]]]).


rules([[my,0],[
[1,[_,my,Y],0,
[why,are,you,concerned,over,my,Y,?],
[what,about,your,own,Y,?],
[are,you,worried,about,someone,elses,Y,?],
[really,',',my,Y,?]]]]).

rules([[was,2],[
[1,[_,was,you,Y],0,
[what,if,you,were,Y,?],
[do,you,think,you,were,Y,?],
[were,you,Y,?],
[what,would,it,mean,if,you,were,Y,?],
[what,does,Y,suggest,to,you,?],
[equal,[what,0]]],
[2,[_,you,was,Y],0,
[were,you,really,?],
[why,do,you,tell,me,you,were,Y,just,now,?],
[perhaps,'I',already,knew,you,were,Y,.]],
[3,[_,was,i,Y],0,
[would,you,like,to,believe,'I',was,Y,?],
[what,suggests,that,'I',was,Y,?],
[what,do,you,think,?],
[perhaps,'I',was,Y,.],
[what,if,'I',had,been,Y,?]],
[4,[_],0,
[newkey]]]]).

rules([[im,0],[
[1,[_,im,_],0,
[equal,[i,0]]]]]).

rules([[youre,0],[
[1,[_,youre,_],0,
[equal,[you,0]]]]]).

rules([[you,0],[
[1,[_,you,cant,Y],0,
[how,do,you,know,you,can,not,Y,?],
[have,you,tried,?],
[perhaps,you,could,Y,now,?],
[do,you,really,want,to,be,able,to,Y,?]],
[2,[_,you,dont,Y],0,
[do,you,not,really,Y,?],
[why,do,you,not,Y,?],
[do,you,wish,to,be,able,to,Y,?],
[does,that,trouble,you,?]],
[3,[_,you,feel,Y],0,
[tell,me,more,about,such,feelings,.],
[do,you,often,feel,Y,?],
[do,you,enjoy,feeling,Y,?],
[of,what,does,feeling,Y,remind,you,?]],
[4,[_,you,was,_],0,
[equal,[was,2]]],
[5,[_,you,Y,i,_],0,
[perhaps,in,your,fantasy,we,Y,each,other,?],
[do,you,wish,to,Y,me,?],
[you,seem,to,need,to,Y,me,.],
[do,you,Y,anyone,else,?]],
[6,[_,you,[*,want,need,_],Y],0,
[what,would,it,mean,to,you,if,you,got,Y,?],
[why,do,you,want,Y,?],
[suppose,you,got,Y,soon,?],
[what,if,you,never,got,Y,?],
[what,would,getting,Y,mean,to,you,?],
[what,does,wanting,Y,have,to,do,with,this,discussion,?]],
[7,[_,you,[*,feel,think,believe,wish,_],you,Y],0,
[do,you,really,think,so,?],
[but,you,are,not,sure,you,Y,?],
[do,you,really,doubt,you,Y,?]],
[8,[_,you,_,[*,feel,think,believe,wish,_],_,i,_],0,
[equal,[you,0]]],
[9,[_,youre,_,[*,sad,unhappy,depressed,sick,M],_],0,
['I',am,sorry,to,hear,you,are,M,.],
[do,you,think,coming,here,will,help,you,not,to,be,M,?],
['I',am,sure,it,is,not,pleasant,to,be,M,.],
[can,you,explain,what,made,you,M,?]],
[10,[_,youre,_,[*,happy,elated,glad,better,M],_],0,
[how,have,'I',helped,you,to,be,M,?],
[has,your,treatment,made,you,M,?],
[what,makes,you,M,just,now,?],
[can,you,explain,why,you,are,suddenly,M,?]],
[11,[_,youre,Y],0,
[is,it,because,you,are,Y,that,you,came,to,me,?],
[how,long,have,you,been,Y,?],
[do,you,believe,it,normal,to,be,Y,?],
[do,you,enjoy,being,Y,?]],
[12,[X],0,
[you,say,X],
[can,you,elaborate,on,that,?],
[do,you,say,X,for,some,special,reason,?],
[that,is,quite,interesting,.]]]]).

rules([[i,0],[
[1,[_,i,remind,you,of,_],0,
[equal,[dit,10]]],
[2,[_,im,Y],0,
[what,makes,you,think,'I',am,Y,?],
[does,it,please,you,to,believe,'I',am,Y,?],
[do,you,sometimes,wish,you,were,Y,?],
[perhaps,you,would,like,to,be,Y,?]],
[3,[_,i,Y,you],0,
[why,do,you,think,'I',Y,you,?],
[you,like,to,think,'I',Y,you,',',do,you,not,?],
[what,makes,you,think,'I',Y,you,?],
[really,',','I',Y,you,.],
[do,you,wish,to,believe,'I',Y,you,?],
[suppose,'I',did,Y,you,',',what,would,that,mean,to,you,?],
[does,someone,else,believe,'I',Y,you,?]],
[4,[_,i,Y],0,
[we,were,discussing,you,',',not,me,.],
[oh,',',i,Y,.],
[you,are,not,really,talking,about,me,',',are,you,?],
[what,are,your,feelings,now,?]]]]).

rules([[yes,0],[
[1,[_],0,
[you,seem,quite,positive,.],
[you,are,sure,?],
[i,see,.],
[i,understand,.]]]]).

rules([[no,0],[
[1,[_],0,
[are,you,saying,no,just,to,be,negative,?],
[you,are,being,a,bit,negative,.],
[why,not,?],
[why,no,?]]]]).

rules([[your,2],[
[1,[_,your,_,[*,mother,father,brother,sister,children,wife,M],Z],0,
[tell,me,more,about,your,family,.],
[who,else,in,your,family,Z,?],
[your,M,?],
[what,else,comes,to,mind,when,you,think,of,your,M,?]],
[2,[_,your,Y],0,
[your,Y,?],
[why,do,you,say,your,Y,?],
[does,that,suggest,anything,else,which,belongs,to,you,?],
[is,it,important,to,you,that,your,Y,?]]]]).

rules([[memory,0],[
[1,[_,your,Y],0,
[lets,discuss,further,why,your,Y,.],
[earlier,you,said,your,Y,.],
[but,your,Y,?],
[does,that,have,anything,to,do,with,the,fact,that,your,Y,?]]]]).

rules([[can,0],[
[1,[_,can,i,Y],0,
[you,believe,'I',can,Y,',',do,you,not,?],
[equal,[what,0]],
[you,want,me,to,be,able,to,Y,?],
[perhaps,you,would,like,to,be,able,to,Y,yourself,?]],
[2,[_,can,you,Y],0,
[whether,or,not,you,can,Y,depends,on,you,more,than,on,me,.],
[do,you,want,to,be,able,to,Y,?],
[perhaps,you,do,not,want,to,Y,.],
[equal,[what,0]]]]]).

rules([[what,0],[
[1,[_],0,
[why,do,you,ask,?],
[does,that,question,interest,you,?],
[what,is,it,you,really,want,to,know,?],
[are,such,questions,much,on,your,mind,?],
[what,answer,would,please,you,most,?],
[what,do,you,think,?],
[what,comes,to,your,mind,when,you,ask,that,?],
[have,you,asked,such,questions,before,?],
[have,you,asked,anyone,else,?]]]]).

rules([[because,0],[
[1,[_],0,
[is,that,the,real,reason,?],
[do,any,other,reasons,not,come,to,mind,?],
[does,that,reason,seem,to,explain,anything,else,?],
[what,other,reasons,might,there,be,?]]]]).

rules([[why,0],[
[1,[_,why,dont,i,Y],0,
[do,you,believe,'I',do,not,Y,?],
[perhaps,'I',will,Y,in,good,time,.],
[should,you,Y,yourself,?],
[you,want,me,to,Y,?],
[equal,[what,0]]],
[2,[_,why,cant,you,Y],0,
[do,you,think,you,should,be,able,to,Y,?],
[do,you,want,to,be,able,to,Y,?],
[do,you,believe,this,will,help,you,to,Y,?],
[have,you,any,idea,why,you,can,not,Y,?],
[equal,[what,0]]]]]).

rules([[everyone,2],[
[1,[_,[*,everyone,everybody,nobody,noone,M],_],0,
[really,',',M,?],
[surely,not,M,?],
[can,you,think,of,anyone,in,particular,?],
[who,',',for,example,?],
[you,are,thinking,of,a,very,special,person,?],
[who,',',may,i,ask,?],
[someone,special,perhaps,?],
[you,have,a,paticular,person,in,mind,',',do,you,not,?],
[who,do,you,think,you,are,talking,about,?]]]]).

rules([[always,1],[
[1,[_],0,
[can,you,think,of,a,specific,example,?],
[when,?],
[what,incident,are,you,thinking,of,?],
[really,',',always,?]]]]).

rules([[like,10],[
[1,[_,[*,im,youre,am,is,are,was,_],_,like,_],0,
[equal,[dit,10]]],
[2,[_],0,
[newkey]]]]).

rules([[dit,10],[
[1,[_],0,
[in,what,way,?],
[what,resemblance,do,you,see,?],
[what,does,that,similarity,suggest,to,you,?],
[what,other,connections,do,you,see,?],
[what,so,you,suppose,that,resemblance,means,?],
[what,is,the,connection,',',do,you,suppose,?],
[could,there,really,be,some,connection,?],
[how,?]]]]).

rules([[quit,100],[
[1,[_],0,
[goodbye,.,'My',secretary,will,send,you,a,bill,.]]]]).


/*****************************************************************************/
% my_char_type(+Char,?Type)
%    Char is an ASCII code.
%    Type is whitespace, punctuation, numeric, alphabetic, or special.

my_char_type(46,period) :- !.
my_char_type(X,alphanumeric) :- X >= 65, X =< 90, !.
my_char_type(X,alphanumeric) :- X >= 97, X =< 123, !.
my_char_type(X,alphanumeric) :- X >= 48, X =< 57, !.
my_char_type(X,whitespace) :- X =< 32, !.
my_char_type(X,punctuation) :- X >= 33, X =< 47, !.
my_char_type(X,punctuation) :- X >= 58, X =< 64, !.
my_char_type(X,punctuation) :- X >= 91, X =< 96, !.
my_char_type(X,punctuation) :- X >= 123, X =< 126, !.
my_char_type(_,special).


/*****************************************************************************/
% lower_case(+C,?L)
%   If ASCII code C is an upper-case letter, then L is the
%   corresponding lower-case letter. Otherwise L=C.

lower_case(X,Y) :-
X >= 65,
X =< 90,
Y is X + 32, !.

lower_case(X,X).


/*****************************************************************************/
% read_lc_string(-String)
%  Reads a line of input into String as a list of ASCII codes,
%  with all capital letters changed to lower case.

read_lc_string(String) :-
get0(FirstChar),
lower_case(FirstChar,LChar),
read_lc_string_aux(LChar,String).

read_lc_string_aux(10,[]) :- !.  % end of line

read_lc_string_aux(-1,[]) :- !.  % end of file

read_lc_string_aux(LChar,[LChar|Rest]) :- read_lc_string(Rest).


/*****************************************************************************/
% extract_word(+String,-Rest,-Word) (final version)
%  Extracts the first Word from String; Rest is rest of String.
%  A word is a series of contiguous letters, or a series
%  of contiguous digits, or a single special character.
%  Assumes String does not begin with whitespace.

extract_word([C|Chars],Rest,[C|RestOfWord]) :-
my_char_type(C,Type),
extract_word_aux(Type,Chars,Rest,RestOfWord).

extract_word_aux(special,Rest,Rest,[]) :- !.
% if Char is special, don't read more chars.

extract_word_aux(Type,[C|Chars],Rest,[C|RestOfWord]) :-
my_char_type(C,Type), !,
extract_word_aux(Type,Chars,Rest,RestOfWord).

extract_word_aux(_,Rest,Rest,[]).   % if previous clause did not succeed.


/*****************************************************************************/
% remove_initial_blanks(+X,?Y)
%   Removes whitespace characters from the
%   beginning of string X, giving string Y.

remove_initial_blanks([C|Chars],Result) :-
my_char_type(C,whitespace), !,
remove_initial_blanks(Chars,Result).

remove_initial_blanks(X,X).   % if previous clause did not succeed.


/*****************************************************************************/
% digit_value(?D,?V)
%  Where D is the ASCII code of a digit,
%  V is the corresponding number.

digit_value(48,0).
digit_value(49,1).
digit_value(50,2).
digit_value(51,3).
digit_value(52,4).
digit_value(53,5).
digit_value(54,6).
digit_value(55,7).
digit_value(56,8).
digit_value(57,9).


/*****************************************************************************/
% string_to_number(+S,-N)
%  Converts string S to the number that it
%  represents, e.g., "234" to 234.
%  Fails if S does not represent a nonnegative integer.

string_to_number(S,N) :-
string_to_number_aux(S,0,N).

string_to_number_aux([D|Digits],ValueSoFar,Result) :-
digit_value(D,V),
NewValueSoFar is 10*ValueSoFar + V,
string_to_number_aux(Digits,NewValueSoFar,Result).

string_to_number_aux([],Result,Result).


/*****************************************************************************/
% string_to_atomic(+String,-Atomic)
%  Converts String into the atom or number of
%  which it is the written representation.

string_to_atomic([C|Chars],Number) :-
string_to_number([C|Chars],Number), !.

string_to_atomic(String,Atom) :- name(Atom,String).
% assuming previous clause failed.


/*****************************************************************************/
% extract_atomics(+String,-ListOfAtomics) (second version)
%  Breaks String up into ListOfAtomics
%  e.g., " abc def  123 " into [abc,def,123].

extract_atomics(String,ListOfAtomics) :-
remove_initial_blanks(String,NewString),
extract_atomics_aux(NewString,ListOfAtomics).

extract_atomics_aux([C|Chars],[A|Atomics]) :-
extract_word([C|Chars],Rest,Word),
string_to_atomic(Word,A),       % <- this is the only change
extract_atomics(Rest,Atomics).

extract_atomics_aux([],[]).


/*****************************************************************************/
% clean_string(+String,-Cleanstring)
%  removes all punctuation characters from String and return Cleanstring

clean_string([C|Chars],L) :-
my_char_type(C,punctuation),
clean_string(Chars,L), !.
clean_string([C|Chars],[C|L]) :-
clean_string(Chars,L), !.
clean_string([C|[]],[]) :-
my_char_type(C,punctuation), !.
clean_string([C|[]],[C]).


/*****************************************************************************/
% read_atomics(-ListOfAtomics)
%  Reads a line of input, removes all punctuation characters, and converts
%  it into a list of atomic terms, e.g., [this,is,an,example].

read_atomics(ListOfAtomics) :-
read_lc_string(String),
clean_string(String,Cleanstring),
extract_atomics(Cleanstring,ListOfAtomics).


/****************************************************************************/
% isalist(+List)
%    checks if List is actually a list

isalist([_|_]).


/****************************************************************************/
% member(?Element,+List)
%    checks if Element is in List
% (FS) SWI-Prolog built-in predicate

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


/****************************************************************************/
% append(?List1, ?List2, ?List3)
%    appends List2 on the end of List1 and returns it as List3
% (FS) SWI-Prolog built-in predicate

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


/****************************************************************************/
% flatten(+List,-FlatList)
%    flattens List with sublists into FlatList
% (FS) SWI-Prolog built-in predicate

%flatten([],[]).
%flatten([H|T],[H|T2]) :- \+ isalist(H),
%                         flatten(T,T2).
%flatten([H|T],L) :- isalist(H),
%                    flatten(H,A),
%                    flatten(T,B),
%                    append(A,B,L).


/****************************************************************************/
% last_member(-Last,+List)
%    returns the last element of List in Last

last_member(End,List) :- append(_,[End],List).


/****************************************************************************/
% findnth(+List,+Number,-Element)
%    returns the Nth member of List in Element

findnth([E|_],1,E).
findnth([_|T],N,T1) :- V is N - 1,
findnth(T,V,T1).


/****************************************************************************/
% replace(+Element1,+List1,+Element2,-List2)
%    replaces all instances of Element1 in List1 with Element2 and returns
%       the new list as List2
%    does not replace variables in List1 with Element1

replace(_,[],_,[]).
replace(X,[H|T],A,[A|T2]) :- nonvar(H), H = X, !, replace(X,T,A,T2).
replace(X,[H|T],A,[H|T2]) :- replace(X,T,A,T2).


/****************************************************************************/
% simplify(+List,-Result)
%   implements non-overlapping simplification
%   simplifies List into Result

simplify(List,Result) :- sr(List,Result,X,Y), !,
simplify(X,Y).
simplify([W|Words],[W|NewWords]) :- simplify(Words,NewWords).
simplify([],[]).


/****************************************************************************/
% match(+MatchRule,+InputList)
%    matches the MatchRule with the InputList. If they match, the variables
%    in the MatchRule are instantiated to one of three things:
%       an empty list
%       a single word
%       a list of words

match(A,C) :- match_aux1(A,C),!.
match(A,C) :- match_aux2(A,C).

match_aux1(A,C) :-
member([*|T],A),
nonvar(T),
member(Tm,T),
nonvar(Tm),
replace([*|T],A,Tm,B),
match_aux2(B,C),
!, last_member(L,T), L = Tm.

match_aux2([],[]).
match_aux2([Item|Items],[Word|Words]) :-
match_aux3(Item,Items,Word,Words),!.
match_aux2([Item1,Item2|Items],[Word|Words]) :-
var(Item1),
nonvar(Item2),
Item2 == Word,!,
match_aux2([Item1,Item2|Items],[[],Word|Words]).
match_aux2([Item1,Item2|Items],[Word|Words]) :-
var(Item1),
var(Item2),!,
match_aux2([Item1,Item2|Items],[[],Word|Words]).
match_aux2([[]],[]).

match_aux3(Word,Items,Word,Words) :-
match_aux2(Items,Words), !.
match_aux3([Word|Seg],Items,Word,Words0) :-
append(Seg,Words1,Words0),
match_aux2(Items,Words1).


/****************************************************************************/
% makecomment(+KeyWordList,+InputList,-Comment)
%    returns ELIZA's Comment to the InputList based on the KeyWordList
%    takes care of special keywords 'your', and 'memory', which require
%       additional processing before a comment can be generated

makecomment([[your,2]|T],InputList,Comment) :-
assertz(mem(InputList)),
rules([[your,2],Reassembly]),
mc_aux([[your,2]|T],Reassembly,InputList,Comment),!.
makecomment([[memory,0]|T],_,Comment) :-
retract(mem(I2)),
retractall(mem(I2)),
rules([[memory,0],Reassembly]),
mc_aux([[memory,0]|T],Reassembly,I2,Comment),!.
makecomment([[memory,0]|T],InputList,Comment) :-
\+ retract(mem(_)),!,
makecomment(T,InputList,Comment).
makecomment([Keyword|T],InputList,Comment) :-
rules([Keyword,Reassembly]),
mc_aux([Keyword|T],Reassembly,InputList,Comment),!.
makecomment([_|T],InputList,Comment) :-
makecomment(T,InputList,Comment),!.


mc_aux(KeyWordList,[[DRuleNum,MatchRule,N|T]|_],InputList,Comment) :-
match(MatchRule,InputList),
mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment),!.
mc_aux(KeyWordList,[_|T],InputList,Comment) :-
mc_aux(KeyWordList,T,InputList,Comment).
mc_aux(_,[],_,_) :- !,fail.

mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
length(T,TLen),
N < TLen, !,
NewN is N + 1,
findnth(T,NewN,Mn),
mc_aux3(KeyWordList,DRuleNum,N,NewN,Mn,InputList,Comment).
mc_aux2(KeyWordList,DRuleNum,N,T,InputList,Comment) :-
member(Mn,T),
mc_aux3(KeyWordList,DRuleNum,N,0,Mn,InputList,Comment).


mc_aux3([Keyword|T],DRuleNum,N,NewN,[equal,MnT],InputList,Comment) :-
!,
updaterule(Keyword,DRuleNum,N,NewN),
makecomment([MnT|T],InputList,Comment).
mc_aux3([Keyword|T],DRuleNum,N,NewN,[newkey],InputList,Comment) :-
!,
updaterule(Keyword,DRuleNum,N,NewN),
makecomment(T,InputList,Comment).
mc_aux3([Keyword|_],DRuleNum,N,NewN,Mn,_,Mn) :-
updaterule(Keyword,DRuleNum,N,NewN).


/****************************************************************************/
% process_input(+Input_List,+[],?Output)
%     returns part of input after a comma, or
%             part of input before a period

process_input([],L,L).
process_input(['.'|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
process_input(['.'|T],_,L) :- !, process_input(T,[],L).
process_input([','|_],L,L) :- findkeywords(L,K), length(K,Kl), Kl >= 3,!.
process_input([','|T],_,L) :- !, process_input(T,[],L).
process_input([H|T],S,L) :- append(S,[H],S2), process_input(T,S2,L).


/****************************************************************************/
% findkeywords(+InputList,?KeyWordList)
%    returns a list with the keywords in the input list
%    if no keywords are found returns a list with keywords 'memory' and 'none'

findkeywords([],[[memory,0],[none,0]]).
findkeywords([H|T],[[H,I]|T1]) :- rules([[H,I]|_]), !, findkeywords(T,T1).
findkeywords([_|T],T1) :- findkeywords(T,T1).


/****************************************************************************/
% sortkeywords(+KeyWordList,?SortedList)
%    returns a list with the keywords sorted according to their importance
%    this routine implements a simple bubble sort, customized for this
%    application

sortkeywords(X,Y) :- sort_aux(X,A,1), !, sortkeywords(A,Y).
sortkeywords(X,Y) :- sort_aux(X,Y,_).

sort_aux([],[],0).
sort_aux([X],[X],0).
sort_aux([[A,X],[B,Y]|T],[[B,Y],[A,X]|T],1) :- X < Y.
sort_aux([X,Y|T],[X|T2],S) :- sort_aux([Y|T],T2,S).


/****************************************************************************/
% updaterule(+KeyList,+DRuleNum,+N,+NewN)
%    updates a rule by changing the number of the reassembly rule associated
%       with a decomposition rule. The main rule to modify is indicated by
%       KeyList. The decomposition rule within the main rule is indicated by
%       DRuleNum. N is the previous reassembly rule used. NewN is the new
%       one used. N is updated to NewN so that next time a different reassembly
%       (actually the next in sequence) in used.

updaterule(KeyList,DRuleNum,N,NewN) :-
retract(rules([KeyList,Rt])),
replace([DRuleNum,A,N|T],Rt,[DRuleNum,A,NewN|T],Rt2),
assertz(rules([KeyList,Rt2])).


/****************************************************************************/
% writecomment(+CommentList)
%    prints the elements of CommentList. First Characater of first element is
%       converted to uppercase befor printing

writecomment([]).
writecomment(['I'|T]) :- !, write('I'), writecomment_aux(T).
writecomment([H|T]) :- !,
name(H,[C|L]),
D is C - 32,
name(Z,[D|L]),
write(Z),
writecomment_aux(T).

writecomment_aux([]).
writecomment_aux([H|T]) :-
name(H,[C]),
my_char_type(C,punctuation), !,
write(H),
writecomment_aux(T).
writecomment_aux([H|T]) :-
write(' '),
write(H),
writecomment_aux(T).


/****************************************************************************/
% quittime(+InputList)
%    checks if the atom 'quit' is in the InputList

quittime(X) :- member('quit',X).


/****************************************************************************/
% eliza
%    main routine of ELIZA

eliza :-
%   reconsult('eliza.rls'),
retractall(mem(_)),nl,nl,
write('Hello. I am ELIZA. How can I help you?'),nl,write('> '),
repeat,
read_atomics(Input),nl,
process_input(Input,[],Input2),
simplify(Input2,Input3),
findkeywords(Input3,KeyWords),
sortkeywords(KeyWords,KeyWords2),
makecomment(KeyWords2,Input3,Comment),
flatten(Comment,Comment2),
writecomment(Comment2),nl,write('> '),
quittime(Input3),
!.


:- eliza,nl,nl.


R.
死の神はりんごだけ食べる

開いた括弧は必ず閉じる -- あるプログラマー

:Tezro: :Tezro: :Onyx2R: :Onyx2RE: :Onyx2: :O3x04R: :O3x0: :O200: :Octane: :Octane2: :O2: :O2: :Indigo2IMP: :PI: :PI: :1600SW: :1600SW: :Indy: :Indy: :Indy: :Indy: :Indy:
:hpserv: J5600, 2 x Mac, 3 x SUN, Alpha DS20E, Alpha 800 5/550, 3 x RS/6000, Amiga 4000 VideoToaster, Amiga4000 -030, 733MHz Sam440 AmigaOS 4.1 update 1.

Sold: :Indy: :Indy: :Indy: :Indigo: Tandem Himalaya S-Series Nonstop S72000 ServerNet.

Twitter @PymbleSoftware
Current Apps (iOS) -> https://itunes.apple.com/au/artist/pymb ... d553990081
(Android) https://play.google.com/store/apps/deve ... +Ltd&hl=en
(Onyx2) Cortex ---> http://www.facebook.com/pages/Cortex-th ... 11?sk=info
(0300s) Minnie ---> http://www.facebook.com/pages/Minnie-th ... 02?sk=info
Github ---> https://github.com/pymblesoftware
skywriter avatar
skywriter
From living in a linux-blunderland
Who joined March 14, 2003, 5:22 a.m.
Wrote the following at April 17, 2011, 3:53 a.m...
Functional programming, yum!

Eliza would make a great IRC channel with a few changes. It's cheerfully monotonous!
:Skywriter:

DECUS Member 368596