Skip to content
GitLab
Commit 6a5882d6 authored by Gérard Huet's avatar Gérard Huet
Browse files

Correction retroflexion preverbs. Several bugs corrected

parent ca103a46
Hide whitespace changes
Inline Side-by-side
DOC/Heritage_Platform.tex
View file @ 6a5882d6
This source diff could not be displayed because it is too large. You can view the blob instead.
ML/automata.ml
View file @ 6a5882d6
......@@ -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. *)
......
ML/data.ml
View file @ 6a5882d6
......@@ -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"
......
ML/dispatcher.ml
View file @ 6a5882d6
......@@ -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} *)
......
ML/graph_segmenter.ml
View file @ 6a5882d6
......@@ -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 =
......
ML/interface.ml
View file @ 6a5882d6
......@@ -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
......
ML/make_transducers.ml
View file @ 6a5882d6
......@@ -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
;
......
ML/pada.ml
View file @ 6a5882d6
......@@ -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
......
ML/verbs.ml
View file @ 6a5882d6
......@@ -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
]
......
ML/version.ml
View file @ 6a5882d6
......@@ -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";
SETUP/MMakefile
View file @ 6a5882d6
......@@ -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 \
$(DATA)/partvocs.rem $(DATA)/transpav.rem $(DATA)/translopak.rem \
$(DATA)/transpav.rem $(DATA)/translopak.rem \
$(DATA)/transauxi.rem $(DATA)/transvoca.rem $(DATA)/translopa.rem \
$(DATA)/transn2.rem $(DATA)/transif2.rem $(DATA)/transic2.rem \
$(DATA)/auxik.rem $(DATA)/auxiick.rem $(DATA)/transauxik.rem \
$(DATA)/transauxiick.rem $(DATA)/transinv.rem $(DATA)/transinftu.rem \
$(DATA)/transkama.rem
$(DATA)/transauxik.rem $(DATA)/transauxiick.rem $(DATA)/transinv.rem \