From e7e2954471b4779cd4e4ae590ca5047575902fb7 Mon Sep 17 00:00:00 2001
From: Enrico Tassi <enrico.tassi@inria.fr>
Date: Mon, 7 Jun 2010 22:55:47 +0000
Subject: [PATCH] unify left args of inductive types with left argus of
 constructors. this allows to put ? in every left arg of every constructor of
 an inductive type.

---
 helm/software/components/ng_refiner/.depend   |  8 +++----
 .../components/ng_refiner/.depend.opt         | 11 +++++----
 .../components/ng_refiner/nCicRefiner.ml      | 23 +++++++++++++++++++
 3 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/helm/software/components/ng_refiner/.depend b/helm/software/components/ng_refiner/.depend
index d3a179400..da0ab80fc 100644
--- a/helm/software/components/ng_refiner/.depend
+++ b/helm/software/components/ng_refiner/.depend
@@ -22,7 +22,7 @@ nCicRefineUtil.cmo: nCicMetaSubst.cmi nCicRefineUtil.cmi
 nCicRefineUtil.cmx: nCicMetaSubst.cmx nCicRefineUtil.cmi 
 nCicUnification.cmo: nCicUnifHint.cmi nCicMetaSubst.cmi nCicUnification.cmi 
 nCicUnification.cmx: nCicUnifHint.cmx nCicMetaSubst.cmx nCicUnification.cmi 
-nCicRefiner.cmo: nCicUnification.cmi nCicMetaSubst.cmi nCicCoercion.cmi \
-    nCicRefiner.cmi 
-nCicRefiner.cmx: nCicUnification.cmx nCicMetaSubst.cmx nCicCoercion.cmx \
-    nCicRefiner.cmi 
+nCicRefiner.cmo: nCicUnification.cmi nCicRefineUtil.cmi nCicMetaSubst.cmi \
+    nCicCoercion.cmi nCicRefiner.cmi 
+nCicRefiner.cmx: nCicUnification.cmx nCicRefineUtil.cmx nCicMetaSubst.cmx \
+    nCicCoercion.cmx nCicRefiner.cmi 
diff --git a/helm/software/components/ng_refiner/.depend.opt b/helm/software/components/ng_refiner/.depend.opt
index db7e52884..da0ab80fc 100644
--- a/helm/software/components/ng_refiner/.depend.opt
+++ b/helm/software/components/ng_refiner/.depend.opt
@@ -3,6 +3,7 @@ nCicMetaSubst.cmi:
 nCicUnifHint.cmi: 
 nCicCoercion.cmi: nCicUnifHint.cmi 
 nRstatus.cmi: nCicCoercion.cmi 
+nCicRefineUtil.cmi: 
 nCicUnification.cmi: nRstatus.cmi 
 nCicRefiner.cmi: nRstatus.cmi 
 nDiscriminationTree.cmo: nDiscriminationTree.cmi 
@@ -17,9 +18,11 @@ nCicCoercion.cmx: nDiscriminationTree.cmx nCicUnifHint.cmx nCicMetaSubst.cmx \
     nCicCoercion.cmi 
 nRstatus.cmo: nCicCoercion.cmi nRstatus.cmi 
 nRstatus.cmx: nCicCoercion.cmx nRstatus.cmi 
+nCicRefineUtil.cmo: nCicMetaSubst.cmi nCicRefineUtil.cmi 
+nCicRefineUtil.cmx: nCicMetaSubst.cmx nCicRefineUtil.cmi 
 nCicUnification.cmo: nCicUnifHint.cmi nCicMetaSubst.cmi nCicUnification.cmi 
 nCicUnification.cmx: nCicUnifHint.cmx nCicMetaSubst.cmx nCicUnification.cmi 
-nCicRefiner.cmo: nCicUnification.cmi nCicMetaSubst.cmi nCicCoercion.cmi \
-    nCicRefiner.cmi 
-nCicRefiner.cmx: nCicUnification.cmx nCicMetaSubst.cmx nCicCoercion.cmx \
-    nCicRefiner.cmi 
+nCicRefiner.cmo: nCicUnification.cmi nCicRefineUtil.cmi nCicMetaSubst.cmi \
+    nCicCoercion.cmi nCicRefiner.cmi 
+nCicRefiner.cmx: nCicUnification.cmx nCicRefineUtil.cmx nCicMetaSubst.cmx \
+    nCicCoercion.cmx nCicRefiner.cmi 
diff --git a/helm/software/components/ng_refiner/nCicRefiner.ml b/helm/software/components/ng_refiner/nCicRefiner.ml
index 8476119ad..7833b9c4a 100644
--- a/helm/software/components/ng_refiner/nCicRefiner.ml
+++ b/helm/software/components/ng_refiner/nCicRefiner.ml
@@ -1128,6 +1128,29 @@ let typeof_obj
                     metasenv,subst,item1::context
                 ) (metasenv,subst,tys) sx_context_ty_rev sx_context_te_rev
               with Invalid_argument "List.fold_left2" -> assert false in
+             let metasenv, subst =
+                let rec aux context (metasenv,subst) = function
+                  | NCic.Meta _ -> metasenv, subst
+                  | NCic.Implicit _ -> metasenv, subst
+                  | NCic.Appl (NCic.Rel i :: args) as t
+                      when i >= List.length context - len ->
+                      let lefts, _ = HExtlib.split_nth leftno args in
+                      let ctxlen = List.length context in
+                      let (metasenv, subst), _ = 
+                        List.fold_left
+                        (fun ((metasenv, subst),l) arg ->
+                          NCicUnification.unify rdb 
+                           ~test_eq_only:true metasenv subst context arg 
+                             (NCic.Rel (ctxlen - len - l)), l+1
+                          )
+                        ((metasenv, subst), 0) lefts
+                      in
+                      metasenv, subst
+                  | t -> NCicUtils.fold (fun e c -> e::c) context aux
+                  (metasenv,subst) t
+                in
+               aux context (metasenv,subst) te
+             in
              let con_sort= NCicTypeChecker.typeof ~subst ~metasenv context te in
               (match
                 NCicReduction.whd ~subst context con_sort,
-- 
2.39.2