monad fix

This commit is contained in:
Lesenechal Remi 2020-01-21 19:04:51 +01:00
parent 786b183d40
commit 8237947c4d
2 changed files with 11 additions and 7 deletions

View File

@ -1344,8 +1344,8 @@ and simpl_declaration_list declarations :
let%bind type_expression = simpl_type_expression type_expr in let%bind type_expression = simpl_type_expression type_expr in
let new_decl = let new_decl =
Declaration_type (Var.of_name name.value, type_expression) in Declaration_type (Var.of_name name.value, type_expression) in
let res = ok @@ Location.wrap ~loc new_decl let res = Location.wrap ~loc new_decl in
in hook (res::acc) declarations hook (bind_list_cons res acc) declarations
| ConstDecl decl :: declarations -> | ConstDecl decl :: declarations ->
let simpl_const_decl = let simpl_const_decl =
fun {name;const_type; init; attributes} -> fun {name;const_type; init; attributes} ->
@ -1362,9 +1362,9 @@ and simpl_declaration_list declarations :
Declaration_constant Declaration_constant
(Var.of_name name.value, type_annotation, inline, expression) (Var.of_name name.value, type_annotation, inline, expression)
in ok new_decl in in ok new_decl in
let res = let%bind res =
bind_map_location simpl_const_decl (Location.lift_region decl) bind_map_location simpl_const_decl (Location.lift_region decl)
in hook (res::acc) declarations in hook (bind_list_cons res acc) declarations
| FunDecl fun_decl :: declarations -> | FunDecl fun_decl :: declarations ->
let decl, loc = r_split fun_decl in let decl, loc = r_split fun_decl in
let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
@ -1376,9 +1376,10 @@ and simpl_declaration_list declarations :
|> List.exists (fun Region.{value; _} -> value = "\"inline\"") in |> List.exists (fun Region.{value; _} -> value = "\"inline\"") in
let new_decl = let new_decl =
Declaration_constant (name, ty_opt, inline, expr) in Declaration_constant (name, ty_opt, inline, expr) in
let res = ok @@ Location.wrap ~loc new_decl let res = Location.wrap ~loc new_decl in
in hook (res::acc) declarations hook (bind_list_cons res acc) declarations
in bind_list @@ hook [] (List.rev declarations) in
hook (ok @@ []) (List.rev declarations)
let simpl_program : Raw.ast -> program result = let simpl_program : Raw.ast -> program result =
fun t -> simpl_declaration_list @@ nseq_to_list t.decl fun t -> simpl_declaration_list @@ nseq_to_list t.decl

View File

@ -701,6 +701,9 @@ let bind_fold_map_pair f acc (a, b) =
let bind_map_triple f (a, b, c) = let bind_map_triple f (a, b, c) =
bind_and3 (f a, f b, f c) bind_and3 (f a, f b, f c)
let bind_list_cons v lst =
lst >>? fun lst ->
ok (v::lst)
(** (**
Wraps a call that might trigger an exception in a result. Wraps a call that might trigger an exception in a result.