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

Turned some of the mathcing_content tuples into records

Browse Source
This commit is contained in:
Suzanne Dupéron 2020-03-23 01:19:32 +01:00
parent 79593e6f3e
commit fcbcea9382
10 changed files with 94 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/passes/10-interpreter/interpreter.ml
View File

@ -338,8 +338,8 @@ and eval : Ast_typed.expression -> env -> value result
| Match_list cases , V_List [] ->
eval cases.match_nil env
| Match_list cases , V_List (head::tail) ->
let (head_var,tail_var,body,_) = cases.match_cons in
let env' = Env.extend (Env.extend env (head_var,head)) (tail_var, V_List tail) in
let {hd;tl;body;tv=_} = cases.match_cons in
let env' = Env.extend (Env.extend env (hd,head)) (tl, V_List tail) in
eval body env'
| Match_variant (case_list , _) , V_Construct (matched_c , proj) ->
let ((_, var) , body) =
@ -355,8 +355,8 @@ and eval : Ast_typed.expression -> env -> value result
| Match_bool cases , V_Ct (C_bool false) ->
eval cases.match_false env
| Match_option cases, V_Construct ("Some" , proj) ->
let (var,body,_) = cases.match_some in
let env' = Env.extend env (var,proj) in
let {opt;body;tv=_} = cases.match_some in
let env' = Env.extend env (opt,proj) in
eval body env'
| Match_option cases, V_Construct ("None" , V_Ct C_unit) ->
eval cases.match_none env

28
src/passes/10-transpiler/transpiler.ml
View File

@ -517,23 +517,23 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
| Match_bool {match_true ; match_false} ->
let%bind (t , f) = bind_map_pair (transpile_annotated_expression) (match_true, match_false) in
return @@ E_if_bool (expr', t, f)
| Match_option { match_none; match_some = (name, s, tv) } ->
| Match_option { match_none; match_some = {opt; body; tv} } ->
let%bind n = transpile_annotated_expression match_none in
let%bind (tv' , s') =
let%bind tv' = transpile_type tv in
let%bind s' = transpile_annotated_expression s in
let%bind s' = transpile_annotated_expression body in
ok (tv' , s')
in
return @@ E_if_none (expr' , n , ((name , tv') , s'))
return @@ E_if_none (expr' , n , ((opt , tv') , s'))
| Match_list {
match_nil ;
match_cons = ((hd_name) , (tl_name), match_cons, ty) ;
match_cons = {hd; tl; body; tv} ;
} -> (
let%bind nil = transpile_annotated_expression match_nil in
let%bind cons =
let%bind ty' = transpile_type ty in
let%bind match_cons' = transpile_annotated_expression match_cons in
ok (((hd_name , ty') , (tl_name , ty')) , match_cons')
let%bind ty' = transpile_type tv in
let%bind match_cons' = transpile_annotated_expression body in
ok (((hd , ty') , (tl , ty')) , match_cons')
in
return @@ E_if_cons (expr' , nil , cons)
)
@ -638,23 +638,23 @@ and transpile_recursive {fun_name; fun_type; lambda} =
Match_bool {match_true; match_false} ->
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type shadowed) (match_true, match_false) in
return @@ E_if_bool (expr, t, f)
| Match_option { match_none; match_some = (name, s, tv) } ->
| Match_option { match_none; match_some = {opt; body; tv} } ->
let%bind n = replace_callback fun_name loop_type shadowed match_none in
let%bind (tv' , s') =
let%bind tv' = transpile_type tv in
let%bind s' = replace_callback fun_name loop_type shadowed s in
let%bind s' = replace_callback fun_name loop_type shadowed body in
ok (tv' , s')
in
return @@ E_if_none (expr , n , ((name , tv') , s'))
return @@ E_if_none (expr , n , ((opt , tv') , s'))
| Match_list {
match_nil ;
match_cons = ((hd_name) , (tl_name), match_cons, ty) ;
match_cons = { hd ; tl ; body ; tv } ;
} -> (
let%bind nil = replace_callback fun_name loop_type shadowed match_nil in
let%bind cons =
let%bind ty' = transpile_type ty in
let%bind match_cons' = replace_callback fun_name loop_type shadowed match_cons in
ok (((hd_name , ty') , (tl_name , ty')) , match_cons')
let%bind ty' = transpile_type tv in
let%bind match_cons' = replace_callback fun_name loop_type shadowed body in
ok (((hd , ty') , (tl , ty')) , match_cons')
in
return @@ E_if_cons (expr , nil , cons)
)

30
src/passes/8-typer-new/typer.ml
View File

@ -477,14 +477,14 @@ and type_match : environment -> Solver.state -> O.type_expression -> I.matching_
let%bind (match_false , state'') = type_expression e state' match_false in
ok (O.Match_bool {match_true ; match_false} , state'')
| Match_option {match_none ; match_some} ->
let%bind t_opt =
let%bind tv =
trace_strong (match_error ~expected:i ~actual:t loc)
@@ get_t_option t in
let%bind (match_none , state') = type_expression e state match_none in
let (n, b, _) = match_some in
let e' = Environment.add_ez_binder n t_opt e in
let%bind (b' , state'') = type_expression e' state' b in
ok (O.Match_option {match_none ; match_some = (n, b', t_opt)} , state'')
let (opt, b, _) = match_some in
let e' = Environment.add_ez_binder opt tv e in
let%bind (body , state'') = type_expression e' state' b in
ok (O.Match_option {match_none ; match_some = { opt; body; tv}} , state'')
| Match_list {match_nil ; match_cons} ->
let%bind t_elt =
trace_strong (match_error ~expected:i ~actual:t loc)
@ -493,8 +493,8 @@ and type_match : environment -> Solver.state -> O.type_expression -> I.matching_
let (hd, tl, b, _) = match_cons in
let e' = Environment.add_ez_binder hd t_elt e in
let e' = Environment.add_ez_binder tl t e' in
let%bind (b' , state'') = type_expression e' state' b in
ok (O.Match_list {match_nil ; match_cons = (hd, tl, b',t)} , state'')
let%bind (body , state'') = type_expression e' state' b in
ok (O.Match_list {match_nil ; match_cons = {hd; tl; body;tv=t}} , state'')
| Match_tuple ((lst, b),_) ->
let%bind t_tuple =
trace_strong (match_error ~expected:i ~actual:t loc)
@ -882,8 +882,8 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
let aux (cur : O.matching_content) =
match cur with
| Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
| Match_list { match_nil ; match_cons = (_ , _ , match_cons, _) } -> [ match_nil ; match_cons ]
| Match_option { match_none ; match_some = (_ , match_some, _) } -> [ match_none ; match_some ]
| Match_list { match_nil ; match_cons = { hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
| Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
| Match_tuple ((_ , match_tuple), _) -> [ match_tuple ]
| Match_variant (lst , _) -> List.map snd lst in
List.map get_type_expression @@ aux m' in
@ -1247,15 +1247,15 @@ and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -
| Match_tuple ((lst, b),_) ->
let%bind b = f b in
ok @@ I.Match_tuple ((lst, b),[])
| Match_option {match_none ; match_some = (v, some,_)} ->
| Match_option {match_none ; match_some = {opt; body;tv=_}} ->
let%bind match_none = f match_none in
let%bind some = f some in
let match_some = v, some, () in
let%bind some = f body in
let match_some = opt, some, () in
ok @@ Match_option {match_none ; match_some}
| Match_list {match_nil ; match_cons = (hd_name, tl_name, cons,_)} ->
| Match_list {match_nil ; match_cons = {hd;tl;body;tv=_}} ->
let%bind match_nil = f match_nil in
let%bind cons = f cons in
let match_cons = hd_name , tl_name , cons, () in
let%bind cons = f body in
let match_cons = hd , tl , cons, () in
ok @@ Match_list {match_nil ; match_cons}
| Match_variant (lst , _) ->
let aux ((a,b),c) =

30
src/passes/8-typer-old/typer.ml
View File

@ -505,14 +505,14 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
let%bind match_false = f e match_false in
ok (O.Match_bool {match_true ; match_false})
| Match_option {match_none ; match_some} ->
let%bind t_opt =
let%bind tv =
trace_strong (match_error ~expected:i ~actual:t loc)
@@ get_t_option t in
let%bind match_none = f e match_none in
let (n, b,_) = match_some in
let e' = Environment.add_ez_binder n t_opt e in
let%bind b' = f e' b in
ok (O.Match_option {match_none ; match_some = (n, b', t_opt)})
let (opt, b,_) = match_some in
let e' = Environment.add_ez_binder opt tv e in
let%bind body = f e' b in
ok (O.Match_option {match_none ; match_some = {opt; body; tv}})
| Match_list {match_nil ; match_cons} ->
let%bind t_elt =
trace_strong (match_error ~expected:i ~actual:t loc)
@ -521,8 +521,8 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
let (hd, tl, b,_) = match_cons in
let e' = Environment.add_ez_binder hd t_elt e in
let e' = Environment.add_ez_binder tl t e' in
let%bind b' = f e' b in
ok (O.Match_list {match_nil ; match_cons = (hd, tl, b', t_elt)})
let%bind body = f e' b in
ok (O.Match_list {match_nil ; match_cons = {hd; tl; body; tv=t_elt}})
| Match_tuple ((lst, b),_) ->
let%bind t_tuple =
trace_strong (match_error ~expected:i ~actual:t loc)
@ -919,8 +919,8 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let aux (cur:O.matching_expr) =
match cur with
| Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
| Match_list { match_nil ; match_cons = (_ , _ , match_cons, _) } -> [ match_nil ; match_cons ]
| Match_option { match_none ; match_some = (_ , match_some, _) } -> [ match_none ; match_some ]
| Match_list { match_nil ; match_cons = {hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
| Match_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; body ]
| Match_tuple ((_ , match_tuple), _) -> [ match_tuple ]
| Match_variant (lst , _) -> List.map snd lst in
List.map get_type_expression @@ aux m' in
@ -1096,15 +1096,15 @@ and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -
| Match_tuple ((lst, b),_) ->
let%bind b = f b in
ok @@ I.Match_tuple ((lst, b),[])
| Match_option {match_none ; match_some = (v, some,_)} ->
| Match_option {match_none ; match_some = {opt; body ; tv=_}} ->
let%bind match_none = f match_none in
let%bind some = f some in
let match_some = v, some, () in
let%bind some = f body in
let match_some = opt, some, () in
ok @@ Match_option {match_none ; match_some}
| Match_list {match_nil ; match_cons = (hd_name, tl_name, cons,_)} ->
| Match_list {match_nil ; match_cons = {hd ; tl ; body ; tv=_}} ->
let%bind match_nil = f match_nil in
let%bind cons = f cons in
let match_cons = hd_name , tl_name , cons, () in
let%bind cons = f body in
let match_cons = hd , tl , cons, () in
ok @@ Match_list {match_nil ; match_cons}
| Match_variant (lst , _) ->
let aux ((a,b),c) =

34
src/passes/9-self_ast_typed/helpers.ml
View File

@ -58,14 +58,14 @@ and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
let%bind res = fold_expression f res match_false in
ok res
)
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
| Match_list { match_nil ; match_cons = {hd=_; tl=_ ; body; tv=_} } -> (
let%bind res = fold_expression f init match_nil in
let%bind res = fold_expression f res cons in
let%bind res = fold_expression f res body in
ok res
)
| Match_option { match_none ; match_some = (_ , some, _) } -> (
| Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> (
let%bind res = fold_expression f init match_none in
let%bind res = fold_expression f res some in
let%bind res = fold_expression f res body in
ok res
)
| Match_tuple ((_ , e), _) -> (
@ -139,16 +139,16 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
let%bind match_true = map_expression f match_true in
let%bind match_false = map_expression f match_false in
ok @@ Match_bool { match_true ; match_false }
)
| Match_list { match_nil ; match_cons = (hd , tl , cons, te) } -> (
)
| Match_list { match_nil ; match_cons = {hd ; tl ; body ; tv} } -> (
let%bind match_nil = map_expression f match_nil in
let%bind cons = map_expression f cons in
ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, te) }
let%bind body = map_expression f body in
ok @@ Match_list { match_nil ; match_cons = {hd ; tl ; body; tv} }
)
| Match_option { match_none ; match_some = (name , some, te) } -> (
| Match_option { match_none ; match_some = {opt ; body ; tv } } -> (
let%bind match_none = map_expression f match_none in
let%bind some = map_expression f some in
ok @@ Match_option { match_none ; match_some = (name , some, te) }
let%bind body = map_expression f body in
ok @@ Match_option { match_none ; match_some = { opt ; body ; tv } }
)
| Match_tuple ((names , e), te) -> (
let%bind e' = map_expression f e in
@ -235,15 +235,15 @@ and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_exp
let%bind (init, match_false) = fold_map_expression f init match_false in
ok @@ (init, Match_bool { match_true ; match_false })
)
| Match_list { match_nil ; match_cons = (hd , tl , cons, te) } -> (
| Match_list { match_nil ; match_cons = { hd ; tl ; body ; tv } } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, cons) = fold_map_expression f init cons in
ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, te) })
let%bind (init, body) = fold_map_expression f init body in
ok @@ (init, Match_list { match_nil ; match_cons = { hd ; tl ; body ; tv } })
)
| Match_option { match_none ; match_some = (name , some, te) } -> (
| Match_option { match_none ; match_some = { opt ; body ; tv } } -> (
let%bind (init, match_none) = fold_map_expression f init match_none in
let%bind (init, some) = fold_map_expression f init some in
ok @@ (init, Match_option { match_none ; match_some = (name , some, te) })
let%bind (init, body) = fold_map_expression f init body in
ok @@ (init, Match_option { match_none ; match_some = { opt ; body ; tv } })
)
| Match_tuple ((names , e), te) -> (
let%bind (init, e') = fold_map_expression f init e in

8
src/passes/9-self_ast_typed/tail_recursion.ml
View File

@ -63,13 +63,13 @@ and check_recursive_call_in_matching = fun n final_path c ->
let%bind _ = check_recursive_call n final_path match_true in
let%bind _ = check_recursive_call n final_path match_false in
ok ()
| Match_list {match_nil;match_cons=(_,_,e,_)} ->
| Match_list {match_nil;match_cons={hd=_;tl=_;body;tv=_}} ->
let%bind _ = check_recursive_call n final_path match_nil in
let%bind _ = check_recursive_call n final_path e in
let%bind _ = check_recursive_call n final_path body in
ok ()
| Match_option {match_none; match_some=(_,e,_)} ->
| Match_option {match_none; match_some={opt=_;body;tv=_}} ->
let%bind _ = check_recursive_call n final_path match_none in
let%bind _ = check_recursive_call n final_path e in
let%bind _ = check_recursive_call n final_path body in
ok ()
| Match_tuple ((_,e),_) ->
let%bind _ = check_recursive_call n final_path e in

8
src/stages/4-ast_typed/PP.ml
View File

@ -305,10 +305,10 @@ and matching : (formatter -> expression -> unit) -> _ -> matching_content -> uni
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
| Match_bool {match_true ; match_false} ->
fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
| Match_list {match_nil ; match_cons = (hd_name, tl_name, match_cons, _)} ->
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd_name expression_variable tl_name f match_cons
| Match_option {match_none ; match_some = (some, match_some, _)} ->
fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some
| Match_list {match_nil ; match_cons = {hd; tl; body; tv=_}} ->
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f body
| Match_option {match_none ; match_some = {opt; body; tv=_}} ->
fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable opt f body
let declaration ppf (d : declaration) =
match d with

4
src/stages/4-ast_typed/misc.ml
View File

@ -235,8 +235,8 @@ module Free_variables = struct
and matching : (bindings -> expression -> bindings) -> bindings -> matching_content -> bindings = fun f b m ->
match m with
| Match_bool { match_true = t ; match_false = fa } -> union (f b t) (f b fa)
| Match_list { match_nil = n ; match_cons = (hd, tl, c, _) } -> union (f b n) (f (union (of_list [hd ; tl]) b) c)
| Match_option { match_none = n ; match_some = (opt, s, _) } -> union (f b n) (f (union (singleton opt) b) s)
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } -> union (f b n) (f (union (of_list [hd ; tl]) b) body)
| Match_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
| Match_tuple ((lst , a), _) ->
f (union (of_list lst) b) a
| Match_variant (lst,_) -> unions @@ List.map (matching_variant_case f b) lst

8
src/stages/4-ast_typed/misc_smart.ml
View File

@ -95,13 +95,13 @@ module Captured_variables = struct
let%bind t' = f b t in
let%bind fa' = f b fa in
ok @@ union t' fa'
| Match_list { match_nil = n ; match_cons = (hd, tl, c, _) } ->
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } ->
let%bind n' = f b n in
let%bind c' = f (union (of_list [hd ; tl]) b) c in
let%bind c' = f (union (of_list [hd ; tl]) b) body in
ok @@ union n' c'
| Match_option { match_none = n ; match_some = (opt, s, _) } ->
| Match_option { match_none = n ; match_some = {opt; body; tv=_} } ->
let%bind n' = f b n in
let%bind s' = f (union (singleton opt) b) s in
let%bind s' = f (union (singleton opt) b) body in
ok @@ union n' s'
| Match_tuple ((lst , a),_) ->
f (union (of_list lst) b) a

17
src/stages/4-ast_typed/types.ml
View File

@ -81,14 +81,27 @@ type matching_content_bool = {
match_false : expression ;
}
and matching_content_cons = {
hd : expression_variable;
tl : expression_variable;
body : expression;
tv : type_expression;
}
and matching_content_list = {
match_nil : expression ;
match_cons : expression_variable * expression_variable * expression * type_expression;
match_cons : matching_content_cons;
}
and matching_content_some = {
opt : expression_variable ;
body : expression ;
tv : type_expression ;
}
and matching_content_option = {
match_none : expression ;
match_some : expression_variable * expression * type_expression;
match_some : matching_content_some ;
}
and matching_content_tuple = (expression_variable list * expression) * type_expression list