version 2
This commit is contained in:
parent
612f8aaf5e
commit
d644872729
@ -210,10 +210,10 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
|
|||||||
let%bind tuple = self tuple in
|
let%bind tuple = self tuple in
|
||||||
return @@ E_tuple_accessor {tuple;path}
|
return @@ E_tuple_accessor {tuple;path}
|
||||||
)
|
)
|
||||||
| E_tuple_destruct {tuple;fields;next} -> (
|
| E_tuple_destruct {tuple;fields;field_types;next} -> (
|
||||||
let%bind tuple = self tuple in
|
let%bind tuple = self tuple in
|
||||||
let%bind next = self next in
|
let%bind next = self next in
|
||||||
return @@ E_tuple_destruct {tuple;fields;next}
|
return @@ E_tuple_destruct {tuple;fields;field_types;next}
|
||||||
)
|
)
|
||||||
| E_constructor c -> (
|
| E_constructor c -> (
|
||||||
let%bind e' = self c.element in
|
let%bind e' = self c.element in
|
||||||
@ -394,10 +394,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
|
|||||||
let%bind (res, tuple) = self init' tuple in
|
let%bind (res, tuple) = self init' tuple in
|
||||||
ok (res, return @@ E_tuple_accessor {tuple; path})
|
ok (res, return @@ E_tuple_accessor {tuple; path})
|
||||||
)
|
)
|
||||||
| E_tuple_destruct {tuple;fields;next} -> (
|
| E_tuple_destruct {tuple;fields;field_types;next} -> (
|
||||||
let%bind (res,tuple) = self init' tuple in
|
let%bind (res,tuple) = self init' tuple in
|
||||||
let%bind (res,next) = self res next in
|
let%bind (res,next) = self res next in
|
||||||
ok (res, return @@ E_tuple_destruct {tuple;fields;next})
|
ok (res, return @@ E_tuple_destruct {tuple;fields;field_types;next})
|
||||||
)
|
)
|
||||||
| E_constructor c -> (
|
| E_constructor c -> (
|
||||||
let%bind (res,e') = self init' c.element in
|
let%bind (res,e') = self init' c.element in
|
||||||
|
@ -337,10 +337,11 @@ and compile_expression' : I.expression -> (O.expression option -> O.expression)
|
|||||||
let%bind tuple = compile_expression tuple in
|
let%bind tuple = compile_expression tuple in
|
||||||
let%bind update = compile_expression update in
|
let%bind update = compile_expression update in
|
||||||
return @@ O.e_tuple_update ~loc tuple path update
|
return @@ O.e_tuple_update ~loc tuple path update
|
||||||
| I.E_tuple_destruct {tuple; fields; next} ->
|
| I.E_tuple_destruct {tuple; fields; field_types; next} ->
|
||||||
let%bind tuple = compile_expression tuple in
|
let%bind tuple = compile_expression tuple in
|
||||||
let%bind next = compile_expression next in
|
let%bind next = compile_expression next in
|
||||||
return @@ O.e_tuple_destruct ~loc tuple fields next
|
let%bind field_types = bind_map_option (bind_map_list compile_type_expression) field_types in
|
||||||
|
return @@ O.e_tuple_destruct ~loc tuple fields field_types next
|
||||||
| I.E_assign {variable; access_path; expression} ->
|
| I.E_assign {variable; access_path; expression} ->
|
||||||
let accessor ?loc s a =
|
let accessor ?loc s a =
|
||||||
match a with
|
match a with
|
||||||
@ -730,10 +731,11 @@ let rec uncompile_expression' : O.expression -> I.expression result =
|
|||||||
let%bind tuple = uncompile_expression' tuple in
|
let%bind tuple = uncompile_expression' tuple in
|
||||||
let%bind update = uncompile_expression' update in
|
let%bind update = uncompile_expression' update in
|
||||||
return @@ I.E_tuple_update {tuple;path;update}
|
return @@ I.E_tuple_update {tuple;path;update}
|
||||||
| O.E_tuple_destruct {tuple; fields; next} ->
|
| O.E_tuple_destruct {tuple; fields; field_types; next} ->
|
||||||
let%bind tuple = uncompile_expression' tuple in
|
let%bind tuple = uncompile_expression' tuple in
|
||||||
let%bind next = uncompile_expression' next in
|
let%bind next = uncompile_expression' next in
|
||||||
return @@ I.E_tuple_destruct {tuple; fields; next}
|
let%bind field_types = bind_map_option (bind_map_list uncompile_type_expression) field_types in
|
||||||
|
return @@ I.E_tuple_destruct {tuple; fields; field_types; next}
|
||||||
| O.E_map map ->
|
| O.E_map map ->
|
||||||
let%bind map = bind_map_list (
|
let%bind map = bind_map_list (
|
||||||
bind_map_pair uncompile_expression'
|
bind_map_pair uncompile_expression'
|
||||||
|
@ -230,10 +230,10 @@ let rec map_expression : exp_mapper -> expression -> expression result = fun f e
|
|||||||
let%bind tuple = self tuple in
|
let%bind tuple = self tuple in
|
||||||
return @@ E_tuple_accessor {tuple;path}
|
return @@ E_tuple_accessor {tuple;path}
|
||||||
)
|
)
|
||||||
| E_tuple_destruct {tuple;fields;next} -> (
|
| E_tuple_destruct {tuple;fields;field_types;next} -> (
|
||||||
let%bind tuple = self tuple in
|
let%bind tuple = self tuple in
|
||||||
let%bind next = self next in
|
let%bind next = self next in
|
||||||
return @@ E_tuple_destruct {tuple;fields;next}
|
return @@ E_tuple_destruct {tuple;fields;field_types;next}
|
||||||
)
|
)
|
||||||
| E_literal _ | E_variable _ | E_skip as e' -> return e'
|
| E_literal _ | E_variable _ | E_skip as e' -> return e'
|
||||||
|
|
||||||
@ -363,10 +363,10 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
|
|||||||
let%bind (res, tuple) = self init' tuple in
|
let%bind (res, tuple) = self init' tuple in
|
||||||
ok (res, return @@ E_tuple_accessor {tuple; path})
|
ok (res, return @@ E_tuple_accessor {tuple; path})
|
||||||
)
|
)
|
||||||
| E_tuple_destruct {tuple;fields;next} -> (
|
| E_tuple_destruct {tuple;fields;field_types;next} -> (
|
||||||
let%bind (res,tuple) = self init' tuple in
|
let%bind (res,tuple) = self init' tuple in
|
||||||
let%bind (res,next) = self res next in
|
let%bind (res,next) = self res next in
|
||||||
ok (res, return @@ E_tuple_destruct {tuple;fields;next})
|
ok (res, return @@ E_tuple_destruct {tuple;fields;field_types;next})
|
||||||
)
|
)
|
||||||
| E_constructor c -> (
|
| E_constructor c -> (
|
||||||
let%bind (res,e') = self init' c.element in
|
let%bind (res,e') = self init' c.element in
|
||||||
|
@ -193,14 +193,22 @@ let rec compile_expression : I.expression -> O.expression result =
|
|||||||
let path = O.Label (string_of_int path) in
|
let path = O.Label (string_of_int path) in
|
||||||
let%bind update = compile_expression update in
|
let%bind update = compile_expression update in
|
||||||
return @@ O.E_record_update {record;path;update}
|
return @@ O.E_record_update {record;path;update}
|
||||||
| I.E_tuple_destruct {tuple; fields; next} ->
|
| I.E_tuple_destruct {tuple; fields; field_types; next} ->
|
||||||
|
let combine fields field_types =
|
||||||
|
match field_types with
|
||||||
|
Some ft -> List.combine fields @@ List.map (fun x -> Some x) ft
|
||||||
|
| None -> List.map (fun x -> (x, None)) fields
|
||||||
|
in
|
||||||
let%bind record = compile_expression tuple in
|
let%bind record = compile_expression tuple in
|
||||||
let%bind next = compile_expression next in
|
let%bind next = compile_expression next in
|
||||||
let aux ((index,e) : int * _ ) (field: I.expression_variable) =
|
let%bind field_types = bind_map_option (bind_map_list idle_type_expression) field_types in
|
||||||
let f = fun expr -> O.e_let_in (field, None) false (O.e_record_accessor record (string_of_int index)) expr in
|
let aux ((index,e) : int * _ ) (field: O.expression_variable * O.type_expression option) =
|
||||||
|
let f = fun expr -> O.e_let_in field false (O.e_record_accessor record (string_of_int index)) expr in
|
||||||
(index+1, fun expr -> e (f expr))
|
(index+1, fun expr -> e (f expr))
|
||||||
in
|
in
|
||||||
let (_,header) = List.fold_left aux (0, fun e -> e) fields in
|
let (_,header) = List.fold_left aux (0, fun e -> e) @@
|
||||||
|
combine fields field_types
|
||||||
|
in
|
||||||
ok @@ header next
|
ok @@ header next
|
||||||
|
|
||||||
and compile_lambda : I.lambda -> O.lambda result =
|
and compile_lambda : I.lambda -> O.lambda result =
|
||||||
|
@ -136,7 +136,7 @@ and expression_content ppf (ec : expression_content) =
|
|||||||
fprintf ppf "%a.%d" expression ta.tuple ta.path
|
fprintf ppf "%a.%d" expression ta.tuple ta.path
|
||||||
| E_tuple_update {tuple; path; update} ->
|
| E_tuple_update {tuple; path; update} ->
|
||||||
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
|
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
|
||||||
| E_tuple_destruct {tuple; fields; next} ->
|
| E_tuple_destruct {tuple; fields; next; _} ->
|
||||||
fprintf ppf "{ let (%a) = %a in %a"
|
fprintf ppf "{ let (%a) = %a in %a"
|
||||||
(list_sep_d expression_variable) fields
|
(list_sep_d expression_variable) fields
|
||||||
expression tuple
|
expression tuple
|
||||||
|
@ -140,7 +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 ?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_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_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_tuple_destruct ?loc tuple fields field_types next = make_e ?loc @@ E_tuple_destruct {tuple; fields; field_types; next}
|
||||||
|
|
||||||
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
|
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}
|
let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}
|
||||||
|
@ -105,7 +105,7 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
|
|||||||
val e_tuple : ?loc:Location.t -> expression list -> expression
|
val e_tuple : ?loc:Location.t -> expression list -> expression
|
||||||
val e_tuple_accessor : ?loc:Location.t -> expression -> int -> 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_update : ?loc:Location.t -> expression -> int -> expression -> expression
|
||||||
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> expression -> expression
|
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
|
||||||
val e_pair : ?loc:Location.t -> expression -> expression -> expression
|
val e_pair : ?loc:Location.t -> expression -> expression -> expression
|
||||||
|
|
||||||
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
|
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
|
||||||
|
@ -145,7 +145,7 @@ and sequence = {
|
|||||||
|
|
||||||
and tuple_accessor = {tuple: expression; path: int}
|
and tuple_accessor = {tuple: expression; path: int}
|
||||||
and tuple_update = {tuple: expression; path: int ; update: expression}
|
and tuple_update = {tuple: expression; path: int ; update: expression}
|
||||||
and tuple_destruct = {tuple: expression; fields : expression_variable list; next : expression}
|
and tuple_destruct = {tuple: expression; fields : expression_variable list; field_types : type_expression list option; next : expression}
|
||||||
|
|
||||||
and assign = {
|
and assign = {
|
||||||
variable : expression_variable;
|
variable : expression_variable;
|
||||||
|
@ -129,7 +129,7 @@ and expression_content ppf (ec : expression_content) =
|
|||||||
fprintf ppf "%a.%d" expression ta.tuple ta.path
|
fprintf ppf "%a.%d" expression ta.tuple ta.path
|
||||||
| E_tuple_update {tuple; path; update} ->
|
| E_tuple_update {tuple; path; update} ->
|
||||||
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
|
fprintf ppf "{ %a with %d = %a }" expression tuple path expression update
|
||||||
| E_tuple_destruct {tuple; fields; next} ->
|
| E_tuple_destruct {tuple; fields; next; _} ->
|
||||||
fprintf ppf "{ let (%a) = %a in %a"
|
fprintf ppf "{ let (%a) = %a in %a"
|
||||||
(list_sep_d expression_variable) fields
|
(list_sep_d expression_variable) fields
|
||||||
expression tuple
|
expression tuple
|
||||||
|
@ -129,7 +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 ?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_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_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_tuple_destruct ?loc tuple fields field_types next = make_e ?loc @@ E_tuple_destruct {tuple; fields; field_types; next}
|
||||||
let e_pair ?loc a b : expression = e_tuple ?loc [a;b]
|
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}
|
let e_cond ?loc condition then_clause else_clause = make_e ?loc @@ E_cond {condition;then_clause;else_clause}
|
||||||
|
@ -85,7 +85,7 @@ val e_annotation : ?loc:Location.t -> expression -> type_expression -> expressio
|
|||||||
val e_tuple : ?loc:Location.t -> expression list -> expression
|
val e_tuple : ?loc:Location.t -> expression list -> expression
|
||||||
val e_tuple_accessor : ?loc:Location.t -> expression -> int -> 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_update : ?loc:Location.t -> expression -> int -> expression -> expression
|
||||||
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> expression -> expression
|
val e_tuple_destruct : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
|
||||||
val e_pair : ?loc:Location.t -> expression -> expression -> expression
|
val e_pair : ?loc:Location.t -> expression -> expression -> expression
|
||||||
|
|
||||||
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
|
val e_cond: ?loc:Location.t -> expression -> expression -> expression -> expression
|
||||||
|
@ -139,7 +139,7 @@ and sequence = {
|
|||||||
|
|
||||||
and tuple_accessor = {tuple: expression; path: int}
|
and tuple_accessor = {tuple: expression; path: int}
|
||||||
and tuple_update = {tuple: expression; path: int ; update: expression}
|
and tuple_update = {tuple: expression; path: int ; update: expression}
|
||||||
and tuple_destruct = {tuple: expression; fields : expression_variable list; next : expression}
|
and tuple_destruct = {tuple: expression; fields : expression_variable list; field_types : type_expression list option; next : expression}
|
||||||
|
|
||||||
and environment_element_definition =
|
and environment_element_definition =
|
||||||
| ED_binder
|
| ED_binder
|
||||||
|
Loading…
Reference in New Issue
Block a user