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

vesion 1

Browse Source
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-05-29 16:06:44 +02:00
parent d5983de522
commit 612f8aaf5e
12 changed files with 70 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/passes/3-self_ast_imperative/helpers.ml
View File

@ -82,6 +82,11 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let%bind res = self init' tuple in
ok res
)
| E_tuple_destruct {tuple; next} -> (
let%bind res = self init' tuple in
let%bind res = self res next in
ok res
)
| E_let_in { let_binder = _ ; rhs ; let_result } -> (
let%bind res = self init' rhs in
let%bind res = self res let_result in
@ -205,6 +210,11 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
let%bind tuple = self tuple in
return @@ E_tuple_accessor {tuple;path}
)
| E_tuple_destruct {tuple;fields;next} -> (
let%bind tuple = self tuple in
let%bind next = self next in
return @@ E_tuple_destruct {tuple;fields;next}
)
| E_constructor c -> (
let%bind e' = self c.element in
return @@ E_constructor {c with element = e'}
@ -384,6 +394,11 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
let%bind (res, tuple) = self init' tuple in
ok (res, return @@ E_tuple_accessor {tuple; path})
)
| E_tuple_destruct {tuple;fields;next} -> (
let%bind (res,tuple) = self init' tuple in
let%bind (res,next) = self res next in
ok (res, return @@ E_tuple_destruct {tuple;fields;next})
)
| E_constructor c -> (
let%bind (res,e') = self init' c.element in
ok (res, return @@ E_constructor {c with element = e'})

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

@ -57,9 +57,10 @@ let repair_mutable_variable_in_matching (match_body : O.expression) (element_nam
| E_constant _
| E_skip
| E_literal _ | E_variable _
| E_application _ | E_lambda _| E_recursive _
| E_constructor _ | E_record _| E_record_accessor _|E_record_update _
| E_ascription _ | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _
| E_application _ | E_lambda _| E_recursive _ | E_constructor _
| E_record _| E_record_accessor _|E_record_update _ | E_ascription _
| E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _
| E_tuple_destruct _
| E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _
-> ok (true, (decl_var, free_var),ass_exp)
)
@ -104,6 +105,7 @@ and repair_mutable_variable_in_loops (for_body : O.expression) (element_names :
| E_application _ | E_lambda _| E_recursive _
| E_constructor _ | E_record _| E_record_accessor _|E_record_update _
| E_ascription _ | E_sequence _ | E_tuple _ | E_tuple_accessor _ | E_tuple_update _
| E_tuple_destruct _
| E_map _ | E_big_map _ |E_list _ | E_set _ |E_look_up _
-> ok (true, (decl_var, free_var),ass_exp)
)
@ -335,6 +337,10 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
let%bind tuple = compile_expression tuple in
let%bind update = compile_expression update in
return @@ O.e_tuple_update ~loc tuple path update
| I.E_tuple_destruct {tuple; fields; next} ->
let%bind tuple = compile_expression tuple in
let%bind next = compile_expression next in
return @@ O.e_tuple_destruct ~loc tuple fields next
| I.E_assign {variable; access_path; expression} ->
let accessor ?loc s a =
match a with
@ -724,6 +730,10 @@ let rec uncompile_expression' : O.expression -> I.expression result =
let%bind tuple = uncompile_expression' tuple in
let%bind update = uncompile_expression' update in
return @@ I.E_tuple_update {tuple;path;update}
| O.E_tuple_destruct {tuple; fields; next} ->
let%bind tuple = uncompile_expression' tuple in
let%bind next = uncompile_expression' next in
return @@ I.E_tuple_destruct {tuple; fields; next}
| O.E_map map ->
let%bind map = bind_map_list (
bind_map_pair uncompile_expression'

15
src/passes/5-self_ast_sugar/helpers.ml
View File

@ -99,6 +99,11 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
let%bind res = self init' tuple in
ok res
)
| E_tuple_destruct {tuple; next} -> (
let%bind res = self init' tuple in
let%bind res = self res next in
ok res
)
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
@ -225,6 +230,11 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
let%bind tuple = self tuple in
return @@ E_tuple_accessor {tuple;path}
)
| E_tuple_destruct {tuple;fields;next} -> (
let%bind tuple = self tuple in
let%bind next = self next in
return @@ E_tuple_destruct {tuple;fields;next}
)
| E_literal _ | E_variable _ | E_skip as e' -> return e'
and map_type_expression : ty_exp_mapper -> type_expression -> type_expression result = fun f te ->
@ -353,6 +363,11 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
let%bind (res, tuple) = self init' tuple in
ok (res, return @@ E_tuple_accessor {tuple; path})
)
| E_tuple_destruct {tuple;fields;next} -> (
let%bind (res,tuple) = self init' tuple in
let%bind (res,next) = self res next in
ok (res, return @@ E_tuple_destruct {tuple;fields;next})
)
| E_constructor c -> (
let%bind (res,e') = self init' c.element in
ok (res, return @@ E_constructor {c with element = e'})

9
src/passes/6-sugar_to_core/sugar_to_core.ml
View File

@ -193,6 +193,15 @@ let rec compile_expression : I.expression -> O.expression result =
let path = O.Label (string_of_int path) in
let%bind update = compile_expression update in
return @@ O.E_record_update {record;path;update}
| I.E_tuple_destruct {tuple; fields; next} ->
let%bind record = compile_expression tuple in
let%bind next = compile_expression next in
let aux ((index,e) : int * _ ) (field: I.expression_variable) =
let f = fun expr -> O.e_let_in (field, None) false (O.e_record_accessor record (string_of_int index)) expr in
(index+1, fun expr -> e (f expr))
in
let (_,header) = List.fold_left aux (0, fun e -> e) fields in
ok @@ header next
and compile_lambda : I.lambda -> O.lambda result =
fun {binder;input_type;output_type;result}->

5
src/stages/1-ast_imperative/PP.ml
View File

@ -136,6 +136,11 @@ and expression_content ppf (ec : expression_content) =
fprintf ppf "%a.%d" expression ta.tuple ta.path
| E_tuple_update {tuple; path; update} ->
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
| E_tuple_destruct {tuple; fields; next} ->
fprintf ppf "{ let (%a) = %a in %a"
(list_sep_d expression_variable) fields
expression tuple
expression next
| E_assign {variable; access_path; expression=e} ->
fprintf ppf "%a%a := %a"
expression_variable variable

1
src/stages/1-ast_imperative/combinators.ml
View File

@ -140,6 +140,7 @@ let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; typ
let e_tuple ?loc lst : expression = make_e ?loc @@ E_tuple lst
let e_tuple_accessor ?loc tuple path : expression = make_e ?loc @@ E_tuple_accessor {tuple; path}
let e_tuple_update ?loc tuple path update : expression = make_e ?loc @@ E_tuple_update {tuple; path; update}
let e_tuple_destruct ?loc tuple fields next = make_e ?loc @@ E_tuple_destruct {tuple; fields; next}
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}

1
src/stages/1-ast_imperative/combinators.mli
View File

@ -105,6 +105,7 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
val e_tuple : ?loc:Location.t -> expression list -> expression
val e_tuple_accessor : ?loc:Location.t -> expression -> int -> expression
val e_tuple_update : ?loc:Location.t -> expression -> int -> expression -> expression
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> expression -> expression
val e_pair : ?loc:Location.t -> expression -> expression -> expression
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression

2
src/stages/1-ast_imperative/types.ml
View File

@ -77,6 +77,7 @@ and expression_content =
| E_tuple of expression list
| E_tuple_accessor of tuple_accessor
| E_tuple_update of tuple_update
| E_tuple_destruct of tuple_destruct
(* Data Structures *)
| E_map of (expression * expression) list
| E_big_map of (expression * expression) list
@ -144,6 +145,7 @@ and sequence = {
and tuple_accessor = {tuple: expression; path: int}
and tuple_update = {tuple: expression; path: int ; update: expression}
and tuple_destruct = {tuple: expression; fields : expression_variable list; next : expression}
and assign = {
variable : expression_variable;

5
src/stages/2-ast_sugar/PP.ml
View File

@ -129,6 +129,11 @@ and expression_content ppf (ec : expression_content) =
fprintf ppf "%a.%d" expression ta.tuple ta.path
| E_tuple_update {tuple; path; update} ->
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
| E_tuple_destruct {tuple; fields; next} ->
fprintf ppf "{ let (%a) = %a in %a"
(list_sep_d expression_variable) fields
expression tuple
expression next
and option_type_name ppf
((n, ty_opt) : expression_variable * type_expression option) =

1
src/stages/2-ast_sugar/combinators.ml
View File

@ -129,6 +129,7 @@ let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; typ
let e_tuple ?loc lst : expression = make_e ?loc @@ E_tuple lst
let e_tuple_accessor ?loc tuple path = make_e ?loc @@ E_tuple_accessor {tuple; path}
let e_tuple_update ?loc tuple path update = make_e ?loc @@ E_tuple_update {tuple; path; update}
let e_tuple_destruct ?loc tuple fields next = make_e ?loc @@ E_tuple_destruct {tuple; fields; next}
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}

1
src/stages/2-ast_sugar/combinators.mli
View File

@ -85,6 +85,7 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
val e_tuple : ?loc:Location.t -> expression list -> expression
val e_tuple_accessor : ?loc:Location.t -> expression -> int -> expression
val e_tuple_update : ?loc:Location.t -> expression -> int -> expression -> expression
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> expression -> expression
val e_pair : ?loc:Location.t -> expression -> expression -> expression
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression

2
src/stages/2-ast_sugar/types.ml
View File

@ -77,6 +77,7 @@ and expression_content =
| E_tuple of expression list
| E_tuple_accessor of tuple_accessor
| E_tuple_update of tuple_update
| E_tuple_destruct of tuple_destruct
(* Data Structures *)
| E_map of (expression * expression) list
| E_big_map of (expression * expression) list
@ -138,6 +139,7 @@ and sequence = {
and tuple_accessor = {tuple: expression; path: int}
and tuple_update = {tuple: expression; path: int ; update: expression}
and tuple_destruct = {tuple: expression; fields : expression_variable list; next : expression}
and environment_element_definition =
| ED_binder