2019-09-24 15:54:34 +04:00
|
|
|
open Ast_simplified
|
|
|
|
open Trace
|
|
|
|
|
|
|
|
let peephole_expression : expression -> expression result = fun e ->
|
|
|
|
let return expression = ok { e with expression } in
|
|
|
|
match e.expression with
|
|
|
|
| E_constant ("MAP_LITERAL" , lst) -> (
|
|
|
|
let%bind elt =
|
|
|
|
trace_option (simple_error "map literal expects a single parameter") @@
|
|
|
|
List.to_singleton lst
|
|
|
|
in
|
|
|
|
let%bind lst =
|
|
|
|
trace (simple_error "map literal expects a list as parameter") @@
|
|
|
|
get_e_list elt.expression
|
|
|
|
in
|
|
|
|
let aux = fun (e : expression) ->
|
|
|
|
trace (simple_error "map literal expects a list of pairs as parameter") @@
|
|
|
|
let%bind tpl = get_e_tuple e.expression in
|
|
|
|
let%bind (a , b) =
|
|
|
|
trace_option (simple_error "of pairs") @@
|
|
|
|
List.to_pair tpl
|
|
|
|
in
|
|
|
|
ok (a , b)
|
|
|
|
in
|
|
|
|
let%bind pairs = bind_map_list aux lst in
|
|
|
|
return @@ E_map pairs
|
|
|
|
)
|
|
|
|
| E_constant ("MAP_EMPTY" , lst) -> (
|
|
|
|
let%bind () =
|
|
|
|
trace_strong (simple_error "MAP_EMPTY expects no parameter") @@
|
|
|
|
Assert.assert_list_empty lst
|
|
|
|
in
|
|
|
|
return @@ E_map []
|
|
|
|
)
|
2019-09-24 16:00:43 +04:00
|
|
|
| E_constant ("SET_LITERAL" , lst) -> (
|
|
|
|
let%bind elt =
|
|
|
|
trace_option (simple_error "map literal expects a single parameter") @@
|
|
|
|
List.to_singleton lst
|
|
|
|
in
|
|
|
|
let%bind lst =
|
|
|
|
trace (simple_error "map literal expects a list as parameter") @@
|
|
|
|
get_e_list elt.expression
|
|
|
|
in
|
|
|
|
return @@ E_set lst
|
|
|
|
)
|
|
|
|
| E_constant ("SET_EMPTY" , lst) -> (
|
|
|
|
let%bind () =
|
|
|
|
trace_strong (simple_error "SET_EMPTY expects no parameter") @@
|
|
|
|
Assert.assert_list_empty lst
|
|
|
|
in
|
|
|
|
return @@ E_set []
|
|
|
|
)
|
2019-09-24 15:54:34 +04:00
|
|
|
| e -> return e
|