'),nl.
/* These routines allow for the annoyingly verbose output. */
dwrite(X) :-
mhdebug,
write(X).
dwrite(_).
dnl :-
mhdebug,
write('
'),
nl.
dnl.
dtab(X) :-
mhdebug,
tab(X).
dtab(_).
/* The following routines get an input word from
the user, check it against the alphabet defined
at the end, and convert it into an appropriate
data structure. */
getword(Word) :-
write('word to parse: '),
read(Word).
makelist(Input,Inputlist) :-
name(Input,Templist),
numchar(Templist,Inputlist).
numchar([],[]).
numchar([H|T],[H1|T1]) :-
name(H1,[H]),
numchar(T,T1).
check([]).
check([H|T]) :-
segment(H),
check(T).
/* each segment has four options: unparsed (u), onset (o),
coda (c), nucleus(n). */
gen([],[]).
gen([H|T],[H/[o,n,c,u]|T2]) :- gen(T,T2).
/* 'doconstraints' applies the constraints to the
input one by one. For each parse, first a full
tableau is created, and then eval is called to
select winning candidates to pass on to the next
parse. */
doconstraints(Final,[],Final).
doconstraints(Theparse,[Topcon|Othercons],Final) :-
formal(Theparse,Tempparse),
It =.. [Topcon,Tempparse,Nextparse],
call(It),
dwrite(Topcon),
dwrite(': '),
dwrite(Theparse),
dwrite(': '),
dwrite(Nextparse),dnl,
doconstraints(Nextparse,Othercons,Final).
/* 'formal' does the housekeeping between constraints */
formal(X,W) :-
formali(X,Y),
formalf(Y,Z),
formalmo(Z,A),
formalmc(A,W).
formali([A/X|B],[A/Y|B]) :- remove(X,c,Y).
formali(X,X).
formalf([A/X],[A/Y]) :- remove(X,o,Y).
formalf([],[]).
formalf([H|T],[H|T2]) :- formalf(T,T2).
formalmc([],[]).
formalmc([A/X|B/[c]],[A/Y|B/[c]]) :- remove(X,o,Y).
formalmc([H,H2|T],[H4,H5|T2]) :-
formalmc([H2|T],[H3|T2]),
formalmc([H|H3],[H4|H5]).
formalmc([H|T],[H|T2]) :- formalmc(T,T2).
formalmo([],[]).
formalmo([A/[o],B/X|T],[A/[o],B/Z|T2]) :-
remove(X,c,Y),
formalmo([B/Y|T],[B/Z|T2]).
formalmo([H|T],[H|T2]) :- formalmo(T,T2).
/* Various basic tasks.... */
contains(X,Y) :- append(_,[Y|_],X).
remove(X,Y,Z) :-
append(P,[Y|Q],X),
append(P,Q,Z),
notempty(Z).
notempty([_]).
notempty([_|T]) :- notempty(T).
append([],L,L).
append([H|T],L,[H|T2]) :- append(T,L,T2).
/* The following routines are responsible for
the different constraints. */
parse([],[]).
parse([Left/Options|Right],[Left/Newoptions|Newright]) :-
remove(Options,u,Newoptions),
parse(Right,Newright).
parse([Left|Right],[Left|Newright]) :- parse(Right,Newright).
onset(X,Z) :-
wonset(X,Y),
monset(Y,Z).
wonset([Y/L1|X],[Y/L2|X]) :- remove(L1,n,L2).
wonset(X,X).
monset([],[]).
monset([First/L1,Second/[n]|Rest],[First/[o],Second/[n]|Newrest]) :-
contains(L1,o),
monset(Rest,Newrest).
monset([H|T],[H|T2]) :- monset(T,T2).
nocoda([],[]).
nocoda([First/L1|Right],[First/L2|Newright]) :-
remove(L1,c,L2),
nocoda(Right,Newright).
nocoda([H|T],[H|T2]) :- nocoda(T,T2).
complex([],[]).
complex([First/[c],Second/L2|Right],[First/[c],Second/L3|Newright]) :-
remove(L2,c,L3),
complex(Right,Newright).
complex([First/[o],Second/L2|Right],[First/[o],Second/L3|Newright]) :-
remove(L2,o,L3),
complex(Right,Newright).
complex([First/L2,Second/[c]|Right],[First/L3,Second/[c]|Newright]) :-
remove(L2,c,L3),
complex(Right,Newright).
complex([First/L2,Second/[o]|Right],[First/L3,Second/[o]|Newright]) :-
remove(L2,o,L3),
complex(Right,Newright).
complex([H|T],[H|T2]) :- complex(T,T2).
vmargin([],[]).
vmargin([V/X|T],[V/Y|T2]) :-
vowel(V),
remove(X,o,Z),
remove(Z,c,Y),
vmargin(T,T2).
vmargin([V/X|T],[V/Y|T2]) :-
vowel(V),
remove(X,o,Y),
vmargin(T,T2).
vmargin([V/X|T],[V/Y|T2]) :-
vowel(V),
remove(X,c,Y),
vmargin(T,T2).
vmargin([H|T],[H|T2]) :- vmargin(T,T2).
cpeak([],[]).
cpeak([C/X|T],[C/Y|T2]) :-
consonant(C),
contains(X,n),
remove(X,n,Y),
cpeak(T,T2).
cpeak([H|T],[H|T2]) :- cpeak(T,T2).
/* The following routines massage the winning candidates
into a visually appropriate form and print them out. */
printlist(Realwinners,Biglist) :-
convert(Realwinners,Biglist),
prettyprint(Biglist,_).
convert([],[[]]).
convert([H|T],New) :-
makecans(H,Cans),
convert(T,T2),
cartesian(Cans,T2,New).
makecans(Seg/[X],[Seg/X]).
makecans(Seg/[H|T],[Seg/H|T2]) :- makecans(Seg/T,T2).
cartesian([],_,[]).
cartesian([H|T],X,Done) :-
cartesian(T,X,Postdone),
ractesian(H,X,Predone),
append(Predone,Postdone,Done).
ractesian(_,[],[]).
ractesian(X,[H|T],[H2|T2]) :-
append([X],H,H2),
ractesian(X,T,T2).
prettyprint([],[]).
prettyprint([H|T],[H6|T2]) :-
dwrite(H),dtab(1),
leftedge(H,H2),
rightedge(H2,H3),
stripseg(H3,H4),
listmake(H4,H5),
name(H6,H5),
write(H6),
write('
'),nl,
prettyprint(T,T2).
listmake([],[]).
listmake([H|T],[X|T1]) :-
name(H,[X]),
listmake(T,T1).
stripseg([],[]).
stripseg([X/_|T],[X|T2]) :- stripseg(T,T2).
stripseg([H|T],[H|T2]) :- stripseg(T,T2).
rightedge(X,Y) :-
marknucr(X,Z),
markcod(Z,Y).
marknucr([],[]).
marknucr([X/n|T],[X/n,')'|T2]) :- marknucr(T,T2).
marknucr([H|T],[H|T2]) :- marknucr(T,T2).
markcod(A,B) :-
append(C,[')',D/c|E],A),
append(C,[D/c,')'|E],F),
markcod(F,B).
markcod(A,A).
leftedge(X,Y) :-
marknuc(X,Z),
markons(Z,Y).
marknuc([],[]).
marknuc([X/n|T],['(',X/n|T2]) :- marknuc(T,T2).
marknuc([H|T],[H|T2]) :- marknuc(T,T2).
markons(A,B) :-
append(C,[D/o,'('|E],A),
append(C,['(',D/o|E],F),
markons(F,B).
markons(A,A).
/* The following facts define the acceptable alphabet */
segment(X) :- vowel(X).
segment(X) :- consonant(X).
vowel(a).
consonant(b).
consonant(c).
consonant(d).
vowel(e).
consonant(f).
consonant(g).
consonant(h).
vowel(i).
consonant(j).
consonant(k).
consonant(l).
consonant(m).
consonant(n).
vowel(o).
consonant(p).
consonant(q).
consonant(r).
consonant(s).
consonant(t).
vowel(u).
consonant(v).
consonant(w).
consonant(x).
consonant(y).
consonant(z).
/* That's all! */