Skip to content

Commit

Permalink
Refactor Load_rules
Browse files Browse the repository at this point in the history
  • Loading branch information
snowleopard committed Nov 15, 2023
1 parent 6e1b343 commit 04e2ebc
Show file tree
Hide file tree
Showing 3 changed files with 42 additions and 30 deletions.
30 changes: 30 additions & 0 deletions src/dune_engine/fs_memo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -302,6 +302,36 @@ let file_digest ?(force_update = false) path =
Fs_cache.read Fs_cache.Untracked.file_digest path
;;

let file_digest_exn ?loc path =
let report_user_error details =
let+ loc =
match loc with
| None -> Memo.return None
| Some loc -> loc ()
in
User_error.raise
?loc
([ Pp.textf
"File unavailable: %s"
(Path.Outside_build_dir.to_string_maybe_quoted path)
]
@ details)
in
file_digest path
>>= function
| Ok digest -> Memo.return digest
| Error No_such_file -> report_user_error []
| Error Broken_symlink -> report_user_error [ Pp.text "Broken symbolic link" ]
| Error Cyclic_symlink -> report_user_error [ Pp.text "Cyclic symbolic link" ]
| Error (Unexpected_kind st_kind) ->
report_user_error
[ Pp.textf "This is not a regular file (%s)" (File_kind.to_string st_kind) ]
| Error (Unix_error unix_error) ->
report_user_error [ Unix_error.Detailed.pp ~prefix:"Reason: " unix_error ]
| Error (Unrecognized exn) ->
report_user_error [ Pp.textf "%s" (Printexc.to_string exn) ]
;;

let dir_contents ?(force_update = false) path =
if force_update then Fs_cache.evict Fs_cache.Untracked.dir_contents path;
let+ () = Watcher.watch ~try_to_watch_via_parent:false path in
Expand Down
6 changes: 6 additions & 0 deletions src/dune_engine/fs_memo.mli
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,12 @@ val file_digest
-> Path.Outside_build_dir.t
-> Cached_digest.Digest_result.t Memo.t

(** Like [file_digest] but raises a user error if the resulting digest is not [Ok _]. *)
val file_digest_exn
: ?loc:(unit -> Loc.t option Memo.t)
-> Path.Outside_build_dir.t
-> Digest.t Memo.t

(** Like [Io.Untracked.with_lexbuf_from_file] but declares a dependency on the
path. *)
val with_lexbuf_from_file
Expand Down
36 changes: 6 additions & 30 deletions src/dune_engine/load_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -269,39 +269,15 @@ let no_rule_found ~loc fn =
[ "fn", Path.Build.to_dyn fn ]
;;

let source_or_external_file_digest path =
let report_user_error details =
let+ loc = Current_rule_loc.get () in
User_error.raise
?loc
([ Pp.textf
"File unavailable: %s"
(Path.Outside_build_dir.to_string_maybe_quoted path)
]
@ details)
in
Fs_memo.file_digest path
>>= function
| Ok digest -> Memo.return digest
| Error No_such_file -> report_user_error []
| Error Broken_symlink -> report_user_error [ Pp.text "Broken symbolic link" ]
| Error Cyclic_symlink -> report_user_error [ Pp.text "Cyclic symbolic link" ]
| Error (Unexpected_kind st_kind) ->
report_user_error
[ Pp.textf "This is not a regular file (%s)" (File_kind.to_string st_kind) ]
| Error (Unix_error unix_error) ->
report_user_error [ Unix_error.Detailed.pp ~prefix:"Reason: " unix_error ]
| Error (Unrecognized exn) ->
report_user_error [ Pp.textf "%s" (Printexc.to_string exn) ]
;;

let eval_source_file : type a. a Action_builder.eval_mode -> Path.Source.t -> a Memo.t =
fun mode path ->
match mode with
| Lazy -> Memo.return ()
| Eager ->
let+ d = source_or_external_file_digest (In_source_dir path) in
Dep.Fact.file (Path.source path) d
let+ digest =
Fs_memo.file_digest_exn ~loc:Current_rule_loc.get path_outside_build_dir
in
Dep.Facts.singleton dep (Dep.Fact.file path digest)
;;

module rec Load_rules : sig
Expand Down Expand Up @@ -988,8 +964,8 @@ type rule_or_source =
let get_rule_or_source path =
match Path.destruct_build_dir path with
| `Outside path ->
let+ d = source_or_external_file_digest path in
Source d
let+ digest = Fs_memo.file_digest_exn ~loc:Current_rule_loc.get path in
Source digest
| `Inside path ->
get_rule_internal path
>>= (function
Expand Down

0 comments on commit 04e2ebc

Please sign in to comment.