remove append_to_abs_directory and make_abs_path

src-saphe/constant.ml

@@ -22,7 +22,7 @@ let lock_tarball_name (package_name : package_name) (locked_version : SemanticVe
 let registered_lock_directory ~store_root:(absdir_store_root : abs_path) (reglock : RegisteredLock.t) : abs_path =
   let RegisteredLock.{ registered_package_id; locked_version } = reglock in
   let RegisteredPackageId.{ registry_hash_value; package_name } = registered_package_id in
-  append_to_abs_directory absdir_store_root
+  AbsPath.append_to_directory absdir_store_root
     (Printf.sprintf "packages/%s/%s/%s"
       registry_hash_value
       package_name
@@ -37,77 +37,74 @@ let lock_directory ~(store_root : abs_path) (lock : Lock.t) : abs_path =
 
 (* Must be in sync with SATySFi *)
 let envelope_config_path ~dir:(absdir_library : abs_path) : abs_path =
-  append_to_abs_directory absdir_library "satysfi-envelope.yaml"
+  AbsPath.append_to_directory absdir_library "satysfi-envelope.yaml"
 
 
 let registered_lock_envelope_config ~(store_root : abs_path) (reglock : RegisteredLock.t) : abs_path =
   envelope_config_path ~dir:(registered_lock_directory ~store_root reglock)
 
 
 let registry_root_directory_path ~store_root:(absdir_store_root : abs_path) (registry_hash_value : registry_hash_value) : abs_path =
-  append_to_abs_directory absdir_store_root (Printf.sprintf "registries/%s" registry_hash_value)
+  AbsPath.append_to_directory absdir_store_root (Printf.sprintf "registries/%s" registry_hash_value)
 
 
 let lock_tarball_cache_directory ~store_root:(absdir_store_root : abs_path) (registry_hash_value : registry_hash_value) : abs_path =
-  append_to_abs_directory absdir_store_root (Printf.sprintf "cache/locks/%s" registry_hash_value)
+  AbsPath.append_to_directory absdir_store_root (Printf.sprintf "cache/locks/%s" registry_hash_value)
 
 
 let external_resource_cache_directory ~store_root:(absdir_store_root : abs_path) (registry_hash_value : registry_hash_value) : abs_path =
-  append_to_abs_directory absdir_store_root (Printf.sprintf "cache/external_resources/%s" registry_hash_value)
+  AbsPath.append_to_directory absdir_store_root (Printf.sprintf "cache/external_resources/%s" registry_hash_value)
 
 
 let store_root_config_path ~store_root:(absdir_store_root : abs_path) : abs_path =
-  append_to_abs_directory absdir_store_root "saphe-store-root.yaml"
+  AbsPath.append_to_directory absdir_store_root "saphe-store-root.yaml"
 
 
 let package_registry_config_path ~registry_dir:(absdir_registry_repo : abs_path) : abs_path =
-  append_to_abs_directory absdir_registry_repo "saphe-registry.yaml"
+  AbsPath.append_to_directory absdir_registry_repo "saphe-registry.yaml"
 
 
 let registry_repo_package_store ~registry_repo_root:(absdir_registry_repo : abs_path) : abs_path =
-  append_to_abs_directory absdir_registry_repo "packages"
+  AbsPath.append_to_directory absdir_registry_repo "packages"
 
 
 let release_config_extension =
   ".saphe-release.yaml"
 
 
 let library_package_config_path ~dir:(absdir_library : abs_path) : abs_path =
-  append_to_abs_directory absdir_library "saphe.yaml"
+  AbsPath.append_to_directory absdir_library "saphe.yaml"
 
 
 let document_package_config_path ~doc:(abspath_doc : abs_path) : abs_path =
-  let path_without_extension = Filename.remove_extension (get_abs_path_string abspath_doc) in
-  make_abs_path (Printf.sprintf "%s.saphe.yaml" path_without_extension)
+  AbsPath.replace_extension ~extension_without_dot:"saphe.yaml" abspath_doc
 
 
 let library_lock_config_path ~dir:(absdir_library : abs_path) : abs_path =
-  append_to_abs_directory absdir_library "saphe.lock.yaml"
+  AbsPath.append_to_directory absdir_library "saphe.lock.yaml"
 
 
 let library_deps_config_path ~dir:(absdir_library : abs_path) : abs_path =
-  append_to_abs_directory absdir_library "satysfi-deps.yaml"
+  AbsPath.append_to_directory absdir_library "satysfi-deps.yaml"
 
 
 let document_lock_config_path ~doc:(abspath_doc : abs_path) : abs_path =
-  let path_without_extension = Filename.remove_extension (get_abs_path_string abspath_doc) in
-  make_abs_path (Printf.sprintf "%s.saphe.lock.yaml" path_without_extension)
+  AbsPath.replace_extension ~extension_without_dot:"saphe.lock.yaml" abspath_doc
 
 
 let default_output_path ~doc:(abspath_doc : abs_path) : abs_path =
-  let path_without_extension = Filename.remove_extension (get_abs_path_string abspath_doc) in
-  make_abs_path (Printf.sprintf "%s.pdf" path_without_extension)
+  AbsPath.replace_extension ~extension_without_dot:"pdf" abspath_doc
 
 
-let document_deps_config_path ~dir:(absdir_doc_root : abs_path) ~(doc_basename : string) : abs_path =
+let document_deps_config_path ~dir:(absdir_intermediate : abs_path) ~(doc_basename : string) : abs_path =
   let doc_basename_without_extension = Filename.remove_extension doc_basename in
-  append_to_abs_directory absdir_doc_root
+  AbsPath.append_to_directory absdir_intermediate
     (Printf.sprintf "%s.satysfi-deps.yaml" doc_basename_without_extension)
 
 
-let dump_path ~dir:(absdir_doc_root : abs_path) ~(doc_basename : string) : abs_path =
+let dump_path ~dir:(absdir_intermediate : abs_path) ~(doc_basename : string) : abs_path =
   let doc_basename_without_extension = Filename.remove_extension doc_basename in
-  append_to_abs_directory absdir_doc_root
+  AbsPath.append_to_directory absdir_intermediate
     (Printf.sprintf "%s.satysfi-aux.yaml" doc_basename_without_extension)
 
 

src-saphe/lockConfig.ml

@@ -40,7 +40,7 @@ let lock_contents_decoder ~dir:(absdir_lock_config : abs_path) : Lock.t ConfigDe
     "local" ==> begin
       get "relative_path" relative_path_decoder >>= fun relpathstr ->
       succeed @@ Lock.LocalFixed{
-        absolute_path = append_to_abs_directory absdir_lock_config relpathstr;
+        absolute_path = AbsPath.append_to_directory absdir_lock_config relpathstr;
       }
     end;
   ]

src-saphe/lockFetcher.ml

@@ -78,7 +78,7 @@ let fetch_registered_lock ~(wget_command : string) ~(tar_command : string) ~stor
     | TarGzip{ url; checksum } ->
         (* Synchronously fetches a tarball (if non-existent): *)
         let abspath_tarball =
-          append_to_abs_directory absdir_lock_tarball_cache
+          AbsPath.append_to_directory absdir_lock_tarball_cache
             (Printf.sprintf "%s.tar.gz" lock_tarball_name)
         in
         let* () =
@@ -153,8 +153,8 @@ let extract_external_zip_and_arrange_files_if_necessary ~(unzip_command : string
   let pairs =
     extractions |> List.map (fun extraction ->
       let { extracted_from; extracted_to } = extraction in
-      let abspath_from = append_to_abs_directory absdir_extraction extracted_from in
-      let abspath_to = append_to_abs_directory absdir_lock extracted_to in
+      let abspath_from = AbsPath.append_to_directory absdir_extraction extracted_from in
+      let abspath_to = AbsPath.append_to_directory absdir_lock extracted_to in
       { abspath_from; abspath_to }
     )
   in
@@ -201,14 +201,14 @@ let fetch_external_resources ~(wget_command : string) ~(unzip_command : string)
       match external_resource with
       | ExternalZip{ url; checksum; extractions } ->
           let absdir_external =
-            append_to_abs_directory
+            AbsPath.append_to_directory
               (Constant.external_resource_cache_directory ~store_root:absdir_store_root registry_hash_value)
               lock_tarball_name
           in
 
           (* Fetches the external zip file if nonexistent: *)
           let abspath_zip =
-            append_to_abs_directory absdir_external (Printf.sprintf "archives/%s.zip" name)
+            AbsPath.append_to_directory absdir_external (Printf.sprintf "archives/%s.zip" name)
           in
           let* () =
             fetch_external_zip_if_nonexistent
@@ -220,7 +220,7 @@ let fetch_external_resources ~(wget_command : string) ~(unzip_command : string)
 
           (* Extracts the external zip file if some of the resulting files are nonexistent: *)
           let absdir_extraction =
-            append_to_abs_directory absdir_external (Printf.sprintf "extractions/%s" name)
+            AbsPath.append_to_directory absdir_external (Printf.sprintf "extractions/%s" name)
           in
           let* () =
             extract_external_zip_and_arrange_files_if_necessary

src-saphe/packageConfig.ml

@@ -221,7 +221,7 @@ let validate_dependency ~dir:(absdir_config : abs_path) (localmap : registry_rem
 
     | ParsedLocalFixedDependency{ relative_path } ->
         return @@ LocalFixedDependency{
-          absolute_path = append_to_abs_directory absdir_config relative_path;
+          absolute_path = AbsPath.append_to_directory absdir_config relative_path;
         }
   in
   return @@ PackageDependency{ used_as; spec }

src-saphe/packageRegistryReader.ml

@@ -12,7 +12,7 @@ let listup_package_directories (absdir_package_store : abs_path) : ((package_nam
   in
   let* acc =
     filenames |> foldM (fun acc filename ->
-      let abspath = append_to_abs_directory absdir_package_store filename in
+      let abspath = AbsPath.append_to_directory absdir_package_store filename in
       if AbsPathIo.is_directory abspath then
         let absdir = abspath in
         let package_name = filename in (* TODO: check that `filename` is a lowercased identifier *)
@@ -53,7 +53,7 @@ let listup_release_configs (package_name : package_name) (absdir_single_package
                       acc
 
                   | Some(semver) ->
-                      let abspath = append_to_abs_directory absdir_single_package filename in
+                      let abspath = AbsPath.append_to_directory absdir_single_package filename in
                       Alist.extend acc (semver, abspath)
                 end
           end

src-saphe/sapheMain.ml

@@ -145,15 +145,10 @@ let get_minimum_language_version (language_requirement : SemanticVersion.require
 
 let get_store_root () : (abs_path, config_error) result =
   let open ResultMonad in
-  let envvar_home =
-    if String.equal Sys.os_type "Win32" then
-      "userprofile"
-    else
-      "HOME"
-  in
-  match Sys.getenv_opt envvar_home with
-  | None       -> err @@ CannotDetermineStoreRoot { envvar = envvar_home }
-  | Some(home) -> return @@ make_abs_path (Filename.concat home ".saphe")
+  let (opt, env_var_home) = AbsPathIo.get_home_directory () in
+  match opt with
+  | None             -> err @@ CannotDetermineStoreRoot { envvar = env_var_home }
+  | Some(absdir_home) -> return @@ AbsPath.append_to_directory absdir_home ".saphe"
 
 
 type package_init_input =
@@ -233,16 +228,16 @@ let init_library ~(fpath_in : string) =
     let absdir_current = AbsPathIo.getcwd () in
     let absdir_package = make_absolute_if_relative ~origin:absdir_current fpath_in in
     let abspath_package_config = Constant.library_package_config_path ~dir:absdir_package in
-    let abspath_source = append_to_abs_directory absdir_package "src/calc.satyh" in
-    let abspath_test = append_to_abs_directory absdir_package "test/calc-test.satyh" in
+    let abspath_source = AbsPath.append_to_directory absdir_package "src/calc.satyh" in
+    let abspath_test = AbsPath.append_to_directory absdir_package "test/calc-test.satyh" in
 
     let* () = assert_nonexistence abspath_package_config in
     let* () = assert_nonexistence abspath_source in
     let* () = assert_nonexistence abspath_test in
 
     ShellCommand.mkdir_p absdir_package;
-    ShellCommand.mkdir_p (append_to_abs_directory absdir_package "src");
-    ShellCommand.mkdir_p (append_to_abs_directory absdir_package "test");
+    ShellCommand.mkdir_p (AbsPath.append_to_directory absdir_package "src");
+    ShellCommand.mkdir_p (AbsPath.append_to_directory absdir_package "test");
     let* () = write_package_config abspath_package_config ~data:InitData.library_package_config_contents in
     let* () = write_initial_file abspath_source ~data:InitData.library_source_contents in
     let* () = write_initial_file abspath_test ~data:InitData.library_test_contents in
@@ -702,7 +697,7 @@ let build
               ~default:Constant.default_intermediate_directory_name
               intermediate_directory
           in
-          append_to_abs_directory absdir_package intermediate_directory
+          AbsPath.append_to_directory absdir_package intermediate_directory
         in
         let abspath_deps_config = Constant.library_deps_config_path ~dir:absdir_intermediate in
 
@@ -745,7 +740,7 @@ let build
             Option.value ~default:Constant.default_intermediate_directory_name
               intermediate_directory
           in
-          append_to_abs_directory absdir_doc_root intermediate_directory
+          AbsPath.append_to_directory absdir_doc_root intermediate_directory
         in
         let doc_basename = MyUtil.basename abspath_doc in
         let abspath_deps_config =
@@ -836,7 +831,7 @@ let test
               ~default:Constant.default_intermediate_directory_name
               intermediate_directory
           in
-          append_to_abs_directory absdir_package intermediate_directory
+          AbsPath.append_to_directory absdir_package intermediate_directory
         in
         let abspath_deps_config = Constant.library_deps_config_path ~dir:absdir_intermediate in
 
@@ -905,8 +900,8 @@ let cache_list () =
       let res = AbsPathIo.readdir absdir_external_resource_cache in
       continue_if_ok res (fun dirs ->
         dirs |> List.sort String.compare |> List.iter (fun dir ->
-          let abspath = append_to_abs_directory absdir_external_resource_cache dir in
-          let abspath_archives = append_to_abs_directory abspath "archives" in
+          let abspath = AbsPath.append_to_directory absdir_external_resource_cache dir in
+          let abspath_archives = AbsPath.append_to_directory abspath "archives" in
           if AbsPathIo.is_directory abspath then
             if AbsPathIo.is_directory abspath_archives then
               let res = AbsPathIo.readdir abspath_archives in
@@ -938,8 +933,8 @@ let cache_list () =
       let res = AbsPathIo.readdir absdir_external_resource_cache in
       continue_if_ok res (fun dirs ->
         dirs |> List.sort String.compare |> List.iter (fun dir ->
-          let abspath = append_to_abs_directory absdir_external_resource_cache dir in
-          let abspath_extractions = append_to_abs_directory abspath "extractions" in
+          let abspath = AbsPath.append_to_directory absdir_external_resource_cache dir in
+          let abspath_extractions = AbsPath.append_to_directory abspath "extractions" in
           if AbsPathIo.is_directory abspath then
             if AbsPathIo.is_directory abspath_extractions then
               let res = AbsPathIo.readdir abspath_extractions in

src-util/absPath.ml

@@ -157,3 +157,8 @@ let dirname (abspath : t) : t =
 
 let basename (abspath : t) : string =
   Filename.basename (to_string abspath)
+
+
+let replace_extension ~(extension_without_dot : string) (abspath : t) : t =
+  let abspathstr_without_dot_and_extension = Filename.remove_extension (to_string abspath) in
+  of_string_exn (Printf.sprintf "%s.%s" abspathstr_without_dot_and_extension extension_without_dot)

src-util/absPath.mli

@@ -21,3 +21,5 @@ val append_to_directory : t -> string -> t
 val dirname : t -> t
 
 val basename : t -> string
+
+val replace_extension : extension_without_dot:string -> t -> t

src-util/absPathIo.ml

@@ -3,6 +3,17 @@ let getcwd () =
   AbsPath.of_string_exn (Sys.getcwd ())
 
 
+let get_home_directory () =
+  let env_var_home =
+    if String.equal Sys.os_type "Win32" then
+      "userprofile"
+    else
+      "HOME"
+  in
+  let opt = Sys.getenv_opt env_var_home in
+  (Option.map AbsPath.of_string_exn opt, env_var_home)
+
+
 let open_in (abspath : AbsPath.t) (k : in_channel -> 'a) : 'a =
   let inc = Stdlib.open_in (AbsPath.to_string abspath) in
   let ret = k inc in

src-util/absPathIo.mli

@@ -1,6 +1,8 @@
 
 val getcwd : unit -> AbsPath.t
 
+val get_home_directory : unit -> AbsPath.t option * string
+
 val open_in : AbsPath.t -> (in_channel -> 'a) -> 'a
 
 val readdir : AbsPath.t -> (string list, string) result

src-util/myUtil.ml

@@ -38,9 +38,7 @@ type abs_path = AbsPath.t
 
 
 (* TODO: remove the following *)
-let make_abs_path pathstr = AbsPath.of_string_exn pathstr
 let get_abs_path_string = AbsPath.to_string
-let append_to_abs_directory = AbsPath.append_to_directory
 let dirname = AbsPath.dirname
 let basename = AbsPath.basename
 let make_absolute_if_relative = AbsPath.make_absolute_if_relative

src-util/myUtil.mli

@@ -11,10 +11,8 @@ val list_fold_adjacent : ('a -> 'b -> 'b option -> 'b option -> 'a) -> 'a -> 'b
 val ( @|> ) : 'a -> ('a -> 'b) -> 'b
 
 (* TODO: remove the following (due to migration to `AbsPath`): *)
-val make_abs_path : string -> abs_path
 val get_abs_path_string : abs_path -> string
 val make_absolute_if_relative : origin:abs_path -> string -> abs_path
-val append_to_abs_directory : abs_path -> string -> abs_path
 val dirname : abs_path -> abs_path
 val basename : abs_path -> string
 

src/frontend/bytecomp/vm.cppo.ml

@@ -1,6 +1,7 @@
 (* -unused-value-declaration *)
 [@@@ocaml.warning "-32"]
 
+open MyUtil
 open LengthInterface
 open GraphicBase
 open SyntaxBase
@@ -22,6 +23,12 @@ let make_entry (v : syntactic_value) : stack_entry =
 let report_dynamic_error msg =
   raise (ExecError(msg))
 
+
+let validate_as_abs_path (s : string) : abs_path =
+  match AbsPath.of_string s with
+  | None          -> report_dynamic_error (Printf.sprintf "not an absolute path: \"%s\"" s)
+  | Some(abspath) -> abspath
+
 (*
 type compiled_nom_inline_text_element =
   | CompiledNomInlineTextText     of string

src/frontend/envelopeReader.ml

@@ -17,7 +17,7 @@ let listup_sources_in_directory (extensions : string list) (absdir_src : abs_pat
   let abspaths =
     filenames |> List.filter_map (fun filename ->
       if extensions |> List.exists (fun suffix -> Core.String.is_suffix filename ~suffix) then
-        Some(append_to_abs_directory absdir_src filename)
+        Some(AbsPath.append_to_directory absdir_src filename)
       else
         None
     )
@@ -32,13 +32,13 @@ let main (display_config : Logging.config) ~(use_test_files : bool) ~(extensions
   let* envelope =
     match config.envelope_contents with
     | Library{ main_module_name; source_directories; test_directories; _ } ->
-        let absdirs_src = source_directories |> List.map (append_to_abs_directory absdir_envelope) in
+        let absdirs_src = source_directories |> List.map (AbsPath.append_to_directory absdir_envelope) in
         let* abspaths_src =
           absdirs_src |> mapM (listup_sources_in_directory extensions) |> Result.map List.concat
         in
         let* abspaths =
           if use_test_files then
-            let absdirs_test = test_directories |> List.map (append_to_abs_directory absdir_envelope) in
+            let absdirs_test = test_directories |> List.map (AbsPath.append_to_directory absdir_envelope) in
             let* abspaths_test =
               absdirs_test |> mapM (listup_sources_in_directory extensions) |> Result.map List.concat
             in
@@ -71,7 +71,7 @@ let main (display_config : Logging.config) ~(use_test_files : bool) ~(extensions
         let font_files =
           font_file_descriptions |> List.map (fun font_file_description ->
             let { font_file_path; font_file_contents } = font_file_description in
-            let abspath = append_to_abs_directory absdir_envelope font_file_path in
+            let abspath = AbsPath.append_to_directory absdir_envelope font_file_path in
             {
               r_font_file_path     = abspath;
               r_font_file_contents = font_file_contents;