balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

solve to bug with location

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-05-19 18:53:20 +02:00
parent e6e1bc5876
commit 85dc95dc7b
2 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/passes/2-concrete_to_imperative/cameligo.ml
View File

@ -218,7 +218,8 @@ let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
let (p,t) = pt.value.pattern,pt.value.type_expr in let (p,t) = pt.value.pattern,pt.value.type_expr in
let%bind p = tuple_pattern_to_vars p in let%bind p = tuple_pattern_to_vars p in
let%bind t = compile_type_expression t in let%bind t = compile_type_expression t in
ok @@ (p,t) let l = Location.lift pt.region in
ok @@ (p,t,l)
| other -> (fail @@ wrong_pattern "parenthetical or type annotation" other) | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other)
and unpar_pattern : Raw.pattern -> Raw.pattern = function and unpar_pattern : Raw.pattern -> Raw.pattern = function
@ -452,7 +453,7 @@ let rec compile_expression :
let f_args = nseq_to_list (binders) in let f_args = nseq_to_list (binders) in
let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args 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 aux acc (_,ty,loc) = Option.map (t_function ~loc ty) acc in
ok @@ (List.fold_right' aux lhs_type' ty) ok @@ (List.fold_right' aux lhs_type' ty)
| _ -> ok None | _ -> ok None
) )
@ -928,7 +929,7 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
} in } in
let f_args = nseq_to_list (param1,others) 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%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 aux acc (_,ty,loc) = Option.map (t_function ~loc ty) acc in
ok (Raw.EFun {region; value=fun_},List.fold_right' aux lhs_type' ty) ok (Raw.EFun {region; value=fun_},List.fold_right' aux lhs_type' ty)
in in
let%bind rhs' = compile_expression let_rhs in let%bind rhs' = compile_expression let_rhs in
@ -938,7 +939,7 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
let f_args = nseq_to_list (binders) in let f_args = nseq_to_list (binders) in
let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in let%bind lhs_type' = bind_map_option (fun x -> compile_type_expression (snd x)) lhs_type in
let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args 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 aux acc (_,ty,loc) = Option.map (t_function ~loc ty) acc in
ok @@ (List.fold_right' aux lhs_type' ty) ok @@ (List.fold_right' aux lhs_type' ty)
| _ -> ok None | _ -> ok None
) )

14
src/passes/4-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -253,7 +253,7 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
let%bind element = compile_expression element in let%bind element = compile_expression element in
return @@ O.e_constructor ~loc constructor element return @@ O.e_constructor ~loc constructor element
| I.E_matching m -> | I.E_matching m ->
let%bind m = compile_matching m in let%bind m = compile_matching m loc in
ok @@ m ok @@ m
| I.E_record record -> | I.E_record record ->
let record = I.LMap.to_kv_list record in let record = I.LMap.to_kv_list record in
@ -385,8 +385,8 @@ and compile_lambda : I.lambda -> O.lambda result =
let%bind result = compile_expression result in let%bind result = compile_expression result in
ok @@ O.{binder;input_type;output_type;result} ok @@ O.{binder;input_type;output_type;result}
and compile_matching : I.matching -> (O.expression option -> O.expression) result = and compile_matching : I.matching -> Location.t -> (O.expression option -> O.expression) result =
fun {matchee;cases} -> fun {matchee;cases} loc ->
let return expr = ok @@ function let return expr = ok @@ function
| None -> expr | None -> expr
| Some e -> O.e_sequence expr e | Some e -> O.e_sequence expr e
@ -412,7 +412,7 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
in in
ok @@ restore_mutable_variable return_expr free_vars env ok @@ restore_mutable_variable return_expr free_vars env
else else
return @@ O.e_matching matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr',tv)} return @@ O.e_matching ~loc matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}
| I.Match_list {match_nil;match_cons} -> | I.Match_list {match_nil;match_cons} ->
let%bind match_nil' = compile_expression match_nil in let%bind match_nil' = compile_expression match_nil in
let (hd,tl,expr,tv) = match_cons in let (hd,tl,expr,tv) = match_cons in
@ -432,10 +432,10 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
in in
ok @@ restore_mutable_variable return_expr free_vars env ok @@ restore_mutable_variable return_expr free_vars env
else else
return @@ O.e_matching matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)} return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}
| I.Match_tuple ((lst,expr), tv) -> | I.Match_tuple ((lst,expr), tv) ->
let%bind expr = compile_expression expr in let%bind expr = compile_expression expr in
return @@ O.e_matching matchee @@ O.Match_tuple ((lst,expr), tv) return @@ O.e_matching ~loc matchee @@ O.Match_tuple ((lst,expr), tv)
| I.Match_variant (lst,tv) -> | I.Match_variant (lst,tv) ->
let env = Var.fresh () in let env = Var.fresh () in
let aux fv ((c,n),expr) = let aux fv ((c,n),expr) =
@ -448,7 +448,7 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
let free_vars = List.sort_uniq Var.compare @@ List.concat fv in let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
if (List.length free_vars == 0) then ( if (List.length free_vars == 0) then (
let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
return @@ O.e_matching matchee @@ O.Match_variant (cases,tv) return @@ O.e_matching ~loc matchee @@ O.Match_variant (cases,tv)
) else ( ) else (
let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in