X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Focaml%2Fcic_proof_checking%2FcicReductionMachine.ml;h=dbe22fb3e6ceb107b7d77d7af1d57fecb2e213df;hb=b38de2d3fa8bbe346c59c18bbeb889f29e493f63;hp=30b688264776e8f2c77816fdf52e5ece0577daa5;hpb=bac72fcaa876137ab7a5630e0c1badc2a627dce8;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicReductionMachine.ml b/helm/ocaml/cic_proof_checking/cicReductionMachine.ml index 30b688264..dbe22fb3e 100644 --- a/helm/ocaml/cic_proof_checking/cicReductionMachine.ml +++ b/helm/ocaml/cic_proof_checking/cicReductionMachine.ml @@ -23,6 +23,8 @@ * http://cs.unibo.it/helm/. *) +(* TODO unify exceptions *) + exception CicReductionInternalError;; exception WrongUriToInductiveDefinition;; exception Impossible of int;; @@ -39,10 +41,7 @@ let debug t env s = CicPp.ppobj (C.Variable ("DEBUG", None, t, [])) ^ "\n" ^ i in if !fdebug = 0 then - begin - print_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "") ; - flush stdout - end + prerr_endline (s ^ "\n" ^ List.fold_right debug_aux (t::env) "") ;; module type Strategy = @@ -375,7 +374,7 @@ prerr_endline ("%%%%%UWVAR " ^ String.concat " ; " (List.map (function (uri,t) - in C.Meta (i, l') | C.Sort _ as t -> t - | C.Implicit as t -> t + | C.Implicit _ as t -> t | C.Cast (te,ty) -> C.Cast (unwind_aux m te, unwind_aux m ty) (*CSC ???*) | C.Prod (n,s,t) -> C.Prod (n, unwind_aux m s, unwind_aux (m + 1) t) | C.Lambda (n,s,t) -> C.Lambda (n, unwind_aux m s, unwind_aux (m + 1) t) @@ -515,7 +514,7 @@ if List.mem uri params then prerr_endline "---- OK2" ; match List.nth context (n - 1 - k) with None -> assert false | Some (_,C.Decl _) -> None - | Some (_,C.Def x) -> Some (S.lift (n - k) x) + | Some (_,C.Def (x,_)) -> Some (S.lift (n - k) x) end with _ -> None @@ -547,7 +546,7 @@ if List.mem uri params then prerr_endline "---- OK2" ; let t' = unwind k e ens t in if s = [] then t' else C.Appl (t'::(RS.from_stack_list ~unwind s)) | (k, e, _, (C.Sort _ as t), s) -> t (* s should be empty *) - | (k, e, _, (C.Implicit as t), s) -> t (* s should be empty *) + | (k, e, _, (C.Implicit _ as t), s) -> t (* s should be empty *) | (k, e, ens, (C.Cast (te,ty) as t), s) -> reduce (k, e, ens, te, s) (* s should be empty *) | (k, e, ens, (C.Prod _ as t), s) -> @@ -558,7 +557,7 @@ if List.mem uri params then prerr_endline "---- OK2" ; | (k, e, ens, (C.LetIn (_,m,t) as t'), s) -> let m' = RS.compute_to_env ~reduce ~unwind k e ens m in reduce (k+1, m'::e, ens, t, s) - | (_, _, _, C.Appl [], _) -> raise (Impossible 1) + | (_, _, _, C.Appl [], _) -> assert false | (k, e, ens, C.Appl (he::tl), s) -> let tl' = List.map @@ -655,7 +654,7 @@ if List.mem uri params then prerr_endline "---- OK2" ; in (* ts are already unwinded because they are a sublist of tl *) reduce (k, e, ens, (List.nth pl (j-1)), (RS.to_stack_list ts)@s) - | C.Cast _ | C.Implicit -> + | C.Cast _ | C.Implicit _ -> raise (Impossible 2) (* we don't trust our whd ;-) *) | _ -> let t' = unwind k e ens t in @@ -765,7 +764,7 @@ module R = Reduction ClosuresOnStackByValueFromEnvOrEnsStrategy;; module R = Reduction ClosuresOnStackByValueFromEnvOrEnsByNameOnConstantsStrategy;; *) -module R = Reduction ClosuresOnStackByValueFromEnvOrEnsStrategy;; +module R = Reduction(ClosuresOnStackByValueFromEnvOrEnsStrategy);; let whd = R.whd;; @@ -805,11 +804,14 @@ let are_convertible = ) true l1 l2 | (C.Sort s1, C.Sort s2) -> true (*CSC da finire con gli universi *) | (C.Prod (name1,s1,t1), C.Prod(_,s2,t2)) -> - aux context s1 s2 && aux ((Some (name1, (C.Decl s1)))::context) t1 t2 + aux context s1 s2 && + aux ((Some (name1, (C.Decl s1)))::context) t1 t2 | (C.Lambda (name1,s1,t1), C.Lambda(_,s2,t2)) -> - aux context s1 s2 && aux ((Some (name1, (C.Decl s1)))::context) t1 t2 + aux context s1 s2 && + aux ((Some (name1, (C.Decl s1)))::context) t1 t2 | (C.LetIn (name1,s1,t1), C.LetIn(_,s2,t2)) -> - aux context s1 s2 && aux ((Some (name1, (C.Def s1)))::context) t1 t2 + aux context s1 s2 && + aux ((Some (name1, (C.Def (s1,None))))::context) t1 t2 | (C.Appl l1, C.Appl l2) -> (try List.fold_right2 (fun x y b -> aux context x y && b) l1 l2 true @@ -875,8 +877,8 @@ let are_convertible = b && aux context ty1 ty2 && aux (tys@context) bo1 bo2) fl1 fl2 true | (C.Cast _, _) | (_, C.Cast _) - | (C.Implicit, _) | (_, C.Implicit) -> - raise (Impossible 3) (* we don't trust our whd ;-) *) + | (C.Implicit _, _) | (_, C.Implicit _) -> + assert false | (_,_) -> false end in