Hack for E_constant with loops shouldn't be necessary in new typer, thanks to typeclasses?

This commit is contained in:
Suzanne Dupéron 2019-10-31 17:19:01 -04:00
parent 1e06c24325
commit 5c3e1ad642

View File

@ -707,42 +707,6 @@ and type_expression : environment -> Solver.state -> I.expression -> (O.annotate
* let%bind (name', tv) = * let%bind (name', tv) =
* type_constant name tv_lst tv_opt ae.location in * type_constant name tv_lst tv_opt ae.location in
* return (E_constant (name' , lst')) tv *) * return (E_constant (name' , lst')) tv *)
| E_constant ( ("LIST_FOLD"|"MAP_FOLD"|"SET_FOLD") as opname ,
[ collect ;
init_record ;
( { expression = (I.E_lambda { binder = (lname, None) ;
input_type = None ;
output_type = None ;
result }) ;
location = _ }) as _lambda
] ) ->
let _TODO = (opname, collect, init_record, lname, result) in
failwith "TODO: E_constant merge"
(* ******************************************************************************************************************************************************** *)
(*
(* this special case is here force annotation of the untyped lambda
generated by pascaligo's for_collect loop *)
let%bind (v_col , v_initr ) = bind_map_pair (type_expression e) (collect , init_record ) in
let tv_col = get_type_annotation v_col in (* this is the type of the collection *)
let tv_out = get_type_annotation v_initr in (* this is the output type of the lambda*)
let%bind input_type = match tv_col.type_value' with
| O.T_constant ( ("list"|"set") , t) -> ok @@ t_tuple (tv_out::t) ()
| O.T_constant ( "map" , t) -> ok @@ t_tuple (tv_out::[(t_tuple t ())]) ()
| _ ->
let wtype = Format.asprintf
"Loops over collections expect lists, sets or maps, got type %a" O.PP.type_value tv_col in
fail @@ simple_error wtype in
let e' = Environment.add_ez_binder lname input_type e in
let%bind body = type_expression ?tv_opt:(Some tv_out) e' result in
let output_type = body.type_annotation in
let lambda' = make_a_e (E_lambda {binder = lname ; body}) (t_function input_type output_type ()) e in
let lst' = [v_col; v_initr ; lambda'] in
let tv_lst = List.map get_type_annotation lst' in
let%bind (opname', tv) =
type_constant opname tv_lst tv_opt ae.location in
return (E_constant (opname' , lst')) tv
*)
(* ******************************************************************************************************************************************************** *)
| E_application (f, arg) -> | E_application (f, arg) ->
let%bind (f' , state') = type_expression e state f in let%bind (f' , state') = type_expression e state f in
let%bind (arg , state'') = type_expression e state' arg in let%bind (arg , state'') = type_expression e state' arg in