X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic%2Fdeannotate.ml;h=ec98b9774214bd6b684f42813711225812ad77ec;hb=8f89cdd08d9ee0a243cf84201bf42e5503759ee3;hp=00d4854db8806f7f8dbafa8d45a118548978ebe1;hpb=5a92117eeff70048d29e91ba24e113155d956e1b;p=helm.git diff --git a/helm/ocaml/cic/deannotate.ml b/helm/ocaml/cic/deannotate.ml index 00d4854db..ec98b9774 100644 --- a/helm/ocaml/cic/deannotate.ml +++ b/helm/ocaml/cic/deannotate.ml @@ -27,33 +27,41 @@ let expect_possible_parameters = ref false;; exception NotExpectingPossibleParameters;; +(* converts annotated terms into cic terms (forgetting ids and names) *) let rec deannotate_term = let module C = Cic in function - C.ARel (_,_,n,_) -> C.Rel n - | C.AVar (_,_,uri) -> C.Var uri - | C.AMeta (_,_,n) -> C.Meta n - | C.ASort (_,_,s) -> C.Sort s + C.ARel (_,n,_) -> C.Rel n + | C.AVar (_,uri) -> C.Var uri + | C.AMeta (_,n, l) -> + let l' = + List.map + (function + None -> None + | Some at -> Some (deannotate_term at) + ) l + in + C.Meta (n, l') + | C.ASort (_,s) -> C.Sort s | C.AImplicit _ -> C.Implicit - | C.ACast (_,_,va,ty) -> C.Cast (deannotate_term va, deannotate_term ty) - | C.AProd (_,_,name,so,ta) -> + | C.ACast (_,va,ty) -> C.Cast (deannotate_term va, deannotate_term ty) + | C.AProd (_,name,so,ta) -> C.Prod (name, deannotate_term so, deannotate_term ta) - | C.ALambda (_,_,name,so,ta) -> + | C.ALambda (_,name,so,ta) -> C.Lambda (name, deannotate_term so, deannotate_term ta) - | C.ALetIn (_,_,name,so,ta) -> + | C.ALetIn (_,name,so,ta) -> C.LetIn (name, deannotate_term so, deannotate_term ta) - | C.AAppl (_,_,l) -> C.Appl (List.map deannotate_term l) - | C.AConst (_,_,uri, cookingsno) -> C.Const (uri, cookingsno) - | C.AAbst (_,_,uri) -> C.Abst uri - | C.AMutInd (_,_,uri,cookingsno,i) -> C.MutInd (uri,cookingsno,i) - | C.AMutConstruct (_,_,uri,cookingsno,i,j) -> + | C.AAppl (_,l) -> C.Appl (List.map deannotate_term l) + | C.AConst (_,uri, cookingsno) -> C.Const (uri, cookingsno) + | C.AMutInd (_,uri,cookingsno,i) -> C.MutInd (uri,cookingsno,i) + | C.AMutConstruct (_,uri,cookingsno,i,j) -> C.MutConstruct (uri,cookingsno,i,j) - | C.AMutCase (_,_,uri,cookingsno,i,outtype,te,pl) -> + | C.AMutCase (_,uri,cookingsno,i,outtype,te,pl) -> C.MutCase (uri,cookingsno,i,deannotate_term outtype, deannotate_term te, List.map deannotate_term pl) - | C.AFix (_,_,funno,ifl) -> + | C.AFix (_,funno,ifl) -> C.Fix (funno, List.map deannotate_inductiveFun ifl) - | C.ACoFix (_,_,funno,ifl) -> + | C.ACoFix (_,funno,ifl) -> C.CoFix (funno, List.map deannotate_coinductiveFun ifl) and deannotate_inductiveFun (name,index,ty,bo) = @@ -71,7 +79,7 @@ let deannotate_inductiveType (name, isinductive, arity, cons) = let deannotate_obj = let module C = Cic in function - C.ADefinition (_, _, id, bo, ty, params) -> + C.ADefinition (_, id, bo, ty, params) -> (match params with C.Possible params -> if !expect_possible_parameters then @@ -81,18 +89,33 @@ let deannotate_obj = | C.Actual params -> C.Definition (id, deannotate_term bo, deannotate_term ty, params) ) - | C.AAxiom (_, _, id, ty, params) -> + | C.AAxiom (_, id, ty, params) -> C.Axiom (id, deannotate_term ty, params) - | C.AVariable (_, _, name, bo, ty) -> + | C.AVariable (_, name, bo, ty) -> C.Variable (name, (match bo with None -> None | Some bo -> Some (deannotate_term bo)), deannotate_term ty) - | C.ACurrentProof (_, _, name, conjs, bo, ty) -> + | C.ACurrentProof (_, name, conjs, bo, ty) -> C.CurrentProof ( - name, List.map (fun (id,con) -> (id,deannotate_term con)) conjs, - deannotate_term bo, deannotate_term ty + name, + List.map + (function + (_,id,acontext,con) -> + let context = + List.map + (function + _,Some (n,(C.ADef at)) -> + Some (n,(C.Def (deannotate_term at))) + | _,Some (n,(C.ADecl at)) -> + Some (n,(C.Decl (deannotate_term at))) + | _,None -> None + ) acontext + in + (id,context,deannotate_term con) + ) conjs, + deannotate_term bo,deannotate_term ty ) - | C.AInductiveDefinition (_, _, tys, params, parno) -> + | C.AInductiveDefinition (_, tys, params, parno) -> C.InductiveDefinition ( List.map deannotate_inductiveType tys, params, parno) ;;