;;; -*- Mode: TDL; Coding: utf-8 -*- 

;;; HAG (Hausa Grammar)
;;; Author: Berthold Crysmann 
;;; 2009

;;; Types for suprasegmentals

;;; Added type l-h*-list
;;; Needs termination of tone lists (<>)
;;; Will not permit tonelist concatenation


word-or-lexrule :+ [MORPH *top*].

word :+ [SUPRA supra_reent].

lex-item :+ [SUPRA  
		    [PRFX [TONE <! !>,
			   LEN <! !>]]]. 


;;; Reentrancy for MCLASS may have to be relaxed once we derive grade 4, 5, 6, 7


lex-rule :+ [SYNSEM [POLTONE #pol,
		     MODIFIABLE #m,
		     BOUND #expr,
		     LIGHT #light],
	     STEM [FROM #from,
		   TO #to],
	     ROBUST #r,
	     SUPRA [PRFX [TONE [LAST #tlast],
			  LEN [LIST #prfx,
			       LAST #llast]],
		    LEN [LAST #llast],
		    TM  #tm,
		    LM #lm],
	     DTR [SYNSEM [POLTONE #pol,
			  LIGHT #light,
			  MODIFIABLE #m,
			  BOUND #expr],
		  STEM [FROM #from,
			TO #to],
		  ROBUST #r,
		  SUPRA [PRFX [TONE [LAST #tlast]],
			 LEN [LAST #prfx],
			 TM #tm,
			 LM #lm]]].


same-mclass-lex-rule :=
		       lex-rule &
		       [MORPH.MCLASS #morph,
			DTR.MORPH.MCLASS #morph].


same-tone-lex-rule :=
		     lex-rule & 
		     [SUPRA [PRFX [TONE <! !>],
			     TONE #tone],
		      DTR [SUPRA.TONE #tone]].

same-len-lex-rule :=
		    lex-rule & 
		    [SUPRA [PRFX.LEN <! !>,
			    LEN.LIST #len],
		     DTR [SUPRA.LEN.LIST #len]].

shorten-lex-rule :=
		   lex-rule & 
		   [SUPRA.LEN [LIST < short . #len >],
		    DTR [SUPRA.LEN [LIST <[] . #len>]]].

lengthen-lex-rule :=
		    lex-rule & 
		    [SUPRA.LEN [LIST < long . #len >],
		     DTR [SUPRA.LEN [LIST <[] . #len>]]].



		     
same-supra-lex-rule :=
		      same-tone-lex-rule & 	
		      same-len-lex-rule. 

no-prefix-len-lex-rule := lex-rule & 
			  [SUPRA.PRFX [LEN <! !>]].

no-prefix-lex := lex-item & 
		 [SUPRA.PRFX [LEN <! !>,
			      TONE <! !>]].


no-prefix-tone-lex-rule := 
			  lex-rule &
			  [SUPRA.PRFX [TONE #tone],
			   DTR.SUPRA.PRFX [TONE #tone]]. 

no-prefix-lex-rule := 
		  no-prefix-tone-lex-rule &
		  no-prefix-len-lex-rule. 
			  


none-tone-lex-rule := 
		      lex-rule &
		      [SUPRA [--TONES #lt,
			      --LENGTHS #ll,
			      TONE.LIST #tlist,
			      TONES [LIST < #tlist, ...> ,
				     LAST #ltl], 
			      LEN.LIST #llist,
			      LENGTHS [LIST < #llist, ... >,
				       LAST #lll]
				      ],
		       DTR [SUPRA [--TONES #lt,
				   TONES [LAST #ltl],
				   --LENGTHS #ll, 
				   LENGTHS  [LAST #lll]
					   ]]].

;; was: supra_noreent
inflecting-lex-rule := none-tone-lex-rule &
		       [ SUPRA supra,
			 DTR.SUPRA supra,
			 NEEDS-AFFIX + ].




constant-lex-rule := none-tone-lex-rule &
		     [ STEM #stem,
		       DTR [ STEM #stem ]].

;		     no-prefix-lex-rule &


sign :+ 
	[SUPRA supra].

lexkeys :+ 
	   [--TONE list & #tones,
	    SYLS supra_min & [TONE.LIST #tones]].



supra_min := avm &
	     [LEN diff-list & [LIST length-marked-list],
	      TONE diff-list  ].

;;; Keep this for qc compatibility, until we recompute
synsem :+ [POLTONE tone].

;;; POL exposes polarity sensitive tone
;;; Quality gets restricted by right neighbour (set from left daughter's 
;;; TONES.LIST.FIRST.FIRST in binary rules)

supra := supra_min &
	 [PRFX supra_min,
	  TM diff-list,
	  LM diff-list,
	  TONES diff-list &  [LIST tm-llist],
	  LENGTHS diff-list,
	  --TONES diff-list,
	  --LENGTHS diff-list].

supra_noreent := supra.


supra_reent := supra &
	       [PRFX [TONE #t-prfx, 
		      LEN.LAST null],
		TONE [LIST #tl,
		      LAST null],
		LEN [LIST.--TL #tl,
		     LAST null & [--TL.--LEFT #t-prfx]]].
; ,
; 		TONES #lt,
; 		LENGTHS #ll,
; 		--TONES #lt,
; 		--LENGTHS #ll].



;;; List of lists to impose sentence-wide consistency


um-llist := list.

tm-llist := list.
; tm-clist := cons & 
; 	    tm-llist &
; 	    [FIRST tone-marked-list & <#pol,...> ,
; 	     REST tm-llist & [--POL #pol]].

tm-clist := cons & 
 	    tm-llist &
 	    [FIRST tone-marked-list,
	     REST tm-llist].

tm-nlist := tm-llist & null.

hm-llist := tm-llist.
hm-clist := tm-clist & 
	    hm-llist &
	    [FIRST high-marked-list, 
	     REST hm-llist].
hm-nlist := hm-llist & tm-nlist.

lm-llist := tm-llist.
lm-clist := tm-clist & 
	    lm-llist &
	    [FIRST low-marked-list, 
	     REST lm-llist].
lm-nlist := lm-llist & tm-nlist.

fm-llist := hm-llist & lm-llist.
fm-clist := hm-clist & 
	    lm-clist & 
	    fm-llist &
	    [FIRST full-marked-list, 
	     REST fm-llist].
fm-nlist := fm-llist  & hm-nlist & lm-nlist.

lenm-llist := list.
lenm-clist := cons & 
	    lenm-llist &
	    [FIRST length-marked-list, 
	     REST lenm-llist].
lenm-nlist := lenm-llist & null.

longm-llist := lenm-llist.
longm-clist := lenm-clist & 
	       longm-llist &
	       [FIRST long-marked-list, 
		REST longm-llist].
longm-nlist := longm-llist & lenm-nlist.



;;; SUPRA type propagation

lex-item :+ [MORPH.MCLASS #mclass,
	     SUPRA [TONE #tone,
		    LEN #len],
	     SYNSEM.LKEYS [--MCLASS #mclass,
			   SYLS [TONE #tone,
				 LEN #len]]].


basic-unary-phrase :+
		     [ROBUST #r, 
		      ARGS <[ROBUST #r]> ].

unary-phrase :+ 
		[STEM [FROM #from,
		       TO #TO],
		 SYNSEM.POLTONE #pol,
		 SUPRA [TONE [LIST <>,
			      LAST <>],
			LEN  [LIST <>,
			      LAST <>],
			TM #tm,
			LM #lm,
			LENGTHS #ll,
			TONES #lt], 
		 ARGS <[SYNSEM.POLTONE #pol,
			STEM [FROM #from,
			      TO #TO],
			MORPH.COMPLETE +,
			SUPRA supra_reent & 
				       [TM #tm,
					LM #lm,
					LENGTHS #ll,
					TONES #lt ]]>].

supra-binary-phrase :=
		      phrase-or-lexrule &		      
		      [STEM [FROM #from,
			     TO #TO],
		       ROBUST #r, 
		       SYNSEM.POLTONE #pol,
		       SUPRA [TONE [LIST <>,
				    LAST <>],
			      LEN  [LIST <>,
				     LAST <>],
			       TM [LIST #tm1,
				   LAST #tm3],
			       LM [LIST #lm1,
				   LAST #lm3],
			       TONES [LIST #lt1,
				      LAST #lt3],
			       LENGTHS [LIST #ll1,
					LAST #ll3]],
			ARGS <[SYNSEM.POLTONE #pol,
			       STEM [FROM #from],
			       ROBUST #r,
			       SUPRA supra_reent &
				    [TM [LIST #tm2,
					 LAST #tm3],
				     LM [LIST #lm2,
					 LAST #lm3],
				     TONES [LIST #lt2 & < < #polarity,...>,...>,
					    LAST #lt3],
				     LENGTHS [LIST #ll2,
					      LAST #ll3]
					]],
			      [STEM [TO #TO],
			       ROBUST #r,
			       SYNSEM.POLTONE #polarity,
			       SUPRA supra_reent & 
				    [TM [LIST #tm1,
					 LAST #tm2],
				     LM [LIST #lm1,
					 LAST #lm2],
				     TONES [LIST #lt1,
					    LAST #lt2],
				     LENGTHS [LIST #ll1,
					      LAST #ll2]]]>].


basic-binary-phrase :+ 
		       supra-binary-phrase &
		       [ARGS <[MORPH.COMPLETE +],
			      [MORPH.COMPLETE +]>].


;;; Tones

length := *top*.

long := length.
short := length.
ulength := length.

;;; long is marked, short is unmarked
length_ := length.
long_ := long & length_.
short_ := short & ulength & length_.


;;; short is marked, long is unmarked
_length := length.
_long := long & ulength & _length.
_short := short & _length.




tone-min := *top*. 

tone := *top* & [POL tone-marked-list].

low-final := tone & [POL <high-initial,...>].

; poltone := tone & [POL tone]. 

high-initial := tone.  

high := high-initial & [POL <low,...>].
low := low-final.
utone := tone.

; phigh := poltone & high & [POL low]. 
; plow-final := poltone & low-final & [POL high].
; pfall := plow-final & fall. 
; plow := plow-final & low. 

;;; high is marked, low is unmarked
tone_ := tone.
utone_ := tone_ & utone.

low-final_ := low-final & tone_.
ulow-final := low-final & utone.
high_ := high & tone_ .
low_ := low & low-final_.
ulow_ := low_ & utone_ & ulow-final.

;;; low is marked, high is unmarked
_tone := tone.
_utone := _tone & utone.

_low-final := low-final & _tone.
_high := high & _tone.
_low := low & _low-final.

_uhigh := _high & _utone.

;;; Everything is marked
_tone_ := tone_ & _tone.
_low-final_ := _tone_ & low-final_ & _low-final. 
_high_ := _tone_ & high_ & _high.
_low_ := _low-final_ & _low & low_.

;;; fall is always marked
fall := low-final & high-initial. 

_fall :=  fall & _low-final. 
fall_ :=  fall & low-final_. 
_fall_ := fall_ & _fall & _low-final_.
ufall := fall & ulow-final. 



;;; Enforce consistent use of tone/length marking (H/L/none)

tone-marked-list := list.
tone-marked-cons := tone-marked-list & 
		    cons & 
 		    [FIRST tone].

tone-marked-null := null & tone-marked-list.

high-marked-list :=  tone-marked-list.
high-marked-null :=  high-marked-list & tone-marked-null.
high-marked-cons :=  high-marked-list & 
		     tone-marked-cons & 
		     [FIRST tone_,
		      REST high-marked-list].



low-marked-list :=  tone-marked-list.
low-marked-null :=  low-marked-list & tone-marked-null.
low-marked-cons :=  low-marked-list & 
		    tone-marked-cons & 
		    [FIRST _tone,
		     REST low-marked-list].


full-marked-list :=  low-marked-list & high-marked-list.
full-marked-null :=  full-marked-list & high-marked-null & low-marked-null.
full-marked-cons :=  full-marked-list & 
		     high-marked-cons & 
		     low-marked-cons &
		     [FIRST _tone_,
		      REST full-marked-list].


;;; Synchronise suprasegmental tiers
supra-list := list & [--LT diff-list,
		      --TL list].
supra-cons := supra-list &
	      cons &
	      [FIRST #len,
	       --LT [LIST <#len . #lt>,
		     LAST #last],
	       --TL cons & [REST #tl],
	       REST [--LT [LIST #lt,
			   LAST #last],
		     --TL #tl]].

supra-null := supra-list &
	      null &
	      [--LT <! !>,
	       --TL <>].

length-marked-list := supra-list.
0-1-length-marked-list := length-marked-list & 0-1-list.
length-marked-cons := supra-cons & length-marked-list.
1-length-marked-list := 1-list & length-marked-cons & 0-1-length-marked-list. 
length-marked-null := supra-null & 0-1-length-marked-list.

long-marked-list := length-marked-list.
0-1-long-marked-list := long-marked-list & 0-1-length-marked-list.

long-marked-cons := length-marked-cons & long-marked-list &
		    [FIRST length_,
		     REST long-marked-list].
1-long-marked-list := long-marked-cons & 0-1-long-marked-list & 1-length-marked-list.
long-marked-null := length-marked-null & 0-1-long-marked-list.

short-marked-list := length-marked-list.
0-1-short-marked-list := short-marked-list & 0-1-length-marked-list.
short-marked-cons := length-marked-cons & short-marked-list &
		    [FIRST _length,
		     REST short-marked-list].
1-short-marked-list := short-marked-cons & 0-1-short-marked-list & 1-length-marked-list.

short-marked-null := length-marked-null & 0-1-short-marked-list.



;;; Tone pattern lists
;;; Naming convention for list types is left to right
;;; Underlying lists are reversed (right to left)

t*-list := tone-marked-list & [--LEFT diff-list ].

t*-cons := tone-marked-cons &
	   t*-list &
	   [FIRST #tone,
	    REST t*-list & [--LEFT [LIST < #tone . #rest>,
				    LAST #slist]],
	    --LEFT [LIST #rest,
		    LAST #slist]
		    ].

t*-null := t*-list & tone-marked-null.


t*-lm-list := low-marked-list & t*-list. 
t*-lm-cons := t*-lm-list & t*-cons & low-marked-cons. 
t*-lm-null := t*-lm-list & t*-null & low-marked-null. 

t*-hm-list := high-marked-list & t*-list. 
t*-hm-cons := t*-hm-list  & t*-cons & high-marked-cons.  
t*-hm-null := t*-hm-list & t*-null & high-marked-null. 

t*-fm-list := full-marked-list & t*-hm-list & t*-lm-list. 
t*-fm-cons := t*-fm-list  & t*-hm-cons & t*-lm-cons & full-marked-cons.  
t*-fm-null := t*-fm-list & t*-hm-null & t*-lm-null & full-marked-null. 



h*-list := t*-list & [--LEFT.LAST proto-h*-list].

h*-cons := h*-list & 		  
	   t*-cons & 
	   [FIRST high,
	    REST h*-list]. 

h*-null := h*-list & t*-null & proto-h*-null. 

proto-h*-list := tone-marked-list.  

proto-h*-cons := proto-h*-list & tone-marked-cons &
		 [FIRST high,
		  REST proto-h*-list].  

proto-h*-null := proto-h*-list &
		 tone-marked-null.

l*-list := t*-list & [--LEFT.LAST proto-l*-list].

l*-cons := l*-list & 
	   t*-cons &
	   [FIRST low,
	    REST l*-list]. 

l*-null := l*-list & t*-null & proto-l*-null. 


proto-l*-list := tone-marked-list.  

proto-l*-cons := proto-l*-list & tone-marked-cons &
		 [FIRST low,
		  REST proto-l*-list].  

proto-l*-null := proto-l*-list &
		 tone-marked-null.




h*-lm-list := t*-lm-list & h*-list. 
h*-lm-cons := h*-lm-list & h*-cons & t*-lm-cons. 
h*-lm-null := h*-lm-list & h*-null & t*-lm-null. 

h*-hm-list := t*-hm-list & h*-list. 
h*-hm-cons := h*-hm-list  & h*-cons & t*-hm-cons.  
h*-hm-null := h*-hm-list & h*-null & t*-hm-null. 

h*-fm-list := t*-fm-list & h*-hm-list & h*-lm-list. 
h*-fm-cons := h*-fm-list  & h*-hm-cons & h*-lm-cons & t*-fm-cons.  
h*-fm-null := h*-fm-list & h*-hm-null & h*-lm-null & t*-fm-null. 


l*-lm-list := t*-lm-list & l*-list. 
l*-lm-cons := l*-lm-list  & l*-cons & t*-lm-cons. 
l*-lm-null := l*-lm-list & l*-null & t*-lm-null. 

l*-hm-list := t*-hm-list & l*-list. 
l*-hm-cons := l*-hm-list & l*-cons & t*-hm-cons. 
l*-hm-null := l*-hm-list & l*-null & t*-hm-null. 

l*-fm-list := t*-fm-list & l*-hm-list & l*-lm-list. 
l*-fm-cons := l*-fm-list  & l*-hm-cons & l*-lm-cons & t*-fm-cons.  
l*-fm-null := l*-fm-list & l*-hm-null & l*-lm-null & t*-fm-null. 

;;; Non-empty lists


l*-h-cons := tone-marked-cons & [FIRST high,
			       REST l*-list].
l*-h-lm-cons := l*-h-cons & low-marked-cons. 
l*-h-hm-cons := l*-h-cons & high-marked-cons. 
l*-h-fm-cons := l*-h-hm-cons & l*-h-lm-cons & full-marked-cons.  


l*-h-hl-cons := tone-marked-cons & [FIRST fall,
			       REST l*-h-cons].
l*-h-hl-lm-cons := l*-h-hl-cons & low-marked-cons. 
l*-h-hl-hm-cons := l*-h-hl-cons & high-marked-cons. 
l*-h-hl-fm-cons := l*-h-hl-hm-cons & l*-h-hl-lm-cons & full-marked-cons.  


l*-h-h-cons := tone-marked-cons & [FIRST high,
			       REST l*-h-cons].
l*-h-h-lm-cons := l*-h-h-cons & low-marked-cons. 
l*-h-h-hm-cons := l*-h-h-cons & high-marked-cons. 
l*-h-h-fm-cons := l*-h-h-hm-cons & l*-h-h-lm-cons & full-marked-cons. 


l*-h-h-h-cons := tone-marked-cons & [FIRST high,
			       REST l*-h-h-cons].
l*-h-h-h-lm-cons := l*-h-h-h-cons & low-marked-cons. 
l*-h-h-h-hm-cons := l*-h-h-h-cons & high-marked-cons. 
l*-h-h-h-fm-cons := l*-h-h-h-hm-cons & l*-h-h-h-lm-cons & full-marked-cons. 


l*-h-h-h-l-cons := tone-marked-cons & [FIRST low,
			       REST l*-h-h-h-cons].
l*-h-h-h-l-lm-cons := l*-h-h-h-l-cons & low-marked-cons. 
l*-h-h-h-l-hm-cons := l*-h-h-h-l-cons & high-marked-cons. 
l*-h-h-h-l-fm-cons := l*-h-h-h-l-hm-cons & l*-h-h-h-l-lm-cons & full-marked-cons. 


l*-h-h-l-cons := tone-marked-cons & [FIRST low,
			       REST l*-h-h-cons].
l*-h-h-l-lm-cons := l*-h-h-l-cons & low-marked-cons. 
l*-h-h-l-hm-cons := l*-h-h-l-cons & high-marked-cons. 
l*-h-h-l-fm-cons := l*-h-h-l-hm-cons & l*-h-h-l-lm-cons & full-marked-cons. 


l*-h-h-l-h-cons := tone-marked-cons & [FIRST high,
			       REST l*-h-h-l-cons].
l*-h-h-l-h-lm-cons := l*-h-h-l-h-cons & low-marked-cons. 
l*-h-h-l-h-hm-cons := l*-h-h-l-h-cons & high-marked-cons. 
l*-h-h-l-h-fm-cons := l*-h-h-l-h-hm-cons & l*-h-h-l-h-lm-cons & full-marked-cons. 



h*-l-cons := tone-marked-cons & [FIRST low,
			       REST h*-list].

;;; HERE
h*-l-lm-cons := h*-l-cons & low-marked-cons. 
h*-l-hm-cons := h*-l-cons & high-marked-cons. 
h*-l-fm-cons := h*-l-hm-cons & h*-l-lm-cons & full-marked-cons. 

h*-l-l-cons := tone-marked-cons & [FIRST low,
						 REST h*-l-cons].

h*-l-l-lm-cons := h*-l-l-cons & low-marked-cons. 
h*-l-l-hm-cons := h*-l-l-cons & high-marked-cons. 
h*-l-l-fm-cons := h*-l-l-hm-cons & h*-l-l-lm-cons & full-marked-cons. 

h*-l-l-l-cons := tone-marked-cons & [FIRST low,
						 REST h*-l-l-cons].

h*-l-l-l-lm-cons := h*-l-l-l-cons & low-marked-cons. 
h*-l-l-l-hm-cons := h*-l-l-l-cons & high-marked-cons. 
h*-l-l-l-fm-cons := h*-l-l-l-hm-cons & h*-l-l-l-lm-cons & full-marked-cons. 

h*-l-l-l-h-cons := tone-marked-cons & [FIRST high,
				       REST h*-l-l-l-cons].

h*-l-l-l-h-lm-cons := h*-l-l-l-h-cons & low-marked-cons. 
h*-l-l-l-h-hm-cons := h*-l-l-l-h-cons & high-marked-cons. 
h*-l-l-l-h-fm-cons := h*-l-l-l-h-hm-cons & h*-l-l-l-h-lm-cons & full-marked-cons. 

h*-l-l-h-cons := tone-marked-cons & [FIRST high,
				     REST h*-l-l-cons].

h*-l-l-h-lm-cons := h*-l-l-h-cons & low-marked-cons. 
h*-l-l-h-hm-cons := h*-l-l-h-cons & high-marked-cons. 
h*-l-l-h-fm-cons := h*-l-l-h-hm-cons & h*-l-l-h-lm-cons & full-marked-cons. 



;;;

h*-hl-cons := tone-marked-cons & 
	      [FIRST fall,
	       REST h*-list].
h*-hl-lm-cons := h*-hl-cons & low-marked-cons. 
h*-hl-hm-cons := h*-hl-cons & high-marked-cons. 
h*-hl-fm-cons := h*-hl-hm-cons & h*-hl-lm-cons & full-marked-cons. 


h*-hl-hl-cons := tone-marked-cons & 
		 [FIRST fall,
		  REST h*-hl-cons].
h*-hl-hl-lm-cons := h*-hl-hl-cons & low-marked-cons. 
h*-hl-hl-hm-cons := h*-hl-hl-cons & high-marked-cons. 
h*-hl-hl-fm-cons := h*-hl-hl-hm-cons & h*-hl-hl-lm-cons & full-marked-cons. 

h*-hl-hl-h-cons := tone-marked-cons & 
		   [FIRST high,
		    REST h*-hl-hl-cons].
h*-hl-hl-h-lm-cons := h*-hl-hl-h-cons & low-marked-cons. 
h*-hl-hl-h-hm-cons := h*-hl-hl-h-cons & high-marked-cons. 
h*-hl-hl-h-fm-cons := h*-hl-hl-h-hm-cons & h*-hl-hl-h-lm-cons & full-marked-cons. 


h*-l-h-cons := tone-marked-cons & 
	       [FIRST high,
		REST h*-l-cons].
h*-l-h-lm-cons := h*-l-h-cons & low-marked-cons. 
h*-l-h-hm-cons := h*-l-h-cons & high-marked-cons. 
h*-l-h-fm-cons := h*-l-h-hm-cons & h*-l-h-lm-cons & full-marked-cons. 

h*-l-h-l-cons := tone-marked-cons & 
		 [FIRST low,
		  REST h*-l-h-cons].

h*-l-h-l-lm-cons := h*-l-h-l-cons & low-marked-cons. 
h*-l-h-l-hm-cons := h*-l-h-l-cons & high-marked-cons. 
h*-l-h-l-fm-cons := h*-l-h-l-hm-cons & h*-l-h-l-lm-cons & full-marked-cons. 


h*-hl-h-cons := tone-marked-cons & 
		[FIRST high,
		 REST h*-hl-cons].
h*-hl-h-lm-cons := h*-hl-h-cons & low-marked-cons. 
h*-hl-h-hm-cons := h*-hl-h-cons & high-marked-cons. 
h*-hl-h-fm-cons := h*-hl-h-hm-cons & h*-hl-h-lm-cons & full-marked-cons. 


h*-hl-h-l-cons := tone-marked-cons & 
		  [FIRST low,
		   REST h*-hl-h-cons].
h*-hl-h-l-lm-cons := h*-hl-h-l-cons & low-marked-cons. 
h*-hl-h-l-hm-cons := h*-hl-h-l-cons & high-marked-cons. 
h*-hl-h-l-fm-cons := h*-hl-h-l-hm-cons & h*-hl-h-l-lm-cons & full-marked-cons. 


h*-hl-l-cons := tone-marked-cons & 
		[FIRST low,
		 REST h*-hl-cons].
h*-hl-l-lm-cons := h*-hl-l-cons & low-marked-cons. 
h*-hl-l-hm-cons := h*-hl-l-cons & high-marked-cons. 
h*-hl-l-fm-cons := h*-hl-l-hm-cons & h*-hl-l-lm-cons & full-marked-cons. 



l*-h-l-cons := tone-marked-cons &
	       [FIRST low,
		REST l*-h-cons].
l*-h-l-lm-cons := l*-h-l-cons & low-marked-cons. 
l*-h-l-hm-cons := l*-h-l-cons & high-marked-cons. 
l*-h-l-fm-cons := l*-h-l-hm-cons & l*-h-l-lm-cons & full-marked-cons. 


l*-h-l-l-cons := tone-marked-cons &
		 [FIRST low,
		  REST l*-h-l-cons].
l*-h-l-l-lm-cons := l*-h-l-l-cons & low-marked-cons. 
l*-h-l-l-hm-cons := l*-h-l-l-cons & high-marked-cons. 
l*-h-l-l-fm-cons := l*-h-l-l-hm-cons & l*-h-l-l-lm-cons & full-marked-cons. 


l*-hl-cons := tone-marked-cons &
	      [FIRST fall,
	       REST l*-list].
l*-hl-lm-cons := l*-hl-cons & low-marked-cons. 
l*-hl-hm-cons := l*-hl-cons & high-marked-cons. 
l*-hl-fm-cons := l*-hl-hm-cons & l*-hl-lm-cons & full-marked-cons. 


l*-hl-h-cons := tone-marked-cons &
		[FIRST high,
		 REST l*-hl-cons].
l*-hl-h-lm-cons := l*-hl-h-cons & low-marked-cons. 
l*-hl-h-hm-cons := l*-hl-h-cons & high-marked-cons. 
l*-hl-h-fm-cons := l*-hl-h-hm-cons & l*-hl-h-lm-cons & full-marked-cons. 


h*-l-hl-cons := tone-marked-cons &
		[FIRST fall,
		 REST h*-l-cons].

h*-l-hl-lm-cons := h*-l-hl-cons & low-marked-cons. 
h*-l-hl-hm-cons := h*-l-hl-cons & high-marked-cons. 
h*-l-hl-fm-cons := h*-l-hl-hm-cons & h*-l-hl-lm-cons & full-marked-cons. 

h*-l-hl-h-cons := tone-marked-cons &
		  [FIRST high,
		   REST h*-l-hl-cons].
h*-l-hl-h-lm-cons := h*-l-hl-h-cons & low-marked-cons. 
h*-l-hl-h-hm-cons := h*-l-hl-h-cons & high-marked-cons. 
h*-l-hl-h-fm-cons := h*-l-hl-h-hm-cons & h*-l-hl-h-lm-cons & full-marked-cons. 


h*-l-h-h-cons := tone-marked-cons & 
		 [FIRST high,
		  REST h*-l-h-cons].
h*-l-h-h-lm-cons := h*-l-h-h-cons & low-marked-cons. 
h*-l-h-h-hm-cons := h*-l-h-h-cons & high-marked-cons. 
h*-l-h-h-fm-cons := h*-l-h-h-hm-cons & h*-l-h-h-lm-cons & full-marked-cons. 


h*-l-h-h-h-cons := tone-marked-cons & 
		   [FIRST high,
		    REST h*-l-h-h-cons].
h*-l-h-h-h-lm-cons := h*-l-h-h-h-cons & low-marked-cons. 
h*-l-h-h-h-hm-cons := h*-l-h-h-h-cons & high-marked-cons. 
h*-l-h-h-h-fm-cons := h*-l-h-h-h-hm-cons & h*-l-h-h-h-lm-cons & full-marked-cons. 


h*-l-h-h-l-cons := tone-marked-cons & 
		   [FIRST low,
		    REST h*-l-h-h-cons].
h*-l-h-h-l-lm-cons := h*-l-h-h-l-cons & low-marked-cons. 
h*-l-h-h-l-hm-cons := h*-l-h-h-l-cons & high-marked-cons. 
h*-l-h-h-l-fm-cons := h*-l-h-h-l-hm-cons & h*-l-h-h-l-lm-cons & full-marked-cons. 



l*-h-l-h-cons := tone-marked-cons &
		 [FIRST high,
		  REST l*-h-l-cons].
l*-h-l-h-lm-cons := l*-h-l-h-cons & low-marked-cons. 
l*-h-l-h-hm-cons := l*-h-l-h-cons & high-marked-cons. 
l*-h-l-h-fm-cons := l*-h-l-h-hm-cons & l*-h-l-h-lm-cons & full-marked-cons. 

l*-h-l-h-l-cons := tone-marked-cons &
		   [FIRST low,
		    REST l*-h-l-h-cons].
l*-h-l-h-l-lm-cons := l*-h-l-h-l-cons & low-marked-cons. 
l*-h-l-h-l-hm-cons := l*-h-l-h-l-cons & high-marked-cons. 
l*-h-l-h-l-fm-cons := l*-h-l-h-l-hm-cons & l*-h-l-h-l-lm-cons & full-marked-cons. 


;;; Complex melodies for loans



l*-h-l-h-h-cons := tone-marked-cons &
		   [FIRST high,
		    REST l*-h-l-h-cons].



h*-l-h-l-h-cons := tone-marked-cons &
		   [FIRST high,
		    REST h*-l-h-l-cons].



h*-l-l-hl-cons := tone-marked-cons &
		  [FIRST fall,
		   REST h*-l-l-cons].




l*-h-l-hl-cons := tone-marked-cons &
		  [FIRST fall,
		   REST l*-h-l-cons].




h*-hl-h-h-l-cons := tone-marked-cons &
		     [FIRST low,
		      REST [FIRST high,
			    REST h*-hl-h-cons]].


h*-l-l-h-l-cons := tone-marked-cons &
		   [FIRST low,
		    REST h*-l-l-h-cons].




h*-l-l-h-h-l-cons := tone-marked-cons &
		     [FIRST low,
		      REST [FIRST high,
			    REST h*-l-l-h-cons]].






;;; inflectional rules to register tonal information

;;; tone-irule does not inherit from inflecting-lex-rule
;;; Types inflecting-lex-rule and constant-lex-rule are specified to set 
;;; LENGTH/TONES 
;;; from their local TONE and LEN specifications. 
;;; All standard lexical rules should inherit from one of these two types.
 
tone-irule :=
	     nocoord &
	     lex-rule &
	     [ARG-ST #arg-st,
	      NEEDS-AFFIX +,
	      INFLECTED infl-word,
	      SYNSEM #synsem,
	      SUPRA  [TM <! [] !>,
		      LM <! [] !>,
		      LENGTHS #ll & [LIST < [] . #lll >,
				   LAST #lll],
		      TONES #lt & [LIST < [] . #ltl >,
				    LAST #ltl],
		      TONE [LIST #tone,
			    LAST #tlast & <>],
		      LEN [LIST #len,
			   LAST #llast & <>]],
	      DTR [ARG-ST #arg-st,
		   INFLECTED infl-word,
		   SYNSEM #synsem,
		   SUPRA [TONES #lt,
			  LENGTHS #ll,
			  TONE [LIST <tone . #tone>,
				LAST #tlast],
			  LEN [LIST <length . #len>,
			       LAST #llast]]]].
	      

lowtone-irule :=
		diacritic-irule &
		[SUPRA [TM <! lm-clist !>],
		 DTR [SUPRA [TONE.LIST <low, ...>]]].

hightone-irule :=
		 diacritic-irule & 
		 [SUPRA [TM <! hm-clist !> ],
		  DTR [SUPRA [TONE.LIST <high, ...>]]].

longvow-irule :=
		diacritic-irule &
		[DTR [SUPRA [LM <! longm-clist !>,
			     LEN.LIST <long, ...>]]].

shortvow-irule :=
		 diacritic-irule &
		 [DTR [SUPRA [LEN.LIST <short, ...>]]].

diacritic-irule :=
		  tone-irule & 
		  [SUPRA [TM <! tm-clist !>]].
	     	     

highlong-irule :=
		 hightone-irule &
		 longvow-irule.

highshort-irule :=
		 hightone-irule &
		 shortvow-irule.

lowlong-irule :=
		 lowtone-irule &
		 longvow-irule.

lowshort-irule :=
		 lowtone-irule &
		 shortvow-irule.




;;; Tone/Length patterns

_monosyl_ := supra & [TONE <! [] !>,
		      LEN <! [] !>].

_bisyl_ := supra & [TONE <! [],[] !>,
		    LEN <! [],[] !> ].

_trisyl_ := supra & [TONE <! [],[],[] !>,
		     LEN <! [],[],[] !>].

_quadsyl_ := supra & [TONE <! [],[],[],[] !>,
		      LEN <! [],[],[],[] !>].

_pentasyl_ := supra & [TONE <! [], [],[],[],[] !>,
		      LEN <! [], [],[],[],[] !>].

_hexasyl_ := supra & [TONE <! [], [], [],[],[],[] !> ,
		      LEN <! [], [], [],[],[],[] !>].

_short_ := _monosyl_  & [LEN <! short !>]. 
_long_ := _monosyl_  & [LEN <! long !>]. 


_long_long_ := _bisyl_  & [LEN <! long,long !>]. 
_short_short_ := _bisyl_  & [LEN <! short, short !>]. 
_long_short_ := _bisyl_  & [LEN <! short,long !>]. 
_short_long_ := _bisyl_  & [LEN <! long,short !>]. 


_long_long_long_ := _trisyl_  & [LEN <! long,long,long !>]. 
_long_long_short_ := _trisyl_  & [LEN <! short,long,long !>]. 
_short_short_long_ := _trisyl_  & [LEN <! long,short,short !>]. 
_short_short_short_ := _trisyl_  & [LEN <! short,short,short !>]. 
_long_short_long_ := _trisyl_  & [LEN <! long,short,long !>]. 
_long_short_short_ := _trisyl_  & [LEN <! short,short,long !>]. 
_short_long_long_ := _trisyl_  & [LEN <! long,long,short !>]. 
_short_long_short_ := _trisyl_  & [LEN <! short,long,short !>]. 

_long_long_long_long_ := _quadsyl_  & [LEN <! long,long,long,long !>]. 
_long_long_long_short_ := _quadsyl_  & [LEN <! short,long,long,long !>]. 
_long_short_short_long_ := _quadsyl_  & [LEN <! long,short,short,long !>]. 
_long_short_short_short_ := _quadsyl_  & [LEN <! short,short,short,long !>]. 
_long_long_short_long_ := _quadsyl_  & [LEN <! long,short,long,long !>]. 
_long_long_short_short_ := _quadsyl_  & [LEN <! short,short,long,long !>]. 
_long_short_long_long_ := _quadsyl_  & [LEN <! long,long,short,long !>]. 
_long_short_long_short_ := _quadsyl_  & [LEN <! short,long,short,long !>]. 
_short_long_long_long_ := _quadsyl_  & [LEN <! long,long,long,short !>]. 
_short_long_long_short_ := _quadsyl_  & [LEN <! short,long,long,short !>]. 
_short_short_short_long_ := _quadsyl_  & [LEN <! long,short,short,short !>]. 
_short_short_short_short_ := _quadsyl_  & [LEN <! short,short,short,short !>]. 
_short_long_short_long_ := _quadsyl_  & [LEN <! long,short,long,short !>]. 
_short_long_short_short_ := _quadsyl_  & [LEN <! short,short,long,short !>]. 
_short_short_long_long_ := _quadsyl_  & [LEN <! long,long,short,short !>]. 
_short_short_long_short_ := _quadsyl_  & [LEN <! short,long,short,short !>]. 



_short_long_long_long_long_ := _pentasyl_  & [LEN <! long,long,long,long,short !>]. 
_short_long_long_long_short_ := _pentasyl_  & [LEN <! short,long,long,long,short !>]. 
_short_long_short_short_long_ := _pentasyl_  & [LEN <! long,short,short,long,short !>]. 
_short_long_short_short_short_ := _pentasyl_  & [LEN <! short,short,short,long,short !>]. 
_short_long_long_short_long_ := _pentasyl_  & [LEN <! long,short,long,long,short !>]. 
_short_long_long_short_short_ := _pentasyl_  & [LEN <! short,short,long,long,short !>]. 
_short_long_short_long_long_ := _pentasyl_  & [LEN <! long,long,short,long,short !>]. 
_short_long_short_long_short_ := _pentasyl_  & [LEN <! short,long,short,long,short !>]. 
_short_short_long_long_long_ := _pentasyl_  & [LEN <! long,long,long,short,short !>]. 
_short_short_long_long_short_ := _pentasyl_  & [LEN <! short,long,long,short,short !>]. 
_short_short_short_short_long_ := _pentasyl_  & [LEN <! long,short,short,short,short !>]. 
_short_short_short_short_short_ := _pentasyl_  & [LEN <! short,short,short,short,short !>]. 
_short_short_long_short_long_ := _pentasyl_  & [LEN <! long,short,long,short,short !>]. 
_short_short_long_short_short_ := _pentasyl_  & [LEN <! short,short,long,short,short !>]. 
_short_short_short_long_long_ := _pentasyl_  & [LEN <! long,long,short,short,short !>]. 
_short_short_short_long_short_ := _pentasyl_  & [LEN <! short,long,short,short,short !>]. 

_long_long_long_long_long_ := _pentasyl_  & [LEN <! long,long,long,long,long !>]. 
_long_long_long_long_short_ := _pentasyl_  & [LEN <! short,long,long,long,long !>]. 
_long_long_short_short_long_ := _pentasyl_  & [LEN <! long,short,short,long,long !>]. 
_long_long_short_short_short_ := _pentasyl_  & [LEN <! short,short,short,long,long !>]. 
_long_long_long_short_long_ := _pentasyl_  & [LEN <! long,short,long,long,long !>]. 
_long_long_long_short_short_ := _pentasyl_  & [LEN <! short,short,long,long,long !>]. 
_long_long_short_long_long_ := _pentasyl_  & [LEN <! long,long,short,long,long !>]. 
_long_long_short_long_short_ := _pentasyl_  & [LEN <! short,long,short,long,long !>]. 
_long_short_long_long_long_ := _pentasyl_  & [LEN <! long,long,long,short,long !>]. 
_long_short_long_long_short_ := _pentasyl_  & [LEN <! short,long,long,short,long !>]. 
_long_short_short_short_long_ := _pentasyl_  & [LEN <! long,short,short,short,long !>]. 
_long_short_short_short_short_ := _pentasyl_  & [LEN <! short,short,short,short,long !>]. 
_long_short_long_short_long_ := _pentasyl_  & [LEN <! long,short,long,short,long !>]. 
_long_short_long_short_short_ := _pentasyl_  & [LEN <! short,short,long,short,long !>]. 
_long_short_short_long_long_ := _pentasyl_  & [LEN <! long,long,short,short,long !>]. 
_long_short_short_long_short_ := _pentasyl_  & [LEN <! short,long,short,short,long !>]. 

;;; hexa

_short_short_long_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,long,short,short !>]. 
_short_short_long_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,long,short,short !>]. 
_short_short_long_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,long,short,short !>]. 
_short_short_long_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,long,short,short !>]. 
_short_short_long_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,long,short,short !>]. 
_short_short_long_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,long,short,short !>]. 
_short_short_long_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,long,short,short !>]. 
_short_short_long_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,long,short,short !>]. 
_short_short_short_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,short,short,short !>]. 
_short_short_short_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,short,short,short !>]. 
_short_short_short_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,short,short,short !>]. 
_short_short_short_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,short,short,short !>]. 
_short_short_short_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,short,short,short !>]. 
_short_short_short_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,short,short,short !>]. 
_short_short_short_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,short,short,short !>]. 
_short_short_short_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,short,short,short !>]. 
_short_long_long_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,long,long,short !>]. 
_short_long_long_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,long,long,short !>]. 
_short_long_long_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,long,long,short !>]. 
_short_long_long_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,long,long,short !>]. 
_short_long_long_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,long,long,short !>]. 
_short_long_long_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,long,long,short !>]. 
_short_long_long_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,long,long,short !>]. 
_short_long_long_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,long,long,short !>]. 
_short_long_short_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,short,long,short !>]. 
_short_long_short_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,short,long,short !>]. 
_short_long_short_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,short,long,short !>]. 
_short_long_short_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,short,long,short !>]. 
_short_long_short_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,short,long,short !>]. 
_short_long_short_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,short,long,short !>]. 
_short_long_short_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,short,long,short !>]. 
_short_long_short_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,short,long,short !>]. 

_long_short_long_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,long,short,long !>]. 
_long_short_long_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,long,short,long !>]. 
_long_short_long_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,long,short,long !>]. 
_long_short_long_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,long,short,long !>]. 
_long_short_long_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,long,short,long !>]. 
_long_short_long_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,long,short,long !>]. 
_long_short_long_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,long,short,long !>]. 
_long_short_long_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,long,short,long !>]. 
_long_short_short_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,short,short,long !>]. 
_long_short_short_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,short,short,long !>]. 
_long_short_short_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,short,short,long !>]. 
_long_short_short_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,short,short,long !>]. 
_long_short_short_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,short,short,long !>]. 
_long_short_short_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,short,short,long !>]. 
_long_short_short_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,short,short,long !>]. 
_long_short_short_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,short,short,long !>]. 
_long_long_long_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,long,long,long !>]. 
_long_long_long_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,long,long,long !>]. 
_long_long_long_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,long,long,long !>]. 
_long_long_long_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,long,long,long !>]. 
_long_long_long_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,long,long,long !>]. 
_long_long_long_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,long,long,long !>]. 
_long_long_long_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,long,long,long !>]. 
_long_long_long_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,long,long,long !>]. 
_long_long_short_long_long_long_ := _hexasyl_  & [LEN <! long,long,long,short,long,long !>]. 
_long_long_short_long_long_short_ := _hexasyl_  & [LEN <! short,long,long,short,long,long !>]. 
_long_long_short_short_short_long_ := _hexasyl_  & [LEN <! long,short,short,short,long,long !>]. 
_long_long_short_short_short_short_ := _hexasyl_  & [LEN <! short,short,short,short,long,long !>]. 
_long_long_short_long_short_long_ := _hexasyl_  & [LEN <! long,short,long,short,long,long !>]. 
_long_long_short_long_short_short_ := _hexasyl_  & [LEN <! short,short,long,short,long,long !>]. 
_long_long_short_short_long_long_ := _hexasyl_  & [LEN <! long,long,short,short,long,long !>]. 
_long_long_short_short_long_short_ := _hexasyl_  & [LEN <! short,long,short,short,long,long !>].