/*  READER.PL  */
 
 
/*
This is the part of the READER in the Richard Head exercise that is to
be loaded. Mainly matching predicates and other subordinate things whose
definitions would not mean much to the student.
*/
 
 
/*
Exported predicates:
 
 
matches( Pattern+, List+ ):
---------------------------
 
Pattern is to be matched against List. Most elements will be taken verbatim,
but the following sequences have a special meaning:
 
    =       Match one element.
    ==      Match any number of elements.
    ?,V     Unify V with the element following.
    ??,V    Unify V with any number of following elements.
    &,A     Match any atom element of which atom A is a subsequence.
 
Examples:
    match( [horse], L )
        Matches L if L = [horse].
 
    match( [horse,==,stealer], L )
        Matches any list L starting with atom 'horse' and ending with
        atom 'stealer'.
 
    match( [??V,horse,==,&,steal,==], L )
        Matches any list L containing atom 'horse' followed by an atom
        which contains the characters 'steal'. Unifies V with the
        sublist preceding the atom 'horse'.
 
The =, ==, ?, ?? are taken from the Pop list matcher. & is used so that
students doing the HEAD exercise can match against fragments of words.
I use ??,V rather than ??(V) to avoid teaching about structures.
 
== and ?? are resatisfiable, so that the matcher will find all possible
segments.
 
 
fits( Pattern+, List+ ):
------------------------
 
Like matches, but is not resatisfiable. Once fits has suceeded, it will
not retry alternatives. This is useful in the HEAD exercise because if
we have matched the student's pattern against a dictionary entry, we
don't need to look for alternative matches - the student will not be
using variables.
 
 
listify( APat+, LPat- ):
------------------------
 
APat is a pattern represented as an atom (see message given by
give_help). LPat is the corresponding pattern as a list, first argument
to matches or fits.
 
 
give_help:
----------
 
Give help on the reader.
 
 
farewell:
---------
 
Emit a farewell message. This is Richard Head's epilogue to the
English-to-Canting dictionary.
*/
 
 
/*
The matcher.
------------
*/
 
 
matches( [], [] ) :- !.
 
matches( [=|TP], [_|TS] ) :-
    !,
    matches( TP, TS ).
 
matches( [==|TP], S ) :-
    !,
    append( _, Post, S ),
    matches( TP, Post ).
 
matches( [?,V|TP], [V|TS] ) :-
    !,
    matches( TP, TS ).
 
matches( [??,V|TP], S ) :-
    !,
    append( V, Post, S ),
    matches( TP, Post ).
 
matches( [&,AP|TP], [AS|TS] ) :-
    !,
    partial_atom_match( AP, AS ),
    matches( TP, TS ).
 
matches( [H|TP], [H|TS] ) :-
    matches( TP, TS ).
 
 
/*  partial_atom_match( AP+, AS+ ):
        Atom AP is a subsequence of atom AS.
*/
partial_atom_match( AP, AS ) :-
    atom( AP ),
    atom( AS ),
    name( AP, LP ),
    name( AS, LS ),
    is_sublist( LP, LS ).
 
 
/*  is_sublist( Sub+, Full+ ):
        List Sub is a subsequence of list Full.
*/
is_sublist( [], _ ) :- !.
 
is_sublist( [H|T], [H|T1] ) :-
    is_sublist( T, T1 ),
    !.
 
is_sublist( L, [_|T1] ) :-
    is_sublist( L, T1 ).
 
 
fits( Pat, S ) :-
    matches( Pat, S ),
    !.
 
 
/*
Converting patterns-as-atoms to patterns-as-lists.
--------------------------------------------------              
*/
 
 
listify( APat, LPat ) :-
    name( APat, L ),
    listify_1( L, LPat ).
 
 
listify_1( [], [] ) :- !.
 
listify_1( [Eq,Eq|TL], [==|TP] ) :-
    is_equals_char( Eq ),
    !,
    listify_1( TL, TP ).
 
listify_1( [Amp|TL], [&,W|TP] ) :-
    is_ampersand_char( Amp ),
    !,
    listify_word( TL, WChars, RestL ),
    name( W, WChars ),
    listify_1( RestL, TP ).
 
listify_1( [Let|T], [W|TP] ) :-
    is_letter_char( Let ),
    !,
    listify_word( [Let|T], WChars, RestL ),
    name( W, WChars ),
    listify_1( RestL, TP ).
 
listify_1( [C|T], [AC|TP] ) :-
    name( AC, [C] ),
    listify_1( T, TP ).
 
 
/*  listify_word( L+, WordChars-, Rest- ):
        L is WordChars suffixed by Rest; Word chars is the longest
        initial sequence of letters.               
*/
listify_word( [], [], [] ) :- !.
 
listify_word( [C|T], [], [C|T] ) :-
    not( is_letter_char(C) ),
    !.
 
listify_word( [C|T], [C|RestW], RestL ) :-
    listify_word( T, RestW, RestL ).
 
 
/*
Help and farewell messages.
---------------------------
*/
 
 
give_help :-
    output( 'When asked for a pattern, you can type' ), nl,
    output( '    stop' ), nl,
    output( 'or' ), nl,
    output( '    help' ), nl,
    output( 'or (for example)' ), nl,
    output( '    steal' ), nl,
    output( '    ==steal==' ), nl,
    output( '    ==&steal==' ), nl,
    output( '    ==horse==&steal==' ), nl,
    output( '' ), nl,
    output( 'A word on its own (like steal) matches any entry containing' ),nl,
    output( 'exactly that word and no other.' ),nl,
    output( '' ), nl,
    output( 'Double equals signs stand for any number of words,' ), nl,
    output( 'so ==steal== matches "to steal", "steal horses", and so on.' ), nl,
    output( '' ), nl,
    output( 'An & before a word matches any word with those letters in,'), nl,
    output( 'so &steal would match "steal", "stealer", and so on.' ), nl.
 
 
farewell :-
    output(
'Our Canting Alphabet will not extend a Letter farther than T, as far as'~<>
'I can find out; not knowing any Canting word beginning with V, X, Y, Z,'~<>
'although I have made a strict inquiry from some of the most notorious'~<>
'Professors hereof: I have consulted likewise what is printed on this'~<>
'subject, and have slighted no help I could gather from thence, which'~<>
'indeed is very little; the greatest assistance I had in this discovery,'~<>
'was from Newgate; which with much difficulty I screw\'d out of the sullen'~<>
'Rogues, who would not speak a word till I had suppled their tongues with'~<>
'the oil of Barley, or rather thaw\'d their obstinate silence with the'~<>
'heat of strong Liquors.'~<>
''~<>
'From there I understood, that the Mode of Canting alter\'d very often,'~<>
'and that they were forced to change frequently those material words'~<>
'which chiefly discovered their mysterious practices and Villanies, least'~<>
'growing too common their own words should betray them.'~<>
''~<>
'Here in this Vocabulary or little Canting Dictionary, You have all or'~<>
'most of the old words which are still in use, and a many new never'~<>
'published in print, and but very lately minted, such too which have'~<>
'passed the approbation of the Critical Canter. If I seem deficient in'~<>
'the quantity of words, let some else supply my defects, having collected'~<>
'words sufficiently enough for one, if you will have more, take the pains'~<>
'which I have done to be supplyed, and in the mean time be content with'~<>
'what is gathered to your hands.'~
    ).
