modify 'Config' for allowing text mode

src/backend/loadFont.ml

@@ -1,4 +1,4 @@
-open Config
+
 open MyUtil
 
 type file_path = string
@@ -95,10 +95,7 @@ let read_assoc (srcpath : file_path) assoc =
 
 
 let main (filename : file_path) =
-(*
-  Format.printf "LoadFont> main %s\n" filename;  (* for debug *)
-*)
-  let srcpath = resolve_dist_path (Filename.concat "dist/hash" filename) in
+  let srcpath = Config.resolve_dist_file (Filename.concat "dist/hash" filename) in
     try
       let json = Yojson.Safe.from_file srcpath in
           (* -- may raise 'Sys_error', or 'Yojson.Json_error' -- *)

src/backend/loadHyph.ml

@@ -1,7 +1,6 @@
 
 open MyUtil
 open CharBasis
-open Config
 
 
 type dir_path = string
@@ -160,7 +159,7 @@ let read_assoc (srcpath : file_path) (assoc : (string * Yojson.Safe.json) list)
 
 
 let main (filename : file_path) : t =
-  let srcpath = resolve_dist_path (Filename.concat "dist/hyph" filename) in
+  let srcpath = Config.resolve_dist_file (Filename.concat "dist/hyph" filename) in
     try
       let json = Yojson.Safe.from_file srcpath in
           (* -- may raise 'Sys_error', or 'Yojson.Json_error' -- *)

src/backend/setDefaultFont.ml

@@ -1,7 +1,6 @@
 
 open MyUtil
 open CharBasis
-open Config
 
 type dir_path    = string
 type file_path   = string
@@ -84,7 +83,7 @@ let read_assoc srcpath assoc =
 
 
 let main () : (font_abbrev * float * float) ScriptSchemeMap.t =
-  let srcpath = resolve_dist_path "dist/hash/default-font.satysfi-hash" in
+  let srcpath = Config.resolve_dist_file "dist/hash/default-font.satysfi-hash" in
     try
       let json = Yojson.Safe.from_file srcpath in
           (* -- may raise 'Sys_error', or 'Yojson.Json_error' -- *)

src/config.ml

@@ -9,14 +9,32 @@ let initialize root_dirs =
   satysfi_root_dirs := root_dirs
 
 
-let resolve_dist_path filename =
-  let dirlst = !satysfi_root_dirs in
-  let rec go = function
-    | [] ->
-        raise (DistFileNotFound(filename, dirlst))
-
-    | d :: ds ->
-        let fn = Filename.concat d filename in
-          if Sys.file_exists fn then fn else go ds
+let resolve fn =
+  if Sys.file_exists fn then Some(fn) else None
+
+
+let resolve_dist_file filename =
+  let dirs = !satysfi_root_dirs in
+  let pathcands =
+    dirs |> List.map (fun dir -> Filename.concat dir filename)
+  in
+    match MyUtil.first_some resolve pathcands with
+    | None     -> raise (DistFileNotFound(filename, pathcands))
+    | Some(fn) -> fn
+
+
+let resolve_dist_package package extcands =
+  let withexts =
+    extcands |> List.map (fun extcand -> package ^ extcand)
+  in
+  let dirs = !satysfi_root_dirs in
+  let pathcands =
+    dirs |> List.map (fun dir ->
+      withexts |> List.map (fun withext ->
+        Filename.concat dir withext
+      )
+    ) |> List.concat
   in
-    go dirlst
+    match MyUtil.first_some resolve pathcands with
+    | None     -> raise (DistFileNotFound(package, pathcands))
+    | Some(fn) -> fn

src/config.mli

@@ -3,4 +3,6 @@ exception DistFileNotFound of string * string list
 
 val initialize : string list -> unit
 
-val resolve_dist_path : string -> string
+val resolve_dist_file : string -> string
+
+val resolve_dist_package : string -> string list -> string

src/frontend/fontInfo.ml

@@ -5,7 +5,6 @@ open LengthInterface
 open HorzBox
 open CharBasis
 open Types
-open Config
 
 
 exception InvalidFontAbbrev     of font_abbrev
@@ -84,7 +83,7 @@ module FontAbbrevHashTable
         match !storeref with
         | UnusedSingle(srcpath) ->
           (* -- if this is the first access to the single font -- *)
-            let srcpath = resolve_dist_path (Filename.concat "dist/fonts" srcpath) in
+            let srcpath = Config.resolve_dist_file (Filename.concat "dist/fonts" srcpath) in
             begin
               match FontFormat.get_decoder_single (abbrev ^ "-Composite") (* temporary *) srcpath with
               | None ->
@@ -101,7 +100,7 @@ module FontAbbrevHashTable
 
         | UnusedTTC(srcpath, i) ->
           (* -- if this is the first access to the TrueTypeCollection -- *)
-            let srcpath = resolve_dist_path (Filename.concat "dist/fonts" srcpath) in
+            let srcpath = Config.resolve_dist_file (Filename.concat "dist/fonts" srcpath) in
             begin
               match FontFormat.get_decoder_ttc (abbrev ^ "-Composite") (* temporary *) srcpath i with
               | None ->
@@ -263,7 +262,7 @@ module MathFontAbbrevHashTable
         match !storeref with
         | UnusedMath(srcpath) ->
           (* -- if this is the first access to the math font -- *)
-            let srcpath = resolve_dist_path (Filename.concat "dist/fonts" srcpath) in
+            let srcpath = Config.resolve_dist_file (Filename.concat "dist/fonts" srcpath) in
             begin
               match FontFormat.get_math_decoder (mfabbrev ^ "-Composite-Math") (* temporary *) srcpath with
               | None ->
@@ -432,10 +431,10 @@ let get_font_dictionary (pdf : Pdf.t) : Pdf.pdfobject =
 let initialize () =
   FontAbbrevHashTable.initialize ();
   MathFontAbbrevHashTable.initialize ();
-  let filename_S   = resolve_dist_path "dist/unidata/Scripts.txt" in
-  let filename_EAW = resolve_dist_path "dist/unidata/EastAsianWidth.txt" in
+  let filename_S   = Config.resolve_dist_file "dist/unidata/Scripts.txt" in
+  let filename_EAW = Config.resolve_dist_file "dist/unidata/EastAsianWidth.txt" in
   ScriptDataMap.set_from_file filename_S filename_EAW;
-  LineBreakDataMap.set_from_file (resolve_dist_path "dist/unidata/LineBreak.txt");
+  LineBreakDataMap.set_from_file (Config.resolve_dist_file "dist/unidata/LineBreak.txt");
   let font_hash = LoadFont.main "fonts.satysfi-hash" in
   font_hash |> List.iter (fun (abbrev, data) ->
     match data with

src/frontend/main.ml

@@ -99,8 +99,13 @@ type file_info =
 
 
 let make_absolute_path curdir headerelem =
+  let extcands =
+    match OptionState.get_mode () with
+    | None      -> [".satyh"; ".satyg"]
+    | Some(lst) -> List.append (lst |> List.map (fun s -> ".satyh-" ^ s)) [".satyg"]
+  in
   match headerelem with
-  | HeaderRequire(s) -> Config.resolve_dist_path (Filename.concat "dist/packages" s ^ ".satyh")
+  | HeaderRequire(s) -> Config.resolve_dist_package (Filename.concat "dist/packages" s) extcands
   | HeaderImport(s)  -> Filename.concat curdir (s ^ ".satyh")
 
 
@@ -338,12 +343,12 @@ let error_log_environment suspended =
         (cycle |> List.map (fun s -> DisplayLine(s)))
       )
 
-  | Config.DistFileNotFound(file_name, dirlst) ->
+  | Config.DistFileNotFound(file_name, pathcands) ->
       report_error Interface (List.append [
         NormalLine("package file not found:");
         DisplayLine(file_name);
-        NormalLine("candidate directories for the SATySFi library root:");
-      ] (dirlst |> List.map (fun dir -> DisplayLine(dir))))
+        NormalLine("candidate paths:");
+      ] (pathcands |> List.map (fun pathcand -> DisplayLine(pathcand))))
 
   | NotALibraryFile(file_name_in, tyenv, ty) ->
       report_error Typechecker [

src/myUtil.ml

@@ -101,3 +101,19 @@ let ( @|> ) = ( |> )
       right-associative version;
       `y @|> x @|> f ` is equivalent to `f x y`
      ---- *)
+
+
+let first_some f lst =
+  let rec aux = function
+    | [] ->
+        None
+
+    | x :: xs ->
+        let opt = f x in
+        begin
+          match opt with
+          | Some(_) -> opt
+          | None    -> aux xs
+        end
+  in
+    aux lst

src/myUtil.mli

@@ -34,3 +34,5 @@ end
 val ( += ) : int ref -> int -> unit
 
 val ( @|> ) : 'a -> ('a -> 'b) -> 'b
+
+val first_some : ('a -> 'b option) -> 'a list -> 'b option