X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_disambiguation%2Fdisambiguate.ml;h=fbe191416a0185024ad68575688fb0bd3b91d511;hb=d5c1f34cd226898525168e470d3e2ec273699826;hp=d3af052564b5e206303d8adb7338203f6f280592;hpb=8f9d476c32c48d14348a61889dc191c7696bd404;p=helm.git diff --git a/helm/software/components/cic_disambiguation/disambiguate.ml b/helm/software/components/cic_disambiguation/disambiguate.ml index d3af05256..fbe191416 100644 --- a/helm/software/components/cic_disambiguation/disambiguate.ml +++ b/helm/software/components/cic_disambiguation/disambiguate.ml @@ -483,7 +483,7 @@ let interpretate_obj ~context ~env ~uri ~is_path obj ~localization_tbl = let fields' = snd ( List.fold_left - (fun (context,res) (name,ty,_coercion) -> + (fun (context,res) (name,ty,_coercion,arity) -> let context' = Cic.Name name :: context in context',(name,interpretate_term context env None false ty)::res ) (context,[]) fields) in @@ -500,16 +500,19 @@ let interpretate_obj ~context ~env ~uri ~is_path obj ~localization_tbl = concl fields' in let con' = add_params con in let tyl = [name,true,ty',["mk_" ^ name,con']] in - let field_names = List.map (fun (x,_,y) -> x,y) fields in + let field_names = List.map (fun (x,_,y,z) -> x,y,z) fields in Cic.InductiveDefinition (tyl,[],List.length params,[`Class (`Record field_names)]) | CicNotationPt.Theorem (flavour, name, ty, bo) -> let attrs = [`Flavour flavour] in let ty' = interpretate_term [] env None false ty in - (match bo with - None -> + (match bo,flavour with + None,`Axiom -> + Cic.Constant (name,None,ty',[],attrs) + | Some bo,`Axiom -> assert false + | None,_ -> Cic.CurrentProof (name,[],Cic.Implicit None,ty',[],attrs) - | Some bo -> + | Some bo,_ -> let bo' = Some (interpretate_term [] env None false bo) in Cic.Constant (name,bo',ty',[],attrs)) @@ -689,7 +692,7 @@ let domain_of_obj ~context ast = | CicNotationPt.Record (params,_,ty,fields) -> let dom = List.flatten - (List.rev_map (fun (_,ty,_) -> domain_rev_of_term [] ty) fields) in + (List.rev_map (fun (_,ty,_,_) -> domain_rev_of_term [] ty) fields) in let dom = List.fold_left (fun dom (_,ty) -> @@ -699,7 +702,7 @@ let domain_of_obj ~context ast = List.filter (fun (_,name) -> not ( List.exists (fun (name',_) -> name = Id name') params - || List.exists (fun (name',_,_) -> name = Id name') fields) + || List.exists (fun (name',_,_,_) -> name = Id name') fields) ) dom in rev_uniq domain_rev @@ -707,9 +710,15 @@ let domain_of_obj ~context ast = (* dom1 \ dom2 *) let domain_diff dom1 dom2 = (* let domain_diff = Domain.diff *) - let is_in_dom2 = - List.fold_left (fun pred elt -> (fun elt' -> elt' = elt || pred elt')) - (fun _ -> false) dom2 + let is_in_dom2 elt = + List.exists + (function + | Symbol (symb, 0) -> + (match elt with + Symbol (symb',_) when symb = symb' -> true + | _ -> false) + | item -> elt = item + ) dom2 in List.filter (fun (_,elt) -> not (is_in_dom2 elt)) dom1 @@ -830,7 +839,7 @@ let refine_profiler = HExtlib.profile "disambiguate_thing.refine_thing" | item -> item in Environment.find item e - with Not_found -> []) + with Not_found -> lookup_in_library ()) in choices in