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%bind p = tuple_pattern_to_vars p 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)
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%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 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 None
)
@ -928,7 +929,7 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
} 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 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)
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%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 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 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
return @@ O.e_constructor ~loc constructor element
| I.E_matching m ->
let%bind m = compile_matching m in
let%bind m = compile_matching m loc in
ok @@ m
| I.E_record record ->
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
ok @@ O.{binder;input_type;output_type;result}
and compile_matching : I.matching -> (O.expression option -> O.expression) result =
fun {matchee;cases} ->
and compile_matching : I.matching -> Location.t -> (O.expression option -> O.expression) result =
fun {matchee;cases} loc ->
let return expr = ok @@ function
| None -> expr
| Some e -> O.e_sequence expr e
@ -412,7 +412,7 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
in
ok @@ restore_mutable_variable return_expr free_vars env
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} ->
let%bind match_nil' = compile_expression match_nil 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
ok @@ restore_mutable_variable return_expr free_vars env
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) ->
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) ->
let env = Var.fresh () in
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
if (List.length free_vars == 0) then (
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 (
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