Syllable generator - production rule version

Overview

Operation

User commands

System primitives usable in rules

The procedures and system variables

Sonority

to sonority :segment
;outputs the sonority of segment as numeric value derived from its 
;place in :sonority.scale
op find.sonority :segment :sonority.scale 1 
end

to find.sonority :segment :scale :sonority
;attempts to find :segment in a sub-list of the sonority scale.  if successful,
;outputs the current value of sonority.  since the value of sonority is set at 1 
;when the procedure is called, the final value equals the position of 
;the sublist in the scale. 
if member? :segment first :scale [op :sonority] 
op find.sonority :segment bf :scale :sonority + 1 
end

to pickseg :lo :hi
op pickrandom collect :lo :hi :sonority.scale 1 
end

to collect :lo :hi :scale :count
;hi must be => lo but hi can be > count :scale and lo can be less than 1
if empty? :scale [op [ ]] 
if :lo < 1 [op collect 1 :hi :scale 1] 
if :count > :hi [op [ ]] 
if :count < :lo [op collect :lo :hi bf :scale :count + 1] 
op se first :scale collect :lo :hi bf :scale :count + 1 
end

The sonority scale (derived from Selkirk 1984)

make "sonority.scale [[p t k] [b d g] [f %] [v $ z] [s] [m n] [l] [r] [i u] [e o] [a]]

Production rule engine

to start
reset  
pr [ ] 
pr [starting from the top] 
print1 [working memory:] 
fprint :wm 
go.through :rules 
pr [spellout] 
pr spellout :wm 
end

to go.through :current.rules
if empty? :current.rules [stop] 
local "condition local "action 
make "condition first first :current.rules 
make "action last first :current.rules 
if run :condition 	
     [run :action 	
           show.status :condition :action 	
                   go.through :rules] 
go.through bf :current.rules 
end

to reset
make "wm [syll] 
erprops plnames 
end

to spellout :list
;outputs (as a word string) the segments associated in turn with each
;category in the working memory list - uses a dash where no association obtains 
if empty? :list [op "] 
if list? gprop first :list "assoc [op word "\- spellout bf :list] 
op word gprop first :list "assoc spellout bf :list 
end

to show.status :cond :act
pr [ ] ( pr :condition "\-\> ) 
pr :action 
pr [ ] pr [working memory now:] 
fprint :wm 
end
Additional vocabulary for writing rules
to find? :something
op member? :something :wm 
end

to link :cat :segment
pprop :cat "assoc :segment 
end

to unlinked? :cat
op empty? gprop :cat "assoc 
end

to assoc :cat
op gprop :cat "assoc 
end

to rw :this :that
make "wm replace :this pickrandom :that :wm 
end

A set of productions

make "rules 
[[[find? "syll] [rw "syll [rhyme [onset rhyme]]]] 
[[find? "rhyme] [rw "rhyme [nucleus [nucleus coda]]]] 
[[find? "onset] [rw "onset [clust [clust liq]]]] 
[[find? "clust] [rw "clust [c [sib c]]]] 
[[and find? "v unlinked? "v] [link "v pickseg 9 11]] 
[[find? "nucleus] [rw "nucleus [v [v glide]]]] 
[[and find? "sib unlinked? "sib] [link "sib "s]] 
[[and find? "sib unlinked? "c] [link "c pickseg 1 1]] 
[[and find? "liq unlinked? "c] [link "c pickseg 1 3]] 
[[and find? "liq unlinked? "liq] [link "liq pickseg 7 9]] 
[[find? "coda] [rw "coda [c1 [c1 c2]]]] 
[[and find? "c unlinked? "c] [link "c pickseg 1 9]] 
[[and find? "glide unlinked? "glide] [link "glide pickseg 9 9]] [[and find? "c1 and find? "c2 unlinked? "c1] [link "c1 pickseg 5 8]] [[and find? "c1 unlinked? "c1] [link "c1 pickseg 1 8]] 
[[and find? "c2 unlinked? "c2] [link "c2 pickseg 1 ( sonority assoc "c1 ) - 2]]]

Production rules printed out with printall

condition: 
find? "syll 
action: 
rw "syll [rhyme [onset rhyme]] 

condition: 
find? "rhyme 
action: 
rw "rhyme [nucleus [nucleus coda]] 

condition: 
find? "onset 
action: 
rw "onset [clust [clust liq]] 

condition: 
find? "clust 
action: 
rw "clust [c [sib c]] 

condition: 
and find? "v unlinked? "v 
action: 
link "v pickseg 9 11 

condition: 
find? "nucleus 
action: 
rw "nucleus [v [v glide]] 

condition: 
and find? "sib unlinked? "sib 
action: 
link "sib "s 

condition: 
and find? "sib unlinked? "c 
action: 
link "c pickseg 1 1 

condition: 
and find? "liq unlinked? "c 
action: 
link "c pickseg 1 3 

condition: 
and find? "liq unlinked? "liq 
action: 
link "liq pickseg 7 9 

condition: 
find? "coda 
action: 
rw "coda [c1 [c1 c2]] 

condition: 
and find? "c unlinked? "c 
action: 
link "c pickseg 1 9 

condition: 
and find? "glide unlinked? "glide 
action: 
link "glide pickseg 9 9 

condition: 
and find? "c1 and find? "c2 unlinked? "c1 
action: 
link "c1 pickseg 5 8 

condition: 
and find? "c1 unlinked? "c1 
action: 
link "c1 pickseg 1 8 

condition: 
and find? "c2 unlinked? "c2 
action: 
link "c2 pickseg 1 ( sonority assoc "c1 ) - 2 

Utilities

to printall :list
if empty? :list [stop] 
pr [] 
pr "condition: 
pr first first :list 
pr "action: 
pr last first :list 
printall bf :list 
end

to add
pr 
local "cond local "act 
pr [type a condition and press the enter key:] 
make "cond rl 
pr [type an action and press the enter key:] 
make "act rl 
make "rules lput list :cond :act :rules 
end

to pickrandom :input
op item 1 + random count :input :input 
end

to replace :old.item :new.item :list
;version of replace which substitutes strings for single elements
;uses se not fput (adapted for production system)
if empty? :list [op []] 
if :old.item = first :list [op se :new.item bf :list] 
op se first :list replace :old.item :new.item bf :list 
end

Help

to help
pr [this is a syllable generator implemented as a production rule system] 
pr [working memory - called "wm - is a single list of categories] 
pr [production memory - called "rules - is a list of rules] 
pr [each rule is a list containing a condition list followed by an action list] 
pr [* * * * * operation * * * * *] 
pr [rules are tested from first to last.] 
pr [if running the condition of a rule returns "true the action is run] 
pr [and the rules are then cycled through again from the beginning] 
pr [otherwise the next rule is tested.] 
pr [if there are no rules left to test, then the system stops.] 
pr [* * * * * commands * * * * *] 
pr [to check working memory type: pr :wm] 
pr [to reset working memory to [syll] type: reset] 
pr [to run the system, type: go.through :rules] 
pr [to reset working memory and then run the system - just type: start] 
pr [to print out the rules, type: printall :rules] 
pr [to add a rule, type: add and follow the instructions] 
pr [* * * * * primitives usable in rules * * * * *] 
pr [find? :arg1 outputs "true if :arg1 is found in working memory] 
pr [rw :arg1 :arg2 replaces :arg1 in wm by a random selection from arg2] 
pr [link :category :segment associates a terminal category with a segment] 
pr [unlinked? :category outputs "true if the category is unassociated] 
pr [assoc :category outputs the segment associated with the category] 
pr [pickseg :lo :hi outputs a random segment with sonority between lo and hi] 
pr [sonority :segment outputs the sonority value of the segment] 
end

A sample run

start

starting from the top 
working memory: [syll] 

find? "syll -> 
rw "syll [rhyme [onset rhyme]] 

working memory now: 
[onset rhyme] 

find? "rhyme -> 
rw "rhyme [nucleus [nucleus coda]] 

working memory now: 
[onset nucleus coda] 

find? "onset -> 
rw "onset [clust [clust liq]] 

working memory now: 
[clust liq nucleus coda] 

find? "clust -> 
rw "clust [c [sib c]] 

working memory now: 
[sib c liq nucleus coda] 

find? "nucleus -> 
rw "nucleus [v [v glide]] 

working memory now: 
[sib c liq v coda] 

and find? "v unlinked? "v -> 
link "v pickseg 9 11 

working memory now: 
[sib c liq v coda] 

and find? "sib unlinked? "sib -> 
link "sib "s 

working memory now: 
[sib c liq v coda] 

and find? "sib unlinked? "c -> 
link "c pickseg 1 1 

working memory now: 
[sib c liq v coda] 

and find? "liq unlinked? "liq -> 
link "liq pickseg 7 9 

working memory now: 
[sib c liq v coda] 

find? "coda -> 
rw "coda [c1 [c1 c2]] 

working memory now: 
[sib c liq v c1] 

and find? "c1 unlinked? "c1 -> 
link "c1 pickseg 1 8 

working memory now: 
[sib c liq v c1] 
spellout 
stiil