fix bug with wrong annotation at the beginning

This commit is contained in:
Pierre-Emmanuel Wulfman 2020-03-03 16:17:07 +01:00
parent a19e2ceb3b
commit 4f13a33d46
2 changed files with 10 additions and 12 deletions

View File

@ -812,8 +812,8 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
ok (var , tl)
in
let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in
let let_rhs = match args with
| [] -> let_rhs
let%bind let_rhs,lhs_type = match args with
| [] -> ok (let_rhs, lhs_type')
| param1::others ->
let fun_ = {
kwd_fun = Region.ghost;
@ -822,18 +822,13 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
arrow = Region.ghost;
body = let_rhs
} in
Raw.EFun {region=Region.ghost ; value=fun_}
in
let f_args = (match let_rhs with
| Raw.EFun f -> nseq_to_list f.value.binders
| _ -> []
)
in
let%bind rhs' = simpl_expression let_rhs in
let f_args = nseq_to_list (param1,others) in
let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
let aux acc ty = Option.map (t_function (snd ty)) acc in
let func_type = List.fold_right' aux lhs_type' ty in
ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , func_type , inline, rhs'))]
ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty)
in
let%bind rhs' = simpl_expression let_rhs in
ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
)
and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result =

3
test.mligo Normal file
View File

@ -0,0 +1,3 @@
let f : int = fun (x, y : int*int) -> x + y
let g (x, y : int * int) : int = f (x, y)