;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--IFD-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                        ;;
;;                Istituto di Fonetica e Dialettologia                    ;;
;;                 Consiglio Nazionale delle Ricerche                     ;;
;;                            Padova Italy                                ;;
;;                        Copyright (c) 2000                              ;;
;;                                                                        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--IFD-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;									  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--IRST-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                        						  ;;
;;           Centro per la ricerca scientifica e tecnologica              ;;
;;         	             Povo (TN) - Italy				  ;;
;;			    Copyright (c) 2000                            ;;
;;									  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<--IRST-->;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Definizione del lessico per l'italiano 
;;; e alcune regole di pre-tokenizzazione.
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Pre-Lessico per mappare tutti i caratteri in quelli giusti; 
;;; in più tratta le parole con l'apostrofo, unendo la sillabazione ma mantenendo la trascrizione delle singole parole.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(lex.create "otherlex_irst")
(lex.set.phoneset "italian")
(lex.set.lts.method "irst_pre_lex_function")

(define (irst_pre_lex_function word feats)
"(pre_lex_function word feats): Funzione di Pre-lessico per mappare tutti i caratteri in quelli giusti, in più tratta le parole con l'apostrofo, unendo la sillabazione ma mantenendo la trascrizione delle singole parole."
(if (string-matches word ".* -T.*")
   (let ()
	(set! true_word_str (string-before word " -T")) 
	(set! trasc_word_str (string-after word " -T ")) 
	(set! tl (read-from-string (string-append "(" trasc_word_str ")"))) ;aggiunge una parentesi
	(set! entry (list true_word_str 'N tl))
	;(print entry)
	;(item.set_name w true_word_str)
	;(item.set_feat w "TRA_NUM" trasc_word_str)
	)
   (let ((me (lex.select "irst_lts")))
      ;(format t "intercept function %l %l\n" word feats)
      (set! down_word (apply string-append (lts.apply word 'italian_downcase)))
      ;(format t "intercept function %l %l\n" down_word feats)
      
      (if (string-matches down_word ".+'.+") ;caso parole con apostrofi
      	(let ()
      	;(print"APOSTROFO")
      	(set! e1 (lex.lookup (string-append (string-before down_word "'") "'")) feats)
      	(set! e2 (lex.lookup (string-after down_word "'")) feats)
      	(set! pos2 (car (cdr e2)))
      	(set! T (append (car (cdr (cdr e1))) (car (cdr (cdr e2)))))
      	(set! ps 1) ;flag per la prima sillaba
      	(while T
      		(set! s1 (car (car T)))
      		(set! Ok 0)
      		(while s1
      			(set! ph (car s1))
      			(if (string-equal (phone_feature ph 'vc) "+")
      				(set! Ok 1))
			(set! s1 (cdr s1)))	
		(if (and (eq? Ok 0) (cdr T)) 
		  (let ()
			(set! sillaba_tra (append (car (car T)) (car (car (cdr T))))) 
			(set! stress (car (cdr (car (cdr T)))))
			(set! sillaba (list sillaba_tra stress))
			(if (eq? ps 1)
			(set! nT  (append (list sillaba)))
			(set! nT (append  nT (list sillaba))))
			(set! T (cdr T)))
		  (let ()
			(if (eq? ps 1)
			(set! nT  (list (car T)))
			(set! nT (append  nT (list (car T)))))))
		(set! ps 0)
		(set! T (cdr T)))
		(set! ne (list down_word pos2 nT))
		
      	(set! entry ne))
	
	;;no apostrofo case
	(set! entry (lex.lookup down_word feats)))

      (lex.select me)
      ))
      
      entry )



(lex.create "irst_lts")
(lex.set.phoneset "italian")
;(lex.set.pos.map irst2_pos_map)
(lex.set.lts.method "irst_lex_function")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LESSICO ADDENDA (pochi termini)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; convenzione àèìòù
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; VOCALI ACCENTATE codifica ANSI
;;
(require 'italian_addenda)


(define (irst_lex_function word feats)
"(irst_lex_function word feats): Funzione per lessico irst."
(let (out)
  (set! out (irst_lookup (apply string-append (lts.apply word 'trasmorph)) feats))
  (if (not out)
      (let ()
	(lex.select "italian_lts")
	(set! out (lex.lookup word feats))))
out))


;;;;;;;;;;;;;;;;;;;;;DA GUARDARE SE è FATTIBILE O COSA è MEGLIO .cosa devo ancora fare qui?
(setq irst_pos_map
      '(
	(( V-P3_IP vb vbn vbz vbp vbg ) V)
	(( A-MS nn nnp nns nnps fw sym ls ) A)
	(( A ) A-MS)
	(( punc fpunc ) punc)
	(( in ) in)
	(( jj jjr jjs 1 2 ) j)
	(( prp ) prp)
	(( D-NNFab ) D-NN)
	(( rb rp rbr rbs ) r)
	(( cc ) cc)
	(( of ) of)
	(( to ) to)
	(( cd ) cd)
	(( md ) md)
	(( pos ) pos)
	(( wdt ) wdt)
	(( wp ) wp)
	(( wrb ) wrb)
	(( ex ) ex)
	(( uh ) uh)
	(( pdt ) pdt)
	))



;;; Lexicon
(lex.create "italian_lts")
(lex.set.phoneset "italian")
(lex.set.pos.map irst_pos_map)
;(defvar ifdlexdir (path-append lexdir "ifd"))
;(lex.set.compile.file (path-append ifdlexdir "lex.out"))
(lex.set.lts.method "italian_lts") 

;(lex.set.lts.ruleset "italian")

;PER ANNULARE I POSTLEX:
(set! postlex_rules_hooks nil)



(provide 'italian_lexicon_irst)
