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

fix free_variables bug

Browse Source
This commit is contained in:
Galfour 2019-04-17 22:02:11 +00:00
parent d97f546b45
commit c74e2846df
2 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/ligo/ast_typed.ml
View File

@ -267,10 +267,15 @@ module Free_variables = struct
match e with match e with
| E_lambda l -> | E_lambda l ->
let b' = union (singleton l.binder) b in let b' = union (singleton l.binder) b in
union (annotated_expression b' l.result) (block b' l.body) let (b'', frees) = block' b' l.body in
union (annotated_expression b'' l.result) frees
| E_literal _ -> empty | E_literal _ -> empty
| E_constant (_ , lst) -> unions @@ List.map self lst | E_constant (_ , lst) -> unions @@ List.map self lst
| E_variable name -> if mem name b then empty else singleton name | E_variable name -> (
match mem name b with
| true -> empty
| false -> singleton name
)
| E_application (a, b) -> unions @@ List.map self [ a ; b ] | E_application (a, b) -> unions @@ List.map self [ a ; b ]
| E_tuple lst -> unions @@ List.map self lst | E_tuple lst -> unions @@ List.map self lst
| E_constructor (_ , a) -> self a | E_constructor (_ , a) -> self a
@ -295,11 +300,14 @@ module Free_variables = struct
| I_patch (_ , _ , a) -> b , annotated_expression b a | I_patch (_ , _ , a) -> b , annotated_expression b a
| I_matching (a , cs) -> b , union (annotated_expression b a) (matching_block b cs) | I_matching (a , cs) -> b , union (annotated_expression b a) (matching_block b cs)
and block : bindings -> block -> bindings = fun b bl -> and block' : bindings -> block -> (bindings * bindings) = fun b bl ->
let aux = fun (binds, frees) cur -> let aux = fun (binds, frees) cur ->
let (binds', frees') = instruction' binds cur in let (binds', frees') = instruction' binds cur in
(binds', union frees frees') in (binds', union frees frees') in
let (_, frees) = List.fold_left aux (b , []) bl in List.fold_left aux (b , []) bl
and block : bindings -> block -> bindings = fun b bl ->
let (_ , frees) = block' b bl in
frees frees
and matching : type a . (bindings -> a -> bindings) -> bindings -> a matching -> bindings = fun f b m -> and matching : type a . (bindings -> a -> bindings) -> bindings -> a matching -> bindings = fun f b m ->

5
src/ligo/transpiler.ml
View File

@ -343,9 +343,10 @@ and translate_lambda env l tv =
let%bind empty_env = let%bind empty_env =
let%bind input = translate_type input_type in let%bind input = translate_type input_type in
ok Environment.(add (binder, input) empty) in ok Environment.(add (binder, input) empty) in
let (body_fvs, result_fvs) = AST.Free_variables.( let ((_body_bounds , body_fvs) , result_fvs) = AST.Free_variables.(
let bindings = singleton binder in let bindings = singleton binder in
block bindings body , annotated_expression bindings result let ((body_bounds , _) as b) = block' bindings body in
b , annotated_expression body_bounds result
) in ) in
match (body_fvs, result_fvs) with match (body_fvs, result_fvs) with
| [] , [] -> ( | [] , [] -> (