X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Ftactics%2FproofEngineReduction.ml;h=e43f9221c2d0a503cb46b6a2c145d4fac3438cc9;hb=b41886e9d21d756279bd6a2ec3f19c17b1a64401;hp=99eb43f6a56e65e8419b090e43a0d2016dd6651b;hpb=e626927b4c1c77bdcd6b545203a0a9c17a9ff136;p=helm.git diff --git a/helm/ocaml/tactics/proofEngineReduction.ml b/helm/ocaml/tactics/proofEngineReduction.ml index 99eb43f6a..e43f9221c 100644 --- a/helm/ocaml/tactics/proofEngineReduction.ml +++ b/helm/ocaml/tactics/proofEngineReduction.ml @@ -389,14 +389,15 @@ let reduce context = let exp_named_subst' = reduceaux_exp_named_subst context l exp_named_subst in - (match CicEnvironment.get_obj uri with + (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + match o with C.Constant _ -> raise ReferenceToConstant | C.CurrentProof _ -> raise ReferenceToCurrentProof | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition - | C.Variable (_,None,_,_) -> + | C.Variable (_,None,_,_,_) -> let t' = C.Var (uri,exp_named_subst') in if l = [] then t' else C.Appl (t'::l) - | C.Variable (_,Some body,_,_) -> + | C.Variable (_,Some body,_,_,_) -> (reduceaux context l (CicSubstitution.subst_vars exp_named_subst' body)) ) @@ -429,15 +430,16 @@ let reduce context = let exp_named_subst' = reduceaux_exp_named_subst context l exp_named_subst in - (match CicEnvironment.get_obj uri with - C.Constant (_,Some body,_,_) -> + (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + match o with + C.Constant (_,Some body,_,_,_) -> (reduceaux context l (CicSubstitution.subst_vars exp_named_subst' body)) - | C.Constant (_,None,_,_) -> + | C.Constant (_,None,_,_,_) -> let t' = C.Const (uri,exp_named_subst') in if l = [] then t' else C.Appl (t'::l) | C.Variable _ -> raise ReferenceToVariable - | C.CurrentProof (_,_,body,_,_) -> + | C.CurrentProof (_,_,body,_,_,_) -> (reduceaux context l (CicSubstitution.subst_vars exp_named_subst' body)) | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition @@ -490,11 +492,12 @@ let reduce context = C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1)) | C.Appl (C.MutConstruct (_,_,j,_) :: tl) -> let (arity, r) = - match CicEnvironment.get_obj mutind with - C.InductiveDefinition (tl,_,r) -> - let (_,_,arity,_) = List.nth tl i in - (arity,r) - | _ -> raise WrongUriToInductiveDefinition + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph mutind in + match o with + C.InductiveDefinition (tl,_,r,_) -> + let (_,_,arity,_) = List.nth tl i in + (arity,r) + | _ -> raise WrongUriToInductiveDefinition in let ts = let rec eat_first = @@ -612,14 +615,15 @@ let simpl context = let exp_named_subst' = reduceaux_exp_named_subst context l exp_named_subst in - (match CicEnvironment.get_obj uri with + (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + match o with C.Constant _ -> raise ReferenceToConstant | C.CurrentProof _ -> raise ReferenceToCurrentProof | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition - | C.Variable (_,None,_,_) -> + | C.Variable (_,None,_,_,_) -> let t' = C.Var (uri,exp_named_subst') in if l = [] then t' else C.Appl (t'::l) - | C.Variable (_,Some body,_,_) -> + | C.Variable (_,Some body,_,_,_) -> reduceaux context l (CicSubstitution.subst_vars exp_named_subst' body) ) @@ -652,16 +656,17 @@ let simpl context = let exp_named_subst' = reduceaux_exp_named_subst context l exp_named_subst in - (match CicEnvironment.get_obj uri with - C.Constant (_,Some body,_,_) -> + (let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + match o with + C.Constant (_,Some body,_,_,_) -> try_delta_expansion l (C.Const (uri,exp_named_subst')) (CicSubstitution.subst_vars exp_named_subst' body) - | C.Constant (_,None,_,_) -> + | C.Constant (_,None,_,_,_) -> let t' = C.Const (uri,exp_named_subst') in if l = [] then t' else C.Appl (t'::l) | C.Variable _ -> raise ReferenceToVariable - | C.CurrentProof (_,_,body,_,_) -> reduceaux context l body + | C.CurrentProof (_,_,body,_,_,_) -> reduceaux context l body | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition ) | C.MutInd (uri,i,exp_named_subst) -> @@ -710,11 +715,12 @@ let simpl context = C.MutConstruct (_,_,j,_) -> reduceaux context l (List.nth pl (j-1)) | C.Appl (C.MutConstruct (_,_,j,_) :: tl) -> let (arity, r) = - match CicEnvironment.get_obj mutind with - C.InductiveDefinition (tl,ingredients,r) -> - let (_,_,arity,_) = List.nth tl i in - (arity,r) - | _ -> raise WrongUriToInductiveDefinition + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph mutind in + match o with + C.InductiveDefinition (tl,ingredients,r,_) -> + let (_,_,arity,_) = List.nth tl i in + (arity,r) + | _ -> raise WrongUriToInductiveDefinition in let ts = let rec eat_first =