hack to make the Pp work (sometimes)

[helm.git] / helm / software / components / cic_disambiguation / disambiguate.ml

diff --git a/helm/software/components/cic_disambiguation/disambiguate.ml b/helm/software/components/cic_disambiguation/disambiguate.ml
index cb4d85cfd245fafb088410a89b092dd4b8375972..fb4c338a447ee040ac8c4ecb63dfad86c149b31d 100644 (file)
--- 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,7 +500,7 @@ 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) ->
@@ -692,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) ->
@@ -702,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
@@ -717,6 +717,10 @@ let domain_diff dom1 dom2 =
           (match elt with
               Symbol (symb',_) when symb = symb' -> true
             | _ -> false)
+       | Num i ->
+          (match elt with
+              Num _ -> true
+            | _ -> false)
        | item -> elt = item
      ) dom2
   in