Commit a437bc81 authored by Gérard Huet's avatar Gérard Huet

final fix to Interface for correct segmentation of caakiirti.h naabibhyat...

final fix to Interface for correct segmentation of caakiirti.h naabibhyat caatiiram naabhaava.h caatathyam mahaajana.h
parent 18d4a83b
......@@ -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 conjugation for computing root conjugations. *)
......@@ -342,6 +342,7 @@ value display_inflected_u font inf absya per abstva = do
; display_ind (absolutive_caption True font) font abstva
; display_ind (absolutive_caption False font) font (List.map prefix_dash absya)
where prefix_dash (c,w) = (c,[ 0 :: w ])
(* NB will display twice absol in -am *)
; display_ind (peripft_caption font) font per
; pl center_end
}
......
......@@ -922,7 +922,6 @@ value build_an_god stem entry = (* Whitney §426a *)
; Bare Noun (wrap stem 1)
]
;
value build_sp_an stem entry =
(* Whitney§432 these stems substitute the following for Voc Nom Acc :
"yakan" \R "yak.rt"
......@@ -930,8 +929,9 @@ value build_sp_an stem entry =
"udan" \R "udaka"
"yuu.san" \R "yuu.sa"
"do.san" \R "dos"
"asan" \R "as.rk"
"aasan" \R "aasya" *)
"asan" \R "as.rj"
"aasan" \R "aasya"
Kale§129 Renou§241d *)
let decline case suff = (case,fix stem suff) in
enter entry
[ Declined Noun Neu
......@@ -950,7 +950,8 @@ value build_sp_an stem entry =
; decline Loc "nos"
])
; (Plural,
[ decline Ins "abhis"
[ decline Acc "aani" (* Kale§129 zakan but not yakan, Renou: trouble *)
; decline Ins "abhis"
; decline Dat "abhyas"
; decline Abl "abhyas"
; decline Gen "naam"
......@@ -3785,6 +3786,13 @@ value build_ap entry =
Phonetics.asp, in order to transform eg duk in dhuk (Whitney §155) *)
value build_root g stem entry =
let decline case suff = (case,fix stem suff)
and decline_nasalise case suff =
let nstem = match stem with
[ [ c :: r ] -> if nasal c then stem else
try [ c :: [ (homonasal c) :: r ]]
with [ Failure _ -> stem ]
| _ -> failwith "build_root"
] in (case,fix nstem suff)
and declfin case suff =
(* [finalize_r] for doubling of vowel in r roots Whitney §245b *)
(case,fix (finalize_r stem) suff)
......@@ -3812,10 +3820,10 @@ value build_root g stem entry =
; decline Loc "os"
])
; (Plural,
[ decline Voc (if g=Neu then "i" else "as")
; decline Nom (if g=Neu then "i" else "as")
; decline Acc (if g=Neu then "i" else "as")
(* Voc Nom Acc Neu ought to have nasal : vr.nti Whitney§389c p. 145 *)
[ if g=Neu then decline_nasalise Voc "i" else decline Voc "as"
; if g=Neu then decline_nasalise Nom "i" else decline Nom "as"
; if g=Neu then decline_nasalise Acc "i" else decline Acc "as"
(* Voc Nom Acc Neu ought to have nasal : v.rnti Whitney§389c p. 145 *)
(* Acc. vaacas with accent on aa or on a Whitney§391 p. 147 *)
; declfin Ins "bhis"
; declfin Dat "bhyas"
......@@ -3829,7 +3837,7 @@ value build_root g stem entry =
; Avyayaf bare
]
;
value build_root_m g trunc stem entry = (* Kale§107 *)
value build_root_m g trunc stem entry = (* Kale§107 prazaam *)
let decline case suff = (case,fix stem suff)
and declcon case suff = (case,fix [ 36 (* n *) :: trunc ] suff) in
enter entry
......@@ -5220,8 +5228,9 @@ value compute_nouns_stem_form e stem d p =
| [ 24 :: r1 ] (* -j *) -> match r1 with (* m.rjify *)
[ [ 2 :: [ 43 :: _ ] ] (* -raaj2 viraaj2 *)
| [ 2 :: [ 42 :: _ ] ] (* -yaaj2 *)
| [ 7; 48 ] (* s.rj2 *) -> build_root Neu [ 124 (* j' *) :: r1 ] e
| [ 5; 42 ] (* yuj2 *) -> do
| [ 7 :: [ 48 :: _ ] ] (* -s.rj2 as.rj *)
-> build_root Neu [ 124 (* j' *) :: r1 ] e
| [ 5; 42 ] (* yuj2 *) -> do
{ build_root Neu stem e
; build_archaic_yuj [ 24; 26; 5; 42 ] (* yu~nj *) Neu e
}
......@@ -5235,7 +5244,7 @@ value compute_nouns_stem_form e stem d p =
| _ -> build_neu_at r1 e (* e.g. jagat *)
]
| [ 2 :: r2 ] (* -aat *) -> build_neu_at r1 e (* ppr in aat/aant ? *)
| _ -> build_root Neu stem e
| _ -> build_root Neu stem e
]
| [ 34 :: r1 ] (* -d *) -> match r1 with
[ [ 1 :: r2 ] (* -ad *) -> match r2 with
......
......@@ -229,11 +229,11 @@ value voices_of_gana g root = match g with
| _ -> voices_of root (* van Ubha *)
]
| 9 -> match root with
[ "jyaa#1" | "pu.s#1" | "mii" | "m.rd#1" | "ri" -> Para
[ "jyaa#1" | "pu.s#1" | "mii" | "m.rd#1" | "ri" | "stambh" -> Para
| _ -> voices_of root
]
| 10 -> match root with
[ "gha.t.t" | ".damb" | "mid" | "mok.s" | "lak.s" | "lok" | "stambh"
[ "gha.t.t" | ".damb" | "mid" | "mok.s" | "lak.s" | "lok"
-> Para
| "arth" -> Atma
| _ -> voices_of root (* other denominatives will take Ubha as default *)
......
......@@ -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 Parts = struct i*)
......
......@@ -57,6 +57,7 @@ and rivarna c = c=7 || c=8 (* .r .rr *)
;
value not_a_vowel c = vowel c && not (avarna c) (* c>2 and c<14 *)
and is_aa c = c=2
and is_i_or_u c = c=3 || c=5
and not_short_vowel c = vowel c && not (short_vowel c)
;
(* segments a word as a list of syllables - Unused *)
......
......@@ -4,7 +4,7 @@
(* *)
(* Gérard Huet *)
(* *)
(* ©2017 Institut National de Recherche en Informatique et en Automatique *)
(* ©2019 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)
(*i module Sandhi = struct i*)
......@@ -220,6 +220,7 @@ value ext_sandhi_pair wl wr =
| 36 -> [ 14; 46; first ] (* n+c {\R} {\d m}\'sc *)
| c -> [ if visargor c then 46 else c; first ]
]
(* | 31 (* {\d n} *) missing c+.n = f.n TODO *)
| c -> failwith ("illegal start of right arg of sandhi in " ^ decode wr)
] (* match first *) in (* let glue *)
let (w1,w2) = match glue with
......
......@@ -417,7 +417,7 @@ value passive_stem entry rstem = (* Panini -yak (k means no guna) *)
| "zii#1" -> revcode "zay" (* \Pan{7,4,22} *)
| "pyaa" -> revcode "pyaay" (* pyaa=pyai *)
| "indh" | "und" | "umbh" | "gumph" | "granth" | "da.mz" | "dhva.ms"
| "bandh" | "bhra.mz" | "za.ms" | "zrambh"
| "bandh" | "bhra.mz" | "za.ms" | "zrambh" | "skambh" | "skand"
(* above roots have penultimate nasal and do not have [i_it] marker *)
| "ba.mh" | "ma.mh" | "manth" | "stambh"
(* these four roots are listed in dhatupathas as bahi, mahi, mathi, stabhi
......@@ -2677,6 +2677,7 @@ value compute_ppp_stems entry rstem =
| "puuy" -> revcode "puu"
| "bhi.saj#2" -> revcode "bhi.sajy"
| "skambh" -> revcode "skabh" (* skambh -> skabh *)
| "stambh" -> revcode "stabh" (* stambh -> stabh *)
| "zrath" -> revcode "zranth"
| "muurch" -> revcode "muur" (* muurta *)
| "av" -> revcode "uu" (* uuta *)
......@@ -2693,8 +2694,8 @@ value compute_ppp_stems entry rstem =
] in [ Ta ppstem :: match entry with
[ ".rc#1" | ".rj" | "k.svi.d" | "ba.mh" | "ma.mh" | "manth"
| "m.rg" | "yaj#1" | "vyadh" | "grah" | "vrazc" | "praz"
| "zrath" | "svap" ->
[ Tia ppstem ] (* avoids *ma.mhita *)
| "zrath" | "svap" | "stambh" ->
[ Tia ppstem ] (* avoids *ma.mhita *)
| "vaz" | "vac" | "vap" | "vap#1" | "vap#2" | "vad"
| "vas#1" | "vas#4" ->
[ Tia rstem; Tia ppstem ]
......@@ -4731,7 +4732,8 @@ value record_ppp_abs_stems entry rstem ppstems =
| "vaz" | "vac" | "vap" | "vap#1" | "vap#2" | "vad"
| "vas#1" | "vas#4" -> w
| "siiv" -> revcode "sev" (* gu.na *)
| _ -> strong w
| "stambh" -> rstem (* stabhita but stambhitvaa! *)
| _ -> strong w
] in
record_abso_tvaa (fix tstem itvaa) entry
; if alternate_tvaa entry rstem then
......@@ -4789,6 +4791,7 @@ value record_abso_am root =
| "s.r" -> record "saaram"
| "s.rp" -> record "sarpam"
| "skand" -> record "skandam"
| "stambh" -> record "stambham"
| "han" -> record "ghaatam" (* \Pan{3,4,36+37} *)
| "knuu" -> record "knopam" (* from causative *)
| _ -> ()
......@@ -5171,7 +5174,7 @@ value compute_present_system entry rstem gana pada third =
let (stem,vow) = match rstem with
[ [ 36; 3 ] (* in *) -> ([ 3 ] (* i *),True) (* Whitney§716a *)
| [ 5; 43; 46 ] (* zru *) -> ([ 7; 46 ] (* z.r *),True)
| [ 40 :: [ 41 :: r ] ] -> ([ 40 :: r ],False) (* skambh -> skabh *)
| [ 40 :: [ 41 :: r ] ] -> ([ 40 :: r ],False) (* skambh stambh *)
(* possibly other penultimate nasal lopa ? *)
| [ c :: rest ] -> if vowel c then ([ short c :: rest ],True)
else (rstem,False)
......@@ -5561,6 +5564,7 @@ value compute_conjugs_stems entry (vmorph,aa) = do (* main *)
| "vyadh" -> compute_perif (revcode "vidh") entry
| "zuu" -> compute_perif (revcode "zve") entry
| "knuu" -> compute_perif (revcode "knuuy") entry
| "stambh" -> compute_perif (revcode "stabh") entry
| _ -> compute_perif rstem entry
]
; (* Precative - active rare, middle unknown in classical language except
......
......@@ -8,4 +8,4 @@
(**************************************************************************)
(* Generated by make version - see main Makefile *)
value version="3.13" and version_date="2019-03-01";
value version="3.13" and version_date="2019-03-10";
VERSION='3.13'
DATE='2019-03-01'
DATE='2019-03-10'
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