special case for pascaligo generated LIST/SET/MAP_FOLD

This commit is contained in:
Lesenechal Remi 2019-10-26 22:15:28 +02:00
parent 70502f62cb
commit 91d92e048d

View File

@ -615,6 +615,37 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
let output_type = body.type_annotation in
return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ())
)
| E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") ,
[ collect ;
init_record ;
( { expression = (I.E_lambda { binder = (name, None) ;
input_type = None ;
output_type = None ;
result }) ;
location = _ }) as _lambda
] ) ->
(* this special case is here force annotation of the lambda
generated by pascaligo's for_collect loop *)
let%bind lst' = bind_list @@ List.map (type_expression e) [collect ; init_record] in
let tv_lst = List.map get_type_annotation lst' in
let tv_col = List.nth tv_lst 0 in
let tv_out = List.nth tv_lst 1 in
let collect_inner_type = match tv_col.type_value' with
| O.T_constant ( ("list"|"set"|"map") , t) -> t
| _ -> failwith "impossible" in
let input_type = t_tuple (tv_out::collect_inner_type) () in
let output_type = Some tv_out in
let e' = Environment.add_ez_binder name input_type e in
let%bind body = type_expression ?tv_opt:output_type e' result in
let output_type = body.type_annotation in
let%bind lambda' = ok @@ make_a_e (E_lambda {binder = name ; body}) (t_function input_type output_type ()) e in
let%bind lst' = ok @@ lst'@[lambda'] in
let tv_lst = List.map get_type_annotation lst' in
let%bind (name', tv) =
type_constant name tv_lst tv_opt ae.location in
return (E_constant (name' , lst')) tv
| E_constant (name, lst) ->
let%bind lst' = bind_list @@ List.map (type_expression e) lst in
let tv_lst = List.map get_type_annotation lst' in