Commit 19555c74 authored by Gérard Huet's avatar Gérard Huet

Cleaning up of code

parent 155c7243
......@@ -99,7 +99,7 @@ value print_tags pvs seg_num phase form tags =
value print_morpho phase word =
match tags_of phase word with
[ Atomic tags -> print_tags [] 0 phase word tags
| Preverbed (_,phase) pvs form tags -> print_tags pvs 0 phase form tags
| Preverbed (_,ph) pvs form tags -> print_tags pvs 0 ph form tags
]
;
(* End of display routines *)
......@@ -165,9 +165,9 @@ value sort_check cpts =
List.sort compare_index cpts
;
value seg_length = fun
[ [ -2 :: rest ] -> Word.length rest (* lopa does not count *)
| w -> Word.length w
]
[ [ -2 :: rest ] -> Word.length rest (* lopa does not count *)
| w -> Word.length w
]
;
value rec merge_rec lpw = fun
[ [] -> lpw
......@@ -200,9 +200,9 @@ value build_visual k segments =
]
;
(* We check whether the current segment [(w,tr,phase,k)] is conflicting with
others at previous offset [n]; if not it is mandatory and marked blue. *)
others at previous offset [n]; if not it is mandatory and marked blue. *)
(* Returns True for blue mandatory segments, False for green/red optional ones *)
(* Warning: very hairy code, do not change without understanding the theory. *)
(* Warning: very hairy code, do not change without thorough understanding . *)
value is_conflicting ((w,tr,ph,k) as segment) =
let l = seg_length w in is_conflicting_rec 0
where rec is_conflicting_rec n = (* n is position in input string *)
......@@ -236,8 +236,8 @@ value is_conflicting ((w,tr,ph,k) as segment) =
possible v for w', in which case it is an overlap returning a blue sign.
If w' has any other possible v's, there is a conflict. *)
(* This may only occur if w=[1] (a) and w' ends in a or aa *)
(* NB. In naabhaava.h caakiirti.h a should be marked blue
but in mahaajana.h after checking mahaa a should not be marked blue *)
(* e.g. In "naabhaava.h caakiirti.h", "a" should be marked blue, and in
"mahaajana.h" after checking "mahaa", "a" should not be marked blue *)
where match_tr' = fun
[ [ v ] -> not (v = w) || does_conflict rest
| _ -> True
......
......@@ -106,10 +106,11 @@ value compound_monosyl_ii = fun
;
(* Similarly for -uu roots *)
value compound_monosyl_uu = fun
[ [ 40 :: _ ] (* -bhuu *) -> True (* abhiibhuu (may be too wide) *)
| [ 48 :: _ ] (* -suu *) -> True (* prasuu (may be too wide) *)
| [ 43 :: [ 40 :: _ ] ] (* -bhruu *) -> True (* subhruu (may be too wide) *)
| _ -> False (* eg m. khalapuu to be completed for other stems *)
[ [ 37 :: _ ] (* -puu *) (* khalapuu DespGram p146 *)
| [ 40 :: _ ] (* -bhuu2 *) (* abhiibhuu manobhuu pratibhuu DespGram p146 *)
| [ 48 :: _ ] (* -suu2 *) (* prasuu *)
| [ 43 :: [ 40 :: _ ] ] (* -bhruu *) -> True (* subhruu *)
| _ -> False
]
;
......@@ -5081,11 +5082,11 @@ value compute_nouns_stem_form e stem d p =
]
| [ 6; 49; 6; 49 ] (* huuhuu *) -> build_huuhuu e
| [ 6 :: r1 ] (* -uu - rare *) ->
if monosyl r1 then build_mono_uu Mas r1 e (* puu2 *)
else build_poly_uu Mas r1 e (* sarvatanuu khalapuu pratibhuu *)
(* vedic polysyllabic in uu are of utmost rarity - Whitney §355 *)
if monosyl r1 || compound_monosyl_uu r1 then build_mono_uu Mas r1 e
else build_poly_uu Mas r1 e (* sarvatanuu *)
(* vedic polysyllabic in uu are of utmost rarity - Whitney §355 *)
| [ 7 :: r1 ] (* -.r *) -> match r1 with
[ [ 27; 47; 12; 43; 17 ] -> build_krostu r1 e (* kro.s.t.r Muller §236 *)
[ [ 27; 47; 12; 43; 17 ] -> build_krostu r1 e (* kro.s.t.r Muller§236 *)
| [ 32 :: r2 ] (* -t.r *) -> match r2 with
[ [ 3; 37 ] (* pit.r *) (* relationships McDonell §101 *)
| [ 2; 41; 2; 24 ] (* jaamaat.r *)
......@@ -6018,6 +6019,7 @@ auxiliary, such as yaa (bhasmasaat) or nii (Whitney) or sampad (gr.) *)
; enter1 "avara" (Indecl Tas (code "avaratas")) (* \Pan{5,3,29} *)
; enter1 "uttara#1" (Indecl Tas (code "uttaratas")) (* on pn \Pan{5,3,7} ? *)
; enter1 "ubhaya" (Indecl Tas (code "ubhayatas")) (* on pn \Pan{5,3,7} ? *)]
; enter1 "puras" (Indecl Tas (code "puratas")) (* on indecl puras *)
*)
value compute_extra_tasils () = do (* add non-generative tasils - ad-hoc *)
{ enter1 "aze.sa" (Indecl Tas (code "aze.satas")) (* tasil on privative cpd *)
......
......@@ -14,7 +14,7 @@ open Web; (* ps pl etc. *)
open Morphology; (* inflected lemma morphology *)
open Phases; (* Phases *)
open Dispatcher; (* Dispatch *)
open SCLpaths; (* [scl_url scl_cgi default_output_font] *)
open SCLpaths; (* [scl_url scl_cgi] interface with UoH parser *)
module Prel = struct
......
......@@ -12,5 +12,5 @@ value scl_url = ""
and scl_cgi = ""
;
value default_output_font = "ROMAN" (* could be "DEV" *)
value default_output_font = "IAST" (* could be "DEV" *)
;
No preview for this file type
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