X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FproofEngineReduction.ml;h=87cf24c2158be45bf601d879c4bfc2690315ec84;hb=4020414d9bc31b545e311760045d4ce8f0645916;hp=460c8d7263acfbeed94a2536fa3cfd5c6abb8cad;hpb=a86e50c2f080bd288d1a37b27fd4d0ea3044c5df;p=helm.git diff --git a/helm/gTopLevel/proofEngineReduction.ml b/helm/gTopLevel/proofEngineReduction.ml index 460c8d726..87cf24c21 100644 --- a/helm/gTopLevel/proofEngineReduction.ml +++ b/helm/gTopLevel/proofEngineReduction.ml @@ -1,4 +1,4 @@ -(* Copyright (C) 2000, HELM Team. +(* Copyright (C) 2002, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -75,7 +75,6 @@ let rec syntactic_equality t t' = | C.Appl l, C.Appl l' -> List.fold_left2 (fun b t1 t2 -> b && syntactic_equality t1 t2) true l l' | C.Const (uri,_), C.Const (uri',_) -> UriManager.eq uri uri' - | C.Abst _, C.Abst _ -> assert false | C.MutInd (uri,_,i), C.MutInd (uri',_,i') -> UriManager.eq uri uri' && i = i' | C.MutConstruct (uri,_,i,j), C.MutConstruct (uri',_,i',j') -> @@ -124,7 +123,6 @@ let replace ~equality ~what ~with_what ~where = (C.Appl l')::tl -> C.Appl (l'@tl) | l' -> C.Appl l') | C.Const _ as t -> t - | C.Abst _ as t -> t | C.MutInd _ as t -> t | C.MutConstruct _ as t -> t | C.MutCase (sp,cookingsno,i,outt,t,pl) -> @@ -203,7 +201,6 @@ let reduce context = | C.CurrentProof (_,_,body,_) -> reduceaux context l body | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition ) - | C.Abst _ as t -> t (*CSC l should be empty ????? *) | C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l) | C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l) | C.MutCase (mutind,cookingsno,i,outtype,term,pl) -> @@ -265,7 +262,7 @@ let reduce context = eat_first (num_to_eat,tl) in reduceaux context (ts@l) (List.nth pl (j-1)) - | C.Abst _ | C.Cast _ | C.Implicit -> + | C.Cast _ | C.Implicit -> raise (Impossible 2) (* we don't trust our whd ;-) *) | _ -> let outtype' = reduceaux context [] outtype in @@ -334,7 +331,6 @@ let reduce context = exception WrongShape;; exception AlreadySimplified;; -exception WhatShouldIDo;; (*CSC: I fear it is still weaker than Coq's one. For example, Coq is *) (*CSCS: able to simpl (foo (S n) (S n)) to (foo (S O) n) where *) @@ -423,7 +419,8 @@ let simpl context = (* superfluous *) aux (he::rev_constant_args) tl (S.subst he t) end - | C.LetIn (_,_,_) -> raise WhatShouldIDo (*CSC: ?????????? *) + | C.LetIn (_,s,t) -> + aux rev_constant_args l (S.subst s t) | C.Fix (i,fl) as t -> let tys = List.map (function (name,_,ty,_) -> @@ -483,7 +480,6 @@ let simpl context = | C.CurrentProof (_,_,body,_) -> reduceaux context l body | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition ) - | C.Abst _ as t -> t (*CSC l should be empty ????? *) | C.MutInd (uri,_,_) as t -> if l = [] then t else C.Appl (t::l) | C.MutConstruct (uri,_,_,_) as t -> if l = [] then t else C.Appl (t::l) | C.MutCase (mutind,cookingsno,i,outtype,term,pl) -> @@ -543,7 +539,7 @@ let simpl context = eat_first (num_to_eat,tl) in reduceaux context (ts@l) (List.nth pl (j-1)) - | C.Abst _ | C.Cast _ | C.Implicit -> + | C.Cast _ | C.Implicit -> raise (Impossible 2) (* we don't trust our whd ;-) *) | _ -> let outtype' = reduceaux context [] outtype in