Commit 5c3299e8 authored by Gérard Huet's avatar Gérard Huet

Cleanups

parent 7272c4b0
......@@ -4,7 +4,7 @@
(* *)
(* Gérard Huet *)
(* *)
(* ©2018 Institut National de Recherche en Informatique et en Automatique *)
(* ©2019 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)
(* CGI-bin declension for computing declensions. *)
......@@ -197,7 +197,7 @@ value sort_out accu form = fun
| Neu -> (mas,fem,[ t :: neu ],any,iic,avy)
| Deictic _ -> (mas,fem,neu,[ t :: any ],iic,avy)
]
| Bare_stem | Auxi_form -> (mas,fem,neu,any,[ f :: iic ],avy)
| Bare_stem | Gati -> (mas,fem,neu,any,[ f :: iic ],avy)
| Avyayaf_form -> (mas,fem,neu,any,iic,[ f :: avy ])
| Ind_form _ | Verb_form _ _ _ | Ind_verb _ | Abs_root _
| Avyayai_form | Unanalysed | PV _
......
......@@ -362,7 +362,7 @@ value filter_out_krit krit root = match Canon.decode root with
;
(* We should verify aa- validation for phantomatic forms *)
value autonomous_form_k krid_form (delta,_) =
let stem = Word.patch delta krid_form in
let stem = Word.patch delta krid_form in
let (homo,bare_stem) = homo_undo stem in
let krid_infos = assoc_word bare_stem unique_kridantas in
let ((conj,krit),root) = look_up_homo homo krid_infos in
......@@ -496,11 +496,11 @@ value validate out = match out with
then out else []
]
| [ (Kric,rev_krid_form,_) :: _ ] ->
let krid_form = Word.mirror rev_krid_form in
let krid_form = Word.mirror rev_krid_form in
match Deco.assoc krid_form morpho.krids with
[ [] -> failwith ("Unknown krid_form: " ^ (Canon.decode krid_form))
| tags -> if List.exists (autonomous_form_k krid_form) tags
then out else []
then out else []
]
| (* iic kridanta forms with preverbs *)
[ (phk,rev_ikrid_form,s) :: [ (ph,prev,sv) :: r ] ]
......@@ -528,7 +528,7 @@ value validate out = match out with
match Deco.assoc krid_form morpho.iiks with
[ [] -> failwith ("Unknown krid_form: " ^ Canon.decode krid_form)
| tags -> if List.exists (autonomous_form_k krid_form) tags
then out else []
then out else []
]
| (* vocative kridanta forms with preverbs *)
[ (phk,rev_krid_form,s) :: [ (ph,prev,sv) :: r ] ]
......
......@@ -407,7 +407,7 @@ value enter1 entry =
[ "kaama" (* volition : who wants to do *)
| "manas" (* consideration : who thinks about doing *)
(* | "zakya" (* possibility : who is able to do *)
(* not amenable since kridanta, other phase *) *)
(* not here since kridanta, cf [enter_form] *) *)
-> add_morphkama w delta f
| _ -> ()
]
......@@ -443,7 +443,7 @@ value enter1 entry =
| Bare Pron w -> add_morphi w delta Bare_stem
| Avyayai w -> add_morphyai w delta Avyayai_form
| Avyayaf w -> add_morphyaf w delta Avyayaf_form
| Cvi w -> add_morphvi w delta Auxi_form
| Cvi w -> add_morphvi w delta Gati
| Invar m w -> let (_,vi) = m
and f = Ind_verb m in
match vi with
......@@ -499,7 +499,8 @@ value enter_form stem =
if root = "i" || root = "edh" then () (* \Pan{6,1,89} *)
else add_morphlopak w stem p aapv
else ()
}
(* TODO [; if v=Pfutp && root="zak" then imitate enter1] inftu-zakya *)
}
| Bare (Krid (_,Action_noun) root) w ->
add_morphauxiick w stem Bare_stem (* cvi patch *)
| Bare (Krid _ root) w -> let f = Bare_stem in do (* losing verbal and root *)
......
......@@ -4,7 +4,7 @@
(* *)
(* Gérard Huet *)
(* *)
(* ©2018 Institut National de Recherche en Informatique et en Automatique *)
(* ©2019 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)
(*i module Morpho_scl = struct i*)
......@@ -141,7 +141,7 @@ value print_scl_morph = fun
| Ind_form k -> print_scl_kind k
| Avyayaf_form -> ps "<avya/>"
| Abs_root c -> do { print_scl_conjugation c; ps "<abs/>" }
| Auxi_form -> ps "<iiv/>"
| Gati -> ps "<iiv/>"
| Ind_verb m -> print_scl_modal m
| PV _ -> ps "<pv/>"
| Unanalysed -> ps "<unknown/>"
......
......@@ -4,7 +4,7 @@
(* *)
(* Gérard Huet *)
(* *)
(* ©2018 Institut National de Recherche en Informatique et en Automatique *)
(* ©2019 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)
(* Linearizes morphological information as a string.
......@@ -119,7 +119,7 @@ value string_morph = fun
| Verb_form f n p -> (string_finite f) ^ (string_number n) ^ (string_person p)
| Ind_form k -> string_ind_kind k
| Abs_root c -> (string_conjugation c) ^ "abs."
| Auxi_form -> "iiv."
| Gati -> "iiv."
| Ind_verb m -> string_modal m
| Unanalysed -> "?"
| PV pvs -> "pv."
......
......@@ -26,11 +26,12 @@ type inflexion_tag = (* vibhakti *)
| Ind_form of ind_kind (* indeclinable forms: prep, adv, etc *)
| Ind_verb of modal (* indeclinable inf abs-ya and perpft *)
| Abs_root of conjugation (* abs-tvaa *)
| Auxi_form (* verbal auxiliaries forms *)
| Gati (* iiv verbal auxiliaries forms *)
| Unanalysed (* un-analysable segments *)
| PV of list string (* Preverb sequences *)
(* NB preverb sequences are collated separately by [Roots] module, and they do not
appear in solutions, removed by compression of [Dispatcher.validate]. *)
(* NB preverb sequences are collated separately by [Roots] module,
and they do not appear in solutions, they are removed by compression
of [Dispatcher.validate]. *)
]
and inflexions = list inflexion_tag
;
......
......@@ -5797,6 +5797,36 @@ value enter_iiv entry =
;
value compute_extra_iiv = iter enter_iiv
;
(* Gati forms used with auxiliary verbs, like Iiv -- form Absya *)
value gatis =
[ "saak.saat" (* Pan{1,4,74} in the sense of cvi - becoming *)
; "mithyaa"
; "cintaa"
; "rocanaa"
; "aasthaa"
; "amaa"
; "amaa"
; "arthe"
; "lava.nam"
; "u.s.nam"
; "ziitam"
; "udakam"
; "aardram"
; "agnau"
; "vaze"
; "urasi" (* Pan{1,4,75} in the sense of anatyaadhaana cf Sharma *)
; "manasi"
; "anye" (* Pan{1,4,76} id *)
; "pade"
; "nicacane"
; "haste" (* Pan{1,4,77} upayamana (mariage) *)
; "paa.nau"
]
;
value enter_gati gati = (* assumes gati has lexical entry *)
let stem = normal_stem gati in
enter1 gati (Cvi stem)
;
value enter_iiy entry =
enter1 entry (Avyayai (normal_stem entry)) (* stripped entry *)
;
......@@ -5843,8 +5873,7 @@ value compute_extra iic_only_stems = do
where decl = Declined Noun Mas [ (Dual,[ (Ins,code "maabhyaam") ]) ]
; enter1 "yuu.sa" (* Siddhaanta kaumudii *) decl
where decl = Declined Noun Mas [ (Plural,[ (Loc,code "yuu.h.su") ]) ]
; enter1 "avanam" (Cvi (revcode "avanamii"))
; enter1 "saak.saat" (Cvi (revcode "saak.saat")) (* gati *)
; enter1 "avanam" (Cvi (code "avanamii")) (* exception *)
(* For the moment, computed as form of n.r but skipped
[; enter1 "nara" decl (* overgenerates badly ! *)
where decl = Declined Noun Mas [ (Singular,[ (Nom,code "naa") ]) ] ] *)
......@@ -5865,6 +5894,7 @@ value compute_extra iic_only_stems = do
; enter1 "viz#2" (* Vedic Whitney§218a *) decl
where decl = Declined Noun Fem [ (Plural,[ (Loc,code "vik.su") ]) ]
; iter enter_iiy iic_avya
; iter enter_gati gatis
; tasil_extra ()
; compute_extra_iic iic_indecl (* antar *)
; compute_extra_iic iic_only_stems (* aajaanu etc. *)
......
......@@ -98,9 +98,10 @@ value voices_of = fun
| "yudh#1" | "rabh" | "ruc#1" | "lajj" | "lamb" | "lii" | "loc" | "vand"
| "vas#2" | "vaaz" | "vip" | "v.rdh#1" | "ve.s.t" | "vrii.d" | "zafk" | "zad"
| "zi~nj" | "zii#1" | "zrambh" | "zlaagh" | "zvit" | "sac" | "sev"
| "styaa" | "spand" | "spardh" | "spaz#1" | "sphaa" | "smi" | "sra.ms"
| "styaa" | "spand" | "spardh" | "spaz#1" | "sphaa" | "sra.ms"
| "sva~nj" | "haa#2" | "hu.n.d" | "h.r#2" | "hnu" | "hraad" | "hlaad"
(*| "m.r" Ubha needed for non present tenses - see \Pan{1,3,61} for exact rule *)
(*| "smi" Ubha needed for smitavat *)
(* DRP restriction: "dyut#1" *)
-> Atma (* "deponent" verbs: middle only *)
| _ -> Ubha (* default *)
......@@ -124,8 +125,8 @@ value voices_of = fun
| "vad" | "vap#1" | "vap#2" | "val" | "vah#1" | "vaa#3" | "vic" | "vij"
| "viij" | "v.r#2" | "v.rt#1" | "vyath" | "vyaa" | "zap" | "zaa" | "zu.s"
| "zubh#1" | "zyaa" | "zri" | "san#1" | "sah#1" | "sic" | "su#2" | "suud"
| "stambh" | "stu" | "st.rr" | "sthaa#1" | "sp.rz#1" | "sp.rh" | "syand"
| "svad" | "had" | "hikk" | "hu" | "huu" | "h.r#1" ] *)
| "stambh" | "stu" | "st.rr" | "sthaa#1" | "sp.rz#1" | "sp.rh" | "smi"
| "syand" | "svad" | "had" | "hikk" | "hu" | "huu" | "h.r#1" ] *)
(* + corr. "pa.th" | "sthaa#1" | "praz" | "k.rr" | "p.rc" | "bandh" *)
(* NB. "ah" "rip" "vadh" have no pr, "mand2" is fictitious *)
(* "iiz1", "lii" and "knuu" allowed Para in future *)
......
......@@ -258,7 +258,7 @@ value print_sem w = fun
| Ind_form Adv -> ps "Adverb"
| Ind_form _ -> ps (translate_tool w)
| Bare_stem -> ps "Compound"
| Auxi_form -> ps "Composed"
| Gati -> ps "Composed"
| _ -> ()
]
;
......
......@@ -390,8 +390,7 @@ value drop_penultimate_nasal = fun
| _ -> failwith "No penultimate nasal"
]
;
value passive_stem entry rstem = (* Panini -yak (k means no guna) *)
(* k also means samprasaara.na *)
value passive_stem entry rstem = (* Panini yak (k : no guna, samprasaara.na) *)
let weak = match entry with
(* [weak] same as first component of [stems], except praz vac etc and bh.rjj *)
[ "dah#1" | "dih" | "duh#1" | "druh#1" | "muh" | "snih#1" | "snuh#1"
......@@ -4206,7 +4205,8 @@ value compute_aorist entry =
| _ -> ()
]
; match entry with (* 7. sa aorist ksa *)
[ "guh" | "diz#1" | "dih" | "duh#1" | "lih#1" | "viz#1" | "v.rj" -> do
[ "guh" | "diz#1" | "dih" | "duh#1" | "lih#1" | "viz#1" | "v.rj"
| "sp.rz#1" -> do
(* \Pan{7,3,72-73} *)
{ compute_ath_sa_aorista weak entry
; compute_ath_sa_aoristm weak entry
......@@ -4418,7 +4418,8 @@ value build_infinitive c inf_stem root = do
See Renou HLS p72 from Patanjali; Renou grammaire §107 dagdhukaama
also Assimil p194 eg tyaktukaama
anu.s.thaatukaama "desirious to proceed" vaktukaama "who wants to speak"
dra.s.tumanas "inclined to see" *)
dra.s.tumanas "inclined to see"
dra.s.tuzakya "able to see" *)
}
;
value perif conj perstem entry = do
......@@ -4470,16 +4471,17 @@ value velarification rstem = (* \Pan{7,3,52} *)
(* Actually the following velarification should be registered as an optional
form, since \Pan{7,3,65} says that it does not apply in the sense of necessity *)
| _ -> let st = match rstem with (* [Int_sandhi.restore_stem] not needed *)
[ [ 22 (* c *) :: [ 26 (* ~n *) :: r ] ] ->
[ 17 (* k *) :: [ 21 (* f *) :: r ] ] (* vafkya *)
| [ 22 (* c *) :: r ] -> [ 17 (* k *) :: r ] (* paakya vaakya *)
| [ 24 (* j *) :: [ 24 (* j *) :: r ] ] ->
[ 19 (* g *) :: [ 19 (* g *) :: r ] ] (* bh.rggya *)
| [ 24 (* j *) :: [ 26 (* ~n *) :: r ] ] ->
[ 19 (* g *) :: [ 21 (* f *) :: r ] ] (* safgya *)
| [ 24 (* j *) :: r ] -> [ 19 (* g *) :: r ] (* maargya *)
| _ -> rstem
] in rfix st "ya"
[ [ 22 (* c *) :: [ 26 (* ~n *) :: r ] ] ->
[ 17 (* k *) :: [ 21 (* f *) :: r ] ] (* vafkya *)
| [ 22 (* c *) :: r ] -> [ 17 (* k *) :: r ] (* paakya vaakya *)
| [ 24 (* j *) :: [ 24 (* j *) :: r ] ] ->
[ 19 (* g *) :: [ 19 (* g *) :: r ] ] (* bh.rggya *)
| [ 24 (* j *) :: [ 26 (* ~n *) :: r ] ] ->
[ 19 (* g *) :: [ 21 (* f *) :: r ] ] (* safgya *)
| [ 24 (* j *) :: r ] -> [ 19 (* g *) :: r ] (* maargya *)
| _ -> rstem
] in
rfix st "ya"
]
;
value record_pfp_ya conj ya_stem root =
......@@ -4595,7 +4597,7 @@ value record_pfp_10 entry rstem = do
value record_part_ppp ppstem entry = do
{ record_part (Ppp_ Primary ppstem entry)
; record_part (Pppa_ Primary [ 45 :: ppstem ] entry) (* pp-vat (krid tavat) *)
; record_part (Pppa_ Primary ppstem entry) (* pp-vat (krit tavat) *)
}
;
value record_abso_ya form entry = enter1 entry (Invar (Primary,Absoya) form)
......@@ -4815,7 +4817,7 @@ value record_absolutive c abs_stem_tvaa abs_stem_ya intercal entry =
value record_pppca cpstem cstem entry =
let ppstem = [ 1 :: [ 32 :: [ 3 :: cpstem ] ] ] (* cp-ita *) in do
{ record_part (Ppp_ Causative ppstem entry)
; record_part (Pppa_ Causative [ 45 :: ppstem ] entry) (* pp-vat *)
; record_part (Pppa_ Causative ppstem entry) (* pp-vat *)
; let abs_stem_ya = match entry with (* Whitney§1051d *)
[ "aap" | ".r" | ".rc#1" | ".rdh" | "kal" | "k.lp" | "kram" | "gam"
| "jan" | "jval" | "dh.r" | "rac" | "zam#1" | "p.rr" | "bhak.s" | "v.rj"
......@@ -4830,7 +4832,7 @@ value record_pppca cpstem cstem entry =
value record_pppdes stem entry =
let ppstem = [ 1 :: [ 32 :: [ 3 :: stem ] ] ] in (* s-ita *) do
{ record_part (Ppp_ Desiderative ppstem entry)
; record_part (Pppa_ Desiderative [ 45 :: ppstem ] entry) (* pp-vat *)
; record_part (Pppa_ Desiderative ppstem entry) (* pp-vat *)
; let abs_stem_tvaa = [ 3 :: stem ] (* s-i *)
and abs_stem_ya = stem in
record_absolutive Desiderative abs_stem_tvaa abs_stem_ya False entry
......@@ -5812,7 +5814,7 @@ value compute_extra_car () = do
let cstem = revcode "j~nap" in
let ppstem = [ 1 :: [ 32 :: cstem ] ] (* j~napta *) in do
{ record_part (Ppp_ Causative ppstem entry)
; record_part (Pppa_ Causative [ 45 :: ppstem ] entry) (* pp-vat *)
; record_part (Pppa_ Causative ppstem entry) (* pp-vat *)
; perif Causative cstem entry
}
and compute_extra_zru () =
......
......@@ -8,4 +8,4 @@
(**************************************************************************)
(* Generated by make version - see main Makefile *)
value version="3.14" and version_date="2019-04-02";
value version="3.14" and version_date="2019-04-11";
VERSION='3.14'
DATE='2019-04-02'
DATE='2019-04-11'
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment