;;; -*- 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*].


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 [MODIFIABLE #m,
		     BOUND #expr,
		     LIGHT #light],
	     STEM [FROM #from,
		   TO #to],
	     ROBUST #r,
	     MORPH.MCLASS #morph,
	     SUPRA [PRFX [TONE [LAST #tlast],
			  LEN [LIST #prfx,
			       LAST #llast]],
		    LEN [LAST #llast],
		    TM  #tm,
		    LM #lm],
	     DTR [SYNSEM [LIGHT #light,
			  MODIFIABLE #m,
			  BOUND #expr],
		  STEM [FROM #from,
			TO #to],
		  ROBUST #r,
		  MORPH.MCLASS #morph,
		  SUPRA [PRFX [TONE [LAST #tlast]],
			 LEN [LAST #prfx],
			 TM #tm,
			 LM #lm]]].





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 & [LAST #ltl],
				   --LENGTHS #ll & [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  ].

synsem :+ [POLTONE tone].

supra := supra_min &
	 [PRFX supra_min,
	  TM diff-list,
	  LM diff-list,
	  TONES diff-list,
	  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, 
	     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]]].



unary-phrase :+ 
		[STEM [FROM #from,
		       TO #TO],
		 ROBUST #r, 
		 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 +,
			ROBUST #r,
			SUPRA supra_reent & 
				       [TM #tm,
					LM #lm,
					LENGTHS #ll,
					TONES #lt ]]>].


basic-binary-phrase :+ 
		       [SYNSEM.POLTONE #pol,
			STEM [FROM #from,
			      TO #TO],
			ROBUST #r, 
			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 <[STEM [FROM #from],
			       ROBUST #r,
			       MORPH.COMPLETE +,
			       SUPRA supra_reent &
				    [TM [LIST #tm1,
					 LAST #tm2],
				     LM [LIST #lm1,
					 LAST #lm2],
				     TONES [LIST #lt1,
					    LAST #lt2],
				     LENGTHS [LIST #ll1,
					      LAST #ll2]
					]],
			      [SYNSEM.POLTONE #pol,
			       STEM [TO #TO],
			       ROBUST #r,
			       MORPH.COMPLETE +,
			       SUPRA supra_reent & 
				    [TM [LIST #tm2,
					 LAST #tm3],
				     LM [LIST #lm2,
					 LAST #lm3],
				     TONES [LIST #lt2,
					    LAST #lt3],
				     LENGTHS [LIST #ll2,
					      LAST #ll3]]]>].



;;; 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 := *top*.

low-final := tone.

high := tone.
low := low-final.
utone := tone.


;;; 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. 

_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 := cons & tone-marked-list.
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].


length-marked-list := list & [--TL list].
length-marked-cons := cons & length-marked-list & [--TL <[] . #tl>,
						   REST.--TL #tl].
length-marked-null := null & length-marked-list & [--TL <>].

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

long-marked-null := length-marked-null & long-marked-list.

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

short-marked-null := length-marked-null & 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.


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

h*-cons := h*-list & 
	   t*-cons &
	   [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 &
	   [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.



; l-h*-list := tone-marked-list & [--LAST diff-list,
; 				 ---SPREAD diff-list].

; l-h*-cons := l-h*-list & 
; 	     tone-marked-cons & 
; 	     [FIRST #tone,
; 	      REST l-h*-list & 
; 		    [--LAST [LIST < #tone . #rest>,
; 			     LAST #slist]],
; 	      --LAST [LIST #rest,
; 		      LAST #slist],
; 	      ---SPREAD [LIST #slist & h*-list,
; 			LAST #slist]
; 		    ].

; l-h*-null := l-h*-list & tone-marked-null & [--LAST <! low !> ].



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

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

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


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

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


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

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

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


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

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

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

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


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

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




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

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



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

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


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

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


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

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


;;;

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

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


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

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


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

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

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

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

;;;;

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

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



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

l*-h-l-h-lm-list := low-marked-list & l*-h-l-h-list. 
l*-h-l-h-lm-cons := l*-h-l-h-lm-list  & l*-h-l-h-cons & low-marked-cons. 
l*-h-l-h-hm-list := high-marked-list & l*-h-l-h-list. 
l*-h-l-h-hm-cons := l*-h-l-h-hm-list & l*-h-l-h-cons & high-marked-cons. 
l*-h-l-h-fm-list := full-marked-list & l*-h-l-h-hm-list & l*-h-l-h-lm-list. 
l*-h-l-h-fm-cons := l*-h-l-h-fm-list  & l*-h-l-h-hm-cons & l*-h-l-h-lm-cons & full-marked-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 +,
	      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 +,
		   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 !>].