matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Simplify pattern matching with monads 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-07-10 01:07:32 +07:00
parent eb68a9067d
commit 77800e669e
1 changed files with 19 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
src/super_context.ml
View File

@ -97,21 +97,17 @@ let expand_ocaml_config t pform =
let (expand_vars_string, expand_vars_path) = let (expand_vars_string, expand_vars_path) =
let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s = let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s =
String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version -> String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version ->
match (match Pform.Map.expand bindings ~syntax_version ~pform with
match Pform.Map.expand bindings ~syntax_version ~pform with | None -> Pform.Map.expand t.pforms ~syntax_version ~pform
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform | Some _ as x -> x)
| Some _ as x -> x |> Option.map ~f:(function
with | Pform.Values l -> l
| None -> None | Ocaml_config -> expand_ocaml_config t pform
| Some x -> | Project_root -> [Value.Dir (Scope.root scope)]
match x with
| Values l -> Some l
| Ocaml_config -> Some (expand_ocaml_config t pform)
| Project_root -> Some [Value.Dir (Scope.root scope)]
| _ -> | _ ->
Loc.fail (String_with_vars.Var.loc pform) Loc.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position" "%s isn't allowed in this position"
(String_with_vars.Var.describe pform)) (String_with_vars.Var.describe pform)))
in in
let expand_vars t ~scope ~dir ?bindings s = let expand_vars t ~scope ~dir ?bindings s =
expand t ~scope ~dir ?bindings s expand t ~scope ~dir ?bindings s
@ -624,13 +620,11 @@ module Action = struct
let key = String_with_vars.Var.full_name pform in let key = String_with_vars.Var.full_name pform in
let s = Option.value (String_with_vars.Var.payload pform) ~default:"" in let s = Option.value (String_with_vars.Var.payload pform) ~default:"" in
let res = let res =
match Pform.Map.expand bindings ~syntax_version ~pform with Pform.Map.expand bindings ~syntax_version ~pform
| None -> None |> Option.bind ~f:(function
| Some x -> | Pform.Values l -> Some l
match x with | Ocaml_config -> Some (expand_ocaml_config sctx pform)
| Values l -> Some l | Project_root -> Some [Value.Dir (Scope.root scope)]
| Ocaml_config -> Some (expand_ocaml_config sctx pform)
| Project_root -> Some [Value.Dir (Scope.root scope)]
| First_dep | Deps | Named_local -> None | First_dep | Deps | Named_local -> None
| Targets -> | Targets ->
begin match targets_written_by_user with begin match targets_written_by_user with
@ -731,7 +725,7 @@ module Action = struct
in in
add_ddep acc ~key data add_ddep acc ~key data
end end
| Path_no_dep -> Some [Value.Dir (Path.relative dir s)] | Path_no_dep -> Some [Value.Dir (Path.relative dir s)])
in in
Option.iter res ~f:(fun v -> Option.iter res ~f:(fun v ->
acc.sdeps <- Path.Set.union acc.sdeps <- Path.Set.union
@ -751,12 +745,7 @@ module Action = struct
match String.Map.find dynamic_expansions key with match String.Map.find dynamic_expansions key with
| Some _ as opt -> opt | Some _ as opt -> opt
| None -> | None ->
match Option.map (Pform.Map.expand bindings ~syntax_version ~pform) ~f:(function
Pform.Map.expand bindings ~syntax_version ~pform
with
| None -> None
| Some x ->
match x with
| Named_local -> | Named_local ->
begin match Jbuild.Bindings.find deps_written_by_user key with begin match Jbuild.Bindings.find deps_written_by_user key with
| None -> | None ->
@ -765,13 +754,12 @@ module Action = struct
; "deps_written_by_user", ; "deps_written_by_user",
Jbuild.Bindings.sexp_of_t Path.sexp_of_t deps_written_by_user Jbuild.Bindings.sexp_of_t Path.sexp_of_t deps_written_by_user
] ]
| Some x -> Some (Value.L.paths x) | Some x -> Value.L.paths x
end end
| Deps -> | Deps ->
deps_written_by_user deps_written_by_user
|> Jbuild.Bindings.to_list |> Jbuild.Bindings.to_list
|> Value.L.paths |> Value.L.paths
|> Option.some
| First_dep -> | First_dep ->
begin match deps_written_by_user with begin match deps_written_by_user with
| Named _ :: _ -> | Named _ :: _ ->
@ -779,15 +767,15 @@ module Action = struct
files and named dependencies are not available in files and named dependencies are not available in
jbuild files *) jbuild files *)
assert false assert false
| Unnamed v :: _ -> Some [Path v] | Unnamed v :: _ -> [Path v]
| [] -> | [] ->
Loc.warn loc "Variable '%s' used with no explicit \ Loc.warn loc "Variable '%s' used with no explicit \
dependencies@." key; dependencies@." key;
Some [Value.String ""] [Value.String ""]
end end
| _ -> | _ ->
Exn.code_error "Unexpected variable in step2" Exn.code_error "Unexpected variable in step2"
["var", String_with_vars.Var.sexp_of_t pform]) ["var", String_with_vars.Var.sexp_of_t pform]))
let run sctx ~loc ~bindings t ~dir ~dep_kind let run sctx ~loc ~bindings t ~dir ~dep_kind
~targets:targets_written_by_user ~scope ~targets:targets_written_by_user ~scope