- | C.MutCase (uri, tyno, outty, term, patterns) ->
- C.MutCase (uri, tyno, eta_fix' outty,
- eta_fix' term, List.map eta_fix' patterns)
+ | C.MutCase (uri, tyno, outty, term, patterns) as prima ->
+ let outty' = eta_fix' context outty in
+ let term' = eta_fix' context term in
+ let patterns' = List.map (eta_fix' context) patterns in
+ let inductive_types,noparams =
+ (match CicEnvironment.get_obj uri with
+ Cic.Constant _ -> assert false
+ | Cic.Variable _ -> assert false
+ | Cic.CurrentProof _ -> assert false
+ | Cic.InductiveDefinition (l,_,n) -> l,n
+ ) in
+ let (_,_,_,constructors) = List.nth inductive_types tyno in
+ prerr_endline ("QUI");
+ let constructor_types =
+ let rec clean_up t =
+ function
+ [] -> t
+ | a::tl ->
+ (match t with
+ Cic.Prod (_,_,t') -> clean_up (S.subst a t') tl
+ | _ -> assert false) in
+ if noparams = 0 then
+ List.map (fun (_,t) -> t) constructors
+ else
+ let term_type =
+ CicTypeChecker.type_of_aux' metasenv context term in
+ (match term_type with
+ C.Appl (hd::params) ->
+ List.map (fun (_,t) -> clean_up t params) constructors
+ | _ -> prerr_endline ("QUA"); assert false) in
+ let patterns2 =
+ List.map2 fix_lambdas_wrt_type
+ constructor_types patterns in
+ let dopo =
+ C.MutCase (uri, tyno, outty',term',patterns2) in
+ if not (CicReduction.are_convertible [] prima dopo) then
+ (prerr_endline ("prima :" ^(CicPp.ppterm prima));
+ prerr_endline ("dopo :" ^(CicPp.ppterm dopo)));
+ dopo