;; this code is more or less from Ken's thesis
(declare (special segment-lattice *graphics-port* *echo-port* 
                  *latice-env* *phoneme-lattice-env*))

(defsysr (parse-segment-lattice segment-lattice)
    (with-lower-case
    (with-lattice-env
; print syllable level labels; gc is gc-ed syllables
    (adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice onset) "onsets"
    (lattice peak) "peak"
    (lattice coda) "coda"
    (lattice inflectional-affix) "inflectional-affix"
    (lattice syllable) "syllable"
    (lattice gc) "gc"
; --------------------------------------------------
; print metrical level labels
    (adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice foot) "foot"
; --------------------------------------------------
; lexicon
(load-dictionary-files)
(adjmat-print-matrices
    *graphics-port* *echo-port* 
    segment-latice "segments"
    (lattice canonical-onset) "canonical-onset"
    (lattice canonical-rhyme) "canonical-rhyme"
    (lattice canonical-syllable) "canonical-syllable"
    (lattice sylparts-in-dictionary) "sylparts-in-dictionary"
    (lattice words-in-dictionary) "words-in-dictionary"
    (lattice gc-words-in-dictionary) "gc-words-in-dictionary"
    ))))
; --------------------------------------------------
; vowels
(def-lattice vowel (phoneme-lattices "cEIiou"))
; --------------------------------------------------
; stops
(def-lattice voiceless-stop (phoneme-lattices "ptk"))
(def-lattice stop (phoneme-lattices "ptkbdg&?"))
(def-lattice unreleased-stop (m-filter (lattice stop) 'unreleased?))
; --------------------------------------------------
; fricatives
(def-lattice strong-fric (phoneme-lattices "sSzZ"))
(def-lattice weak-fric (phoneme-lattices "fvTD"))
(def-lattice fric (m+ (lattice strong-fric) (lattice weak-fric)))
; --------------------------------------------------
; syllables, feet
(def-lattice fric-stop-cluster (m* (phoneme-lattice #/s )
                                    (lattice voiceless-stop)))
(def-lattice onset-core 
                        (m+ (lattice fric-stop-cluster)
                            (lattice fric)
                            (m- (lattice-stop) (lattice unreleased-stop))))
(def-lattice onset 
                        (m+ (lattice onset-core)
                            (m* (mopt (phoneme-lattice #/s))
                                 (phoneme-lattices "nm"))
                                 (phoneme-lattice #/h)))

(def-lattice coda 
                        (m+  (lattice stop)
                             (lattice fric)
                             (lattice fric-stop-cluster)))


(def-lattice peak (lattice vowel))

(def-lattice syllable (m* (mopt (lattice onset))
                                (lattice peak)
                                (lattice coda)))

(def-lattice foot  (m* (lattice syllable))

; --------------------------------------------------
; canonicalization
(def-lattice canonical-onset
          (canonicalize-lattice (lattice onset)))
(def-lattice canonical-peak
          (canonicalize-lattice (lattice peak)))
(def-lattice canonical-syllable
          (canonicalize-lattice (lattice syllable)))


(def-lattice sylparts-in-dictionary
          (adjmat-transduce (lattice canonical-syllable)
                            #'lookup-sylparts))

(def-lattice words-in-dictionary
          (lookup-adjmat-in-dnet
          (lattice sylparts-in-dictionary)
           *syllable-to-word-dnet*))

(def-lattice gc-words-in-dictionary
          (adjmat-gc (m* (lattice words-in-dictionary)
                          (mopt (lattice inflectional-affix)))))