special case for pascaligo generated LIST/SET/MAP_FOLD

src/passes/4-typer/typer.ml

@@ -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