Commit 6a5882d6 authored by Gérard Huet's avatar Gérard Huet

Correction retroflexion preverbs. Several bugs corrected

parent ca103a46
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -68,7 +68,7 @@ value (sandhis, sandhir, sandhin, sandhif, sandhio) =
value filter_cesura sandhis =
List.map (List.filter (fun (w,_,_) -> not (List.mem 50 w))) sandhis
;
(* flag_pv =True for preverbs automaton *)
(* [flag_pv=True] for preverbs automaton *)
value get_sandhi flag_pv = fun (* argument is [mirror (code u)] *)
[ [] -> failwith "get_sandhi 0"
| [ 43 (* r *) :: before ] -> match before with
......@@ -143,7 +143,7 @@ and hash1 letter key sum = sum + letter*key
and hash b arcs rules = (* NB. [abs] needed because possible integer overflow *)
(abs (arcs + Gen.dirac b + List.length rules)) mod hash_max
;
(* flag_pv =True for prverbs automaton *)
(* [flag_pv=True] for preverbs automaton *)
value build_auto flag_pv (rewrite : rewrite_set) = traverse
(* [traverse: word -> lexicon -> (auto * stack * rewrite_set * int)] *)
(* The occurrence list [occ] is the reverse of the access word. *)
......
......@@ -140,15 +140,7 @@ and transabstvaa_file = data "transabstvaa.rem" (* [absoltvaa_automaton] *)
and transinftu_file = data "transinftu.rem" (* [inftu_automaton] *)
and transkama_file = data "transkama.rem" (* [kama_automaton] *)
and transstems_file = data "transstems.rem" (* [stems_automaton] *)
and declstxt_file = data "nouns.txt" (* created by [decline -ascii] *)
and declstex_file = data "nouns.tex" (* created by [decline -tex] *)
and declsxml_file = data "nouns.xml" (* created by [decline -xml] *)
and rootstxt_file = data "roots.txt" (* created by [conjug -ascii] *)
and rootstex_file = data "roots.tex" (* created by [conjug -tex] *)
and rootsxml_file = data "roots.xml" (* created by [conjug -xml] *)
and partstxt_file = data "parts.txt" (* created by [declinep -ascii] *)
and partstex_file = data "parts.tex" (* created by [declinep -tex] *)
and partsxml_file = data "parts.xml" (* created by [declinep -xml] *)
and mw_exc_file = data "mw_exceptions.rem" (* for MW indexing *)
and mw_index_file = data "mw_index.rem"
and guess_auto = data "guess_index.rem"
......
......@@ -133,8 +133,10 @@ value initial full = if full then initial1 else initial2
value dispatch1 w = fun (* w is the current input word *)
[ Nouv | Nouc | Pron | Inde | Abso | Auxi | Auxik | Kama | Ifcv | Ifcc
| Kriv | Kric | Absv | Absc | Avy | Lopak | Root | Lopa | Cache -> initial1
| A -> [ Iicc; Nouc; Iikc; Kric; Pvkc; Iivc; Vocc; Vokc ]
| An -> [ Iicv; Nouv; Iikv; Kriv; Pvkv; Iivv; Vocv; Vokv
| A -> if phantomatic w then [] else
[ Iicc; Nouc; Iikc; Kric; Pvkc; Iivc; Vocc; Vokc ]
| An -> if phantomatic w then [] else
[ Iicv; Nouv; Iikv; Kriv; Pvkv; Iivv; Vocv; Vokv
; A (* eg anak.sara anavadya *) ; An (* attested ? *) ]
| Ai -> [ Absc; Pvc ]
| Ani -> [ Absv; Pvv ]
......@@ -143,9 +145,10 @@ value dispatch1 w = fun (* w is the current input word *)
| Iicv | Iicc | Iikv | Iikc | Iiif | Auxiick | Cachei -> (* Compounding *)
[ Iicv; Iicc; Nouv; Nouc; A; An; Ifcv; Ifcc; Iikv; Iikc; Kriv; Kric
; Pvkv; Pvkc; Iiif; Iivv; Iivc; Vocv; Vocc; Vokv; Vokc ] @ cached
| Pv -> if amuitic w then [ Lopa ] else [ Root; Abso; Peri; Inftu ]
| Pvc | Pvv -> [ Abso ]
| Pvkc | Pvkv ->
| Pv -> if phantomatic w then [] else
if amuitic w then [ Lopa ] else [ Root; Abso; Peri; Inftu ]
| Pvc | Pvv -> if phantomatic w then [] else [ Abso ]
| Pvkc | Pvkv -> if phantomatic w then [] else
if amuitic w then [ Lopak ] else [ Iikv; Iikc; Kriv; Kric; Vokv; Vokc ]
| Iiv -> [ Auxi ] (* as bhuu and k.r finite forms *)
| Iivv | Iivc -> [ Auxik; Auxiick ] (* bhuu and k.r kridanta forms *)
......@@ -161,11 +164,14 @@ value dispatch1 w = fun (* w is the current input word *)
| ph -> failwith ("Dispatcher fake phase: " ^ string_of_phase ph)
]
and dispatch2 w = fun (* simplified segmenter *)
[ Noun2 | Pron | Inde | Abso | Absv | Absc | Auxi | Ifc2 -> initial2
| Root | Lopa -> (* no consecutive verbs in chunk *)
[ Inde; Iic2; Noun2; Pron ]
[ Noun2 | Pron | Inde | Abso | Absv | Absc | Auxi | Ifc2 ->
if phantomatic w then [ Root; Abso ] else initial2
| Root | Lopa ->
if phantomatic w then [] (* no consecutive verbs in chunk *)
else [ Inde; Iic2; Noun2; Pron ]
| Iic2 -> [ Iic2; Noun2; Ifc2 ]
| Pv -> if amuitic w then [ Lopa ] else [ Root; Abso ]
| Pv -> if phantomatic w then [] else
if amuitic w then [ Lopa ] else [ Root; Abso ]
| Iiv -> [ Auxi ]
| _ -> failwith "Dispatcher anomaly"
]
......@@ -309,7 +315,7 @@ value valid_morph_pv_k pv krit_stem morph = (* morph of form [Part_form] *)
if conj=Primary then attested_verb gana_pada pv root else attested pv root
with [ Unvoiced -> attested pv root ]
;
value validate_pv pv root_form = (* generalizes [roots_of] *)
value validate_pv pv root_form =
match Deco.assoc root_form morpho.roots with
[ [] -> fail_inconsistency root_form
| tags -> List.exists valid tags
......@@ -434,6 +440,17 @@ value apply_sandhi rleft right = fun
]
;
(* debug for validate -- vomit in interface
[value printout seg =
let print_seg (ph,w,_) = do
{ print_string (string_of_phase ph)
; print_string (" " ^ (Canon.rdecode w) ^ "<br />\n")
} in do
{ print_int (List.length seg); print_string " : "
; List.iter print_seg seg; print_string "<hr /><br />\n"
}
;] *)
(* [validate : output -> output] - dynamic consistency check in Segmenter.
It refines the regular language of dispatch by contextual conditions
expressing that preverbs are consistent with the following verbal form.
......@@ -617,12 +634,12 @@ value validate out = match out with
[ (Comp (Pv,Abso) pv abso_form,cpd_form,s) :: r ]
else []
]
| [ (Abso,rev_abso_form,s) :: next ] ->
| [ (Abso,rev_abso_form,s) :: next ] -> (* impossible since Abso follows Pv *)
raise (Control.Anomaly "Isolated Abso form") (* phase enforced *)
| [ (_,w,_) :: _ ] when phantomatic (Word.mirror w) ->
let mess = "Bug phantomatic segment: " ^ Canon.rdecode w in
raise (Control.Anomaly mess)
| [ (phase,_,_) :: [ (pv,_,_) :: _ ] ] when preverb_phase pv ->
| [ (phase,_,_) :: [ (pv,_,_) :: _ ] ] when preverb_phase pv ->
let m = "validate: " ^ string_of_phase pv ^ " " ^ string_of_phase phase in
raise (Control.Anomaly m) (* all preverbs ought to have been processed *)
(* We now prevent overgeneration of forms "sa" and "e.sa" \Pan{6,1,132} *)
......
......@@ -306,7 +306,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -3 (* *a *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-3])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2 ],[ 2 ], [ 1 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2 ],[ 2 ],[ 1 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 1 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -314,7 +314,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -9 (* *A *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-9])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2 ],[ 2 ], [ 2 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2 ],[ 2 ],[ 2 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 2 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -322,7 +322,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -4 (* *i *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-4])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 10 ],[ 2 ], [ 3 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 10 ],[ 2 ],[ 3 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 3 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -330,7 +330,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -7 (* *I *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-7])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 10 ],[ 2 ], [ 4 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 10 ],[ 2 ],[ 4 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 4 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -338,7 +338,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -5 (* *u *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-5])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 12 ],[ 2 ], [ 5 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 12 ],[ 2 ],[ 5 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 5 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -346,7 +346,7 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -8 (* *U *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-8])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 12 ],[ 2 ], [ 6 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 12 ],[ 2 ],[ 6 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 6 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -354,15 +354,16 @@ value accrue ((ph,revword,rule) as segment) previous_segments =
| [ -6 (* *r *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[-6])) :: rest ] ->
let w = sandhi_aa u in
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2; 43 ],[ 2 ], [ 7 ]))
[ new_segment :: [ (aa_phase ph,[ 2 ],Euphony ([ 2; 43 ],[ 2 ],[ 7 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_segment = (ph,Word.mirror [ 7 :: r ],rule)
| _ -> failwith "accrue anomaly"
]
| [ 123 (* *C *) :: r ] -> match previous_segments with
[ [ (phase,rword,Euphony (_,u,[ 123 ])) :: rest ] ->
if preverb_phase phase then failwith "accrue C with aa" else
let w = sandhi_aa u in
[ new_seg :: [ (aa_phase ph,[ 2 ],Euphony ([ 2; 22; 23 ],[ 2 ], [ 23 ]))
[ new_seg :: [ (aa_phase ph,[ 2 ],Euphony ([ 2; 22; 23 ],[ 2 ],[ 23 ]))
:: [ (phase,rword,Euphony (w,u,[ 2 ])) :: rest ] ] ]
where new_seg = (ph,Word.mirror [ 23 :: r ],rule)
| _ -> failwith "accrue anomaly"
......@@ -400,7 +401,7 @@ value access phase = acc (transducer phase) []
]
]
;
(* The scheduler gets its phase transitions from dispatcher *)
(* The scheduler gets its phase transitions from Dispatcher.dispatch *)
value schedule phase input output w cont =
let add phase cont = [ Advance phase input output w :: cont ] in
let transitions =
......
......@@ -192,15 +192,13 @@ value build_visual k segments =
if k < visual_width.(n) then find_ind_rec (n+1) else n in
match seg with
[ [] -> ()
| [ (phase,(w1,tr)) :: rest ] -> match phase with
[ Phases.Pv | Phases.Pvkc | Phases.Pvkv ->
failwith "Preverb in build_visual"
| _ -> do
| [ (phase,(w1,tr)) :: rest ] ->
if preverb_phase phase then failwith "Preverb in build_visual"
else do
{ visual.(start_ind) := visual.(start_ind) @ [ (w1,tr,phase,k) ]
; visual_width.(start_ind) := (seg_length w1) + k
; ass_rec rest
}
]
]
;
(* We check whether the current segment [(w,tr,phase,k)] is conflicting with
......
......@@ -219,7 +219,7 @@ Mini.reset ()
(* Special treatment for [preverbs_file] created by [Make_preverbs] *)
let deco = make_preverbs Data.preverbs_file in
let transducer = Make_automaton.make_transducer deco in
let transducer = Make_preverb_automaton.make_transducer deco in
Gen.dump transducer Data.transp_file
;
......
......@@ -35,11 +35,11 @@ value voices_of = fun
| "und" | "umbh" | "u.s" | ".rc#1" | ".rdh" | ".r.s" | "ej" | "kas" | "kiil"
| "ku.t" | "ku.n.th" | "kunth" | "kup" | "kul" | "ku.s" | "kuuj" | "k.rt#1"
| "k.rz" | "krand" | "krii.d" | "kru~nc#1" | "krudh#1" | "kruz" | "klam"
| "klid" | "kliz" | "kvath" | "k.sar" | "k.sal" | "k.si" | "k.sii" | "k.su"
| "k.sudh#1" | "k.subh" | "k.svi.d" | "kha~nj#1" | "khaad" | "khid" | "khel"
| "khyaa" | "gaj" | "gad" | "garj" | "gard" | "gal" | "gaa#1" | "gaa#2"
| "gu~nj" | "gu.n.th" | "gup" | "gumph" | "g.rdh" | "g.rr#1" | "g.rr#2"
| "granth" | "grah" | "glai" | "ghas" | "ghu.s" | "gh.r" | "gh.r.s"
| "klid" | "kliz" | "kvath" | "k.sar" | "k.sal" | "k.saa" | "k.si" | "k.sii"
| "k.su" | "k.sudh#1" | "k.subh" | "k.svi.d" | "kha~nj#1" | "khaad" | "khid"
| "khel" | "khyaa" | "gaj" | "gad" | "garj" | "gard" | "gal" | "gaa#1"
| "gaa#2" | "gu~nj" | "gu.n.th" | "gup" | "gumph" | "g.rdh" | "g.rr#1"
| "g.rr#2" | "granth" | "grah" | "glai" | "ghas" | "ghu.s" | "gh.r" | "gh.r.s"
| "ghraa" | "cakaas" | "ca.t" | "cand" | "cam" | "car" | "cal" | "cit#1"
| "cumb" | "chur" | "ch.rd" | "jak.s" | "jap" | "jabh#2" | "jam" | "jalp"
| "jas" | "jaag.r" | "jinv" | "jiiv" | "jvar" | "jval" | "tak" | "tak.s"
......@@ -92,7 +92,7 @@ value voices_of = fun
| "az#1" | "aas#2" | "indh" | "iik.s" | "ii.d" | "iir" | "iiz#1" | "ii.s"
| "iih" | "edh" | "katth" | "kam" | "kamp" | "kaaz" | "kaas#1" | "kuu"
| "k.rp" | "k.lp" (* but Henry: {cak.lpur} "ils s'arrangèrent" *)
| "knuu" | "klav" | "k.sad" | "k.sam" | "galbh" | "gur" | "glah"
| "knuu" | "klav" | "k.sad" | "galbh" | "gur" | "glah"
| "gha.t" | "jabh#1" | "ju.s#1" | "j.rmbh" | ".damb" | ".dii" | "tandr"
| "tij" | "trap" | "trai" | "tvar" | "dak.s" | "day" | "diik.s" | "diip"
| "d.r#1" | "dhii#1" | "dhuk.s" | "pa.n" | "pad#1" | "pi~nj"
......@@ -107,13 +107,14 @@ value voices_of = fun
(*| "smi" Ubha needed for smitavat *)
(*| "bhuj#2" Ubha needed for bhunakti to govern *)
(*| "gaah" Ubha needed for gaahet epics *)
(*| "k.sam" Ubha needed for k.samati epics *)
(* DRP restriction: "dyut#1" *)
-> Atma (* "deponent" verbs: middle only *)
| _ -> Ubha (* default *)
(* Attested Ubha (over all ga.nas) :
[ "a~nc" | "arh" | "i" | "i.s#1" | "uc" | "uurj#1" | "uuh" | ".r" | ".rj"
| "ka.n.d" | "kal" | "ka.s" | "ku.t.t" | "ku.n.d" | "k.r#1" | "k.r#2" | "k.r.s"
| "kram" | "krii" | "k.san" | "k.sap#1" | "k.sal" | "k.sip" | "k.sud"
| "kram" | "krii" | "k.san" | "k.sap#1" | "k.sam" | "k.sal" | "k.sip" | "k.sud"
| "k.s.nu" | "khan" | "gam" | "garh" | "gaah" | "guh" | "gras" | "gha.t.t"
| "cat" | "carc" | "ci" | "cint" | "cud" | "ce.s.t" | "cyu" | "chad#1"
| "chand" | "chid#1" | "jan" | "juu" | "j~naa#1" | "jyaa#1" | "jyut" | "ta.d"
......@@ -127,9 +128,9 @@ value voices_of = fun
| "muc#1" | "mud#1" | "m.r" | "m.rj" | "m.rdh" | "m.r.s" | "yaj#1" | "yam"
| "yaac" | "yu#1" | "yuj#1" | "rac" | "ra~nj" | "ram" | "rah" | "raaj#1" | "ri"
| "ric" | "rud#1" | "rudh#2" | "lafgh" | "lak.s" | "labh" | "la.s" | "lip"
| "lih#1" | "lup" | "luu#1" | "vad" | "vap#1" | "vap#2" | "val" | "vah#1"
| "vaa#3" | "vic" | "vij" | "viij" | "v.r#2" | "v.rt#1" | "vyath" | "vyaa"
| "vrii" | "zap" | "zaa" | "zu.s" | "zubh#1" | "zyaa" | "zram" | "zri"
| "lih#1" | "lup" | "luu#1" | "vad" | "van" | "vap#1" | "vap#2" | "val"
| "vah#1" | "vaa#3" | "vic" | "vij" | "viij" | "v.r#2" | "v.rt#1" | "vyath"
| "vyaa" | "vrii" | "zap" | "zaa" | "zu.s" | "zubh#1" | "zyaa" | "zram" | "zri"
| "zru" | "sru" | "san#1" | "sah#1" | "sic" | "su#2" | "suud" | "stambh"
| "stu" | "st.rr" | "sthaa#1" | "sp.rz#1" | "sp.rh" | "smi" | "syand"
| "svad" | "had" | "hikk" | "hu" | "huu" | "h.r#1" ] *)
......@@ -228,12 +229,11 @@ value voices_of_gana g root = match g with
]
| 7 -> match root with
[ "vid#2" -> Atma
| "ric" -> Para
| _ -> voices_of root
]
| 8 -> match root with
[ "man" -> Atma
| _ -> voices_of root (* van Ubha *)
| _ -> voices_of root
]
| 9 -> match root with
[ "jyaa#1" | "pu.s#1" | "mii" | "m.rd#1" | "ri" | "vrii" | "stambh"
......@@ -313,8 +313,8 @@ value voices_of_pv upasarga gana = fun
| "pari" | "ava" -> Atma
| _ -> Para (* \Pan{1,3,18} *)
]
(* Next three equivalent to marking "unused" in lexicon *)
| "ta~nc" | "saa#1" | "zam#2" | "zal" (* also "khyaa" ? *) ->
(* Next four equivalent to marking "unused" in lexicon *)
| "ta~nc" | "saa#1" | "zam#2" | "zal" (* | "khyaa" ? *) ->
match upasarga with
[ "" -> raise Unattested (* thus braa.hmasya "Ô Brahmane, tue" unrecognized *)
| _ -> Para
......
......@@ -289,7 +289,7 @@ value sandhi revstem wsuff =
(* But [int_sandhi] may provoke too much retroflexion, such as *si.sarti
instead of sisarti for root s.r in redup3 below.
Same pb to avoid *pu.sphora as perfect of sphur, instead of pusphora.
Thus need of the boolean argument retr: *)
Thus need of the boolean argument retr in the following: *)
value revaffix retr revpref rstem =
let glue = if retr then Int_sandhi.int_sandhi else List2.unstack in
rev (glue revpref (rev rstem)) (*i too many revs - ugly i*)
......@@ -386,8 +386,7 @@ value stems root =
]
;
value drop_penultimate_nasal = fun
[ [ c :: [ n :: s ] ] -> if nasal n then [ c :: s ]
else failwith "No penultimate nasal"
[ [ c :: [ n :: s ] ] when nasal n -> [ c :: s ]
| _ -> failwith "No penultimate nasal"
]
;
......@@ -434,10 +433,12 @@ value passive_stem entry rstem = (* Panini yak (k : no guna, samprasaara.na) *)
match weak with
[ [ c :: rst ] -> match c with
[ 2 (* aa *) -> match rst with
[ [ 42 (* y *) :: r ] -> [ 4 (* ii *) :: r ] (* ziiyate stiiyate *)
[ [ 42 (* y *) ] (* yaa1 *)
| [ 42 (* y *); 18 (* kh *) ] (* kyaa *)
| [ 42 (* y *); 35 (* dh *) ] (* dhyaa *) -> weak
| [ 42 (* y *) :: r ] -> [ 4 (* ii *) :: r ] (* ziiyate stiiyate *)
| _ -> match entry with
[ "j~naa#1" | "dhyaa" | "bhaa#1" | "mnaa" | "yaa#1" | "laa"
| "zaa" | "haa#2"
[ "j~naa#1" | "bhaa#1" | "mnaa" | "laa" | "zaa" | "haa#2"
-> weak
| _ -> [ 4 (* ii *) :: rst ]
]
......@@ -591,7 +592,7 @@ and o_it = fun (* these roots have ppp in -na \Pan{8,2,45} - unused here *)
| "nud" | "pad#1" | "pii" | "p.rr" | "pyaa" | "bhid#1" | "majj" | "man"
| "mid" | "mlaa" | "ri" | "lii" | "luu#1" | "vid#2" | "vlii" | "zad" | "z.rr"
| "sad#1" | "skand" | "st.rr" | "styaa" | "syand" | "svid#2" | "had" *)
(* also "suu#2" suuna and "vrii" vrii.na *)
(* also "suu#2" suuna and "vrii" vrii.na and "k.saa" k.saa.na *)
-> True
| _ -> False
]
......@@ -2335,8 +2336,9 @@ value compute_future stem entry =
| _ -> match voices_of entry with
[ Para -> do (* active only *)
{ compute_futurea Primary stem entry
; match entry with (* conditional on demand *)
; match entry with (* conditional or atma on demand *)
[ "gam" | "bhuu#1" -> compute_conda Primary stem entry
| "khaad" -> compute_futurem Primary stem entry
| _ -> ()
]
}
......@@ -2400,12 +2402,12 @@ value intercalates root =
else if semivowel c then set
else match root with
[ "ak.s" | "a~nj" | "k.rt#1" | "k.rp" | "k.lp" | "kram" | "k.sam"
| "klid" | "gup" | "guh" | "ghu.s" | "jan" | "ta~nc" | "tap" | "t.rd"
| "tyaj#1" | "dah#1" | "d.rp" | "nam" | "naz" | "n.rt" | "bandh"
| "bhaj" | "majj" | "man" | "m.rj" | "yam" | "ruh" | "labh" | "likh"
| "vap#2" | "vas#1" | "vah#1" | "vij" | "vid#1" | "v.rj" | "v.rt#1"
| "vrazc" | "sad#1" | "sah#1" | "sidh#2" | "svap" | "han#1"
| "syand" (* WR says set for atma, anit for para *)
| "klid" | "kliz" | "gup" | "guh" | "ghu.s" | "jan" | "ta~nc"
| "tap" | "t.rd" | "tyaj#1" | "dah#1" | "d.rp" | "nam" | "naz"
| "n.rt" | "bandh" | "bhaj" | "majj" | "man" | "m.rj" | "yam"
| "ruh" | "labh" | "likh" | "vap#2" | "vas#1" | "vah#1" | "vij"
| "vid#1" | "v.rj" | "v.rt#1" | "vrazc" | "sad#1" | "sah#1"
| "sidh#2" | "svap" | "han#1" | "syand" (* WR: set atma, anit para *)
-> vet
| "grah" -> setl
| "s.rj#1" -> [ 3 ] (* sra.s.taa *)
......@@ -2482,12 +2484,12 @@ value intercalate_pp root rstem =
| "ghu.s" (* \Pan{7,2,23} *) | "ka.s" (* \Pan{7,2,22} *)
| "dh.r.s" (* \Pan{7,2,19} *)
| "am" | "tvar" (* \Pan{7,2,28} *) -> vet (* but only set for -tvaa *)
| "kas" | "gup" | "dyut#1" | "dham" | "nud" | "m.rj" -> vet
| "kas" | "k.sam" | "gup" | "dyut#1" | "dham" | "nud" | "m.rj" -> vet
(* NB zaas vet for stem zaas but admits also zi.s only anit *)
| "aj" | "a.t" | "at" | "an#2" | "az#2" | "aas#2" | "i.s#2"
| "ii.d" | "iir" | "iiz#1" | "ii.s" | "iih" | "uc" | ".rc#1" | ".rj"
| "ej" | "edh" | "kath" | "kal" | "kaaz" | "kiil" | "kuc" | "kup"
| "ku.s" | "kuuj" | "k.rz" | "krii.d" | "klav" | "kvath" | "k.sam"
| "ku.s" | "kuuj" | "k.rz" | "krii.d" | "klav" | "kvath"
| "k.sar" | "k.sudh#1" | "k.svi.d" | "khaad" | "ga.n" | "gad" | "gal"
| "granth" | "gha.t" | "ghaat" | "cak" | "ca.t" | "car" | "cal"
| "cud" | "cur" | "chal" | "jiiv" | "jval" | "ta.d" | "tam" | "tul"
......@@ -2562,14 +2564,14 @@ value compute_ppp_stems entry rstem =
[ "vrazc" -> [ sNa "v.rk" ] (* exception - v.rk root stem of vrazc *)
(* Most roots starting with 2 consonants take -na \Pan{8,2,43} *)
(* but not "k.svi.d" "zrath" *)
| "iir" | "und" | "k.rr" | "klid" | "k.sii" | "k.sud" | "k.svid" | "khid"
| "g.rr#1" | "glai" | "chad#1" | "chid#1" | "ch.rd" | "j.rr" | ".dii"
| "tud#1" | "t.rd" | "t.rr" | "dagh" | "d.rr" | "dev" | "draa#1" | "draa#2"
| "nud" | "pad#1" | "pii" | "p.rr" | "pyaa" | "bha~nj" | "bhid#1" | "bhuj#1"
| "majj" | "man" | "mid" | "mlaa" | "ri" | "lii" | "luu#1" | "vij" | "vid#2"
| "vrii" | "vlii" | "zad" | "zuu" | "z.rr" | "sad#1" | "skand" | "st.rr"
| "styaa" | "syand" | "svid#2" | "had" | "haa#2"
->
| "iir" | "und" | "k.rr" | "klid" | "k.saa" | "k.sii" | "k.sud" | "k.svid"
| "khid" | "g.rr#1" | "glai" | "chad#1" | "chid#1" | "ch.rd" | "j.rr"
| ".dii" | "tud#1" | "t.rd" | "t.rr" | "dagh" | "d.rr" | "dev" | "draa#1"
| "draa#2" | "nud" | "pad#1" | "pii" | "p.rr" | "pyaa" | "bha~nj"
| "bhid#1" | "bhuj#1" | "majj" | "man" | "mid" | "mlaa" | "ri" | "lii"
| "luu#1" | "vij" | "vid#2" | "vrii" | "vlii" | "zad" | "zuu" | "z.rr"
| "sad#1" | "skand" | "st.rr" | "styaa" | "syand" | "svid#2" | "had"
| "haa#2" ->
(* except lag which is "nipaatana" (exception) \Pan{7,2,18} *)
let ppna w = [ Na w ] in
match rstem with
......@@ -2645,7 +2647,7 @@ value compute_ppp_stems entry rstem =
| "khan" -> revcode "khaa" (* \Pan{6,4,42} lengthening of vowel *)
| "jan" -> revcode "jaa" (* id *)
| "san#1" -> revcode "saa" (* id *)
| "am" -> revcode "aan" (* -am -> -aan \Pan{6,4,15} *)
| "am" -> revcode "aan" (* -am -> -aan \Pan{6,4,15} Wh§955a *)
| "kam" -> revcode "kaan"
| "kram" -> revcode "kraan"
| "cam" -> revcode "caan"
......@@ -2655,7 +2657,7 @@ value compute_ppp_stems entry rstem =
| "vam" -> revcode "vaan"
| "zram" -> revcode "zraan"
| "zam#1" | "zam#2" -> revcode "zaan"
| "dhvan" -> revcode "dhvaan" (* id. for final n *) (* Whit§955a *)
| "dhvan" -> revcode "dhvaan" (* id. for final n *) (* Wh§955a *)
| "daa#2" -> revcode "di" (* aa -> i \Pan{7,4,40} *)
| "maa#1" -> revcode "mi"
| "zaa" -> revcode "zi"
......@@ -3077,6 +3079,7 @@ value redup_perf root =
[ "ce.s.t" | "diiv#1" | "dev" |"sev" | "mlecch" | "vye"
-> 3 (* i *) (* vye for vyaa *)
| _ -> 1 (* a *) (* also bhuu elsewhere *)
(* but Vedic k.lp etc have long aa Whitney§786a *)
]
else match root with
[ "maa#3" -> 3 (* i *) (* analogy with present *)
......@@ -3589,7 +3592,7 @@ value sigma augment stem suff =
| _ -> error_empty 17
]
| [ c :: _ ] -> [ 48 (* s *) :: sfx ]
| _ -> error_empty 18
| [ ] -> []
] in
let form = sandhi stem ssfx in
if augment then aug form else form
......@@ -4127,9 +4130,9 @@ value compute_aorist entry =
| _ -> ()
]
; match entry with (* 4. sigma aorist sic *)
[ "aap" | "k.r#1" | "gup" | "chid#1" | "ji" | "tud" | "t.rr" | "tyaj#1"
| "dah#1" | "daa#1" | "d.rz#1" | "draa#2" | "dhaa#1" | "dhyaa" | "dhyai"
| "dhv.r" | "nak.s" | "nii#1" | "pac" | "praz" | "prii"
[ "aap" | "k.r#1" | "khan" | "gup" | "chid#1" | "ji" | "tud" | "t.rr"
| "tyaj#1" | "dah#1" | "daa#1" | "d.rz#1" | "draa#2" | "dhaa#1" | "dhyaa"
| "dhyai" | "dhv.r" | "nak.s" | "nii#1" | "pac" | "praz" | "prii"
| "budh#1" | "bhaa#1" | "bhii#1" | "muc#1" | "yaj#1" | "yuj#1" | "ram"
| "labh" | "v.r#2" | "vyadh" | "zru" | "sidh#1" | "s.rj#1" | "stu"
| "sp.rz#1" | "hu" -> do
......@@ -4139,11 +4142,21 @@ value compute_aorist entry =
| _ -> long
] in
compute_ath_s_aorista stem entry
; match entry with (* Whitney§890 *)
[ "khan" (* akhaan *)
| "dah#1" (* adhaak *)
(* | "d.rz1" adraak wrong *adaar.t below TODO use [ar_ra] *)
| "yaj#1" (* ayaa.t *)
(* | "s.rj1" asraak wrong *asaar.t below *)
-> let lopa = sigma True long "" in
enter1 entry (Conju (aora 4) [ (Singular,[ (Third, lopa) ]) ])
| _ -> ()
]
; if entry = "yuj#1" || entry = "chid#1"
then compute_ath_s_aorista strong entry else ()
(* ayok.siit and acchetsiit besides ayauk.siit and acchaitsiit *)
; match entry with
[ "gup" -> () (* active only *)
[ "gup" | "d.rz#1" | "s.rj#1" -> () (* active only *)
| _ -> let stemm = match weak with
[ [ c :: r ] -> match c with
[ 3 | 4 | 5 | 6 (* i ii u uu *) -> strong
......@@ -4215,11 +4228,11 @@ value compute_aorist entry =
| _ -> ()
]
; match entry with (* 7. sa aorist ksa *)
[ "guh" | "diz#1" | "dih" | "duh#1" | "lih#1" | "viz#1" | "v.rj"
| "sp.rz#1" -> do
(* \Pan{7,3,72-73} *)
[ "kruz" | "kliz" | "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
; if entry = "kruz" || entry = "kliz" then ((* Para *))
else compute_ath_sa_aoristm weak entry
}
| "pac" -> do (* Kiparsky apaak.sam *)
{ compute_ath_sa_aorista long entry
......@@ -4351,8 +4364,8 @@ value compute_aor_ca cpstem entry =
| "t.rr" (* atiitarat *)
| "vah#1" (* aviivahat *)
| "hlaad" (* ajihladat *)
(* | "jan" (* wrong *ajijiinat for ajiijanat *)
| "sp.rz#1" (* wrong *apii.spazat for apisp.rzat *) TODO *) ->
(*| "jan" (* wrong *ajijiinat for ajiijanat *)
| "sp.rz#1" (* wrong *apii.spazat for apisp.rzat *) TODO *) ->
match cpstem with (* cpstem-ayati is the ca stem *)
[ [ 37 :: [ 2 :: w ] ] -> (* w-aapayati *)
let voy = if entry = "daa#1" then 1 (* a *)
......@@ -4369,11 +4382,11 @@ value compute_aor_ca cpstem entry =
}
| [ c :: w ] ->
let (v,light,r) = look_rec True w
where rec look_rec b = fun
[ [ ] -> error_empty 31
| [ x :: w' ] -> if vowel x then (x,b && short_vowel x,w')
else look_rec False w'
] in
where rec look_rec b = fun
[ [ ] -> error_empty 31
| [ x :: w' ] -> if vowel x then (x,b && short_vowel x,w')
else look_rec False w'
] in
let voy = match v with
[ 5 (* u *) -> 6
| 6 (* uu *) -> 5
......@@ -5573,7 +5586,7 @@ value compute_conjugs_stems entry (vmorph,aa) = do (* main *)
match entry with
[ "ifg" | "paz" | "cint" (* d.rz cit *)
| "bruu" (* vac *)
| "cud" | "dhii#1" | "pat#2" |"praa#1" | "vidh#1" | "zlath"
| "k.saa" | "cud" | "dhii#1" | "pat#2" |"praa#1" | "vidh#1" | "zlath"
-> () (* no future *)
| "tud#1" | "cakaas" -> () (* only periphrastic *)
| "bharts" -> compute_future_gen rstem entry (* exception gana 10 *)
......@@ -5591,7 +5604,7 @@ value compute_conjugs_stems entry (vmorph,aa) = do (* main *)
; (* Periphrastic future, Infinitive, Passive future part. in -tavya *)
match entry with
[ "ifg" | "paz" (* for d.rz *) | "bruu" (* for vac *)
| "cud" | "dhii#1" | "pat#2" | "praa#1" | "vidh#1"
| "k.saa" | "cud" | "dhii#1" | "pat#2" | "praa#1" | "vidh#1"
| "haa#2" -> () (* no perif *)
| "saa#1" -> do { compute_perif (revcode "si") entry
; compute_perif rstem entry
......@@ -5640,7 +5653,8 @@ value compute_conjugs_stems entry (vmorph,aa) = do (* main *)
; (* Perfect *)
match entry with
[ "paz" (* d.rz *) | "bruu" (* vac *) | "ma.mh" (* mah *) | "ind"
| "indh" | "inv" | "cakaas" | "dhii#1" | "vidh#1" -> () (* no perfect *)
| "indh" | "inv" | "k.saa" | "cakaas" | "dhii#1" | "vidh#1"
-> () (* no perfect *)
| "uuh" -> () (* periphrastic *)
| _ -> compute_perfect entry
]
......
......@@ -8,4 +8,4 @@
(**************************************************************************)
(* Generated by make version - see main Makefile *)
value version="3.20" and version_date="2019-11-15";
value version="3.20" and version_date="2019-12-01";
......@@ -346,7 +346,8 @@ $(DATA)/lopaks.rem $(DATA)/indecls.rem $(DATA)/abstvaa.rem $(DATA)/absya.rem \
$(DATA)/iics.rem $(DATA)/piics.rem $(DATA)/ifcs.rem $(DATA)/iivs.rem \
$(DATA)/iifcs.rem $(DATA)/auxi.rem $(DATA)/voca.rem $(DATA)/invs.rem \
$(DATA)/inftu.rem $(DATA)/kama.rem $(DATA)/nouns2.rem $(DATA)/iics2.rem \
$(DATA)/avyayais.rem $(DATA)/avyayafs.rem $(DATA)/ifcs2.rem
$(DATA)/avyayais.rem $(DATA)/avyayafs.rem $(DATA)/ifcs2.rem \
$(DATA)/auxik.rem $(DATA)/auxiick.rem $(DATA)/partvocs.rem
SANDHIS=$(DATA)/sandhis.rem $(DATA)/sandhis_pv.rem $(DATA)/sandhis_ph.rem \
$(DATA)/sandhis_id.rem
......@@ -360,15 +361,14 @@ $(DATA)/transr.rem $(DATA)/transiiy.rem $(DATA)/transavy.rem $(DATA)/transp.rem
$(DATA)/transpa.rem $(DATA)/transic.rem $(DATA)/transif.rem \
$(DATA)/transpic.rem $(DATA)/transiif.rem $(DATA)/transabsya.rem \
$(DATA)/transabstvaa.rem $(DATA)/transiv.rem $(DATA)/transinde.rem \