From: Claudio Sacerdoti Coen Date: Fri, 26 Apr 2002 10:34:57 +0000 (+0000) Subject: Old and dead code from the previous implementation removed. X-Git-Tag: V_0_3_0_debian_8~125 X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=commitdiff_plain;h=faf01084c13ccd731d7040fadb96caa0a2aa0019 Old and dead code from the previous implementation removed. --- diff --git a/helm/ocaml/cic_unification/cicUnification.ml b/helm/ocaml/cic_unification/cicUnification.ml index 5b1d3ce1b..a01f9a9b8 100644 --- a/helm/ocaml/cic_unification/cicUnification.ml +++ b/helm/ocaml/cic_unification/cicUnification.ml @@ -24,7 +24,6 @@ *) exception UnificationFailed;; -(*CSC: Vecchia unificazione: exception Impossible;;*) exception Free;; exception OccurCheck;; @@ -81,48 +80,6 @@ let delift n = deliftaux 1 ;; -(* Questa funzione non serve piu'... per il momento la lascio *) -(* -let closed_up_to_n n m = - let rec closed_aux k = - let module C = Cic in - function - C.Rel m -> if m > k then () else raise Free - | C.Var _ - | C.Meta _ (* we assume Meta are closed up to k; note that during - meta-unfolding we shall need to properly lift the - "body" of Metavariables *) - | C.Sort _ - | C.Implicit -> () - | C.Cast (te,ty) -> closed_aux k te; closed_aux k ty - | C.Prod (n,s,t) -> closed_aux k s; closed_aux (k+1) t - | C.Lambda (n,s,t) -> closed_aux k s; closed_aux (k+1) t - | C.LetIn (n,s,t) -> closed_aux k s; closed_aux (k+1) t - | C.Appl l -> List.iter (closed_aux k) l - | C.Const _ - | C.Abst _ - | C.MutInd _ - | C.MutConstruct _ -> () - | C.MutCase (sp,cookingsno,i,outty,t,pl) -> - closed_aux k outty; closed_aux k t; - List.iter (closed_aux k) pl - | C.Fix (i, fl) -> - let len = List.length fl in - List.iter - (fun (name, i, ty, bo) -> closed_aux k ty; closed_aux (k+len) bo) - fl - | C.CoFix (i, fl) -> - let len = List.length fl in - List.iter - (fun (name, ty, bo) -> closed_aux k ty; closed_aux (k+len) bo) - fl - in - if n = 0 then true - else - try closed_aux n m; true - with Free -> false -;; *) - (* NUOVA UNIFICAZIONE *) (* A substitution is a (int * Cic.term) list that associates a metavariable i with its body. @@ -220,95 +177,6 @@ let fo_unif_new metasenv context t1 t2 = | (_,_) -> raise UnificationFailed in fo_unif_aux [] 0 t1 t2;; -(* VECCHIA UNIFICAZIONE -- molto piu' bella, alas *) -(* -let fo_unif_mgu k t1 t2 mgu = - let module C = Cic in - let module R = CicReduction in - let module S = CicSubstitution in - let rec deref n = match mgu.(n) with - C.Meta m as t -> if n = m then t else (deref m) - | t -> t - in - let rec fo_unif k t1 t2 = match (t1, t2) with - (* aggiungere l'unificazione sui tipi in caso di istanziazione *) - (C.Meta n, C.Meta m) -> if n == m then () else - let t1' = deref n in - let t2' = deref m in - (* deref of metavariables ARE already delifted *) - (match (t1',t2') with - (C.Meta n, C.Meta m) -> if n = m then () else - if n < m then mgu.(m) <- t1' else - if n > m then mgu.(n) <- t2' - | (C.Meta n, _) -> mgu.(n) <- t2' - | (_, C.Meta m) -> mgu.(m) <- t1' - | (_,_) -> fo_unif k t1' t2') - | (C.Meta n, _) -> let t1' = deref n in - let t2' = try delift k t2 - with Free -> raise UnificationFailed in - (match t1' with - C.Meta n -> mgu.(n) <- t2' - | _ -> fo_unif k t1' t2') - | (_, C.Meta m) -> let t2' = deref m in - let t1' = try delift k t1 - with Free -> raise UnificationFailed in - (match t2' with - C.Meta m -> mgu.(m) <- t1' - | _ -> fo_unif k t1' t2') - | (C.Rel _, _) - | (_, C.Rel _) - | (C.Var _, _) - | (_, C.Var _) - | (C.Sort _ ,_) - | (_, C.Sort _) - | (C.Implicit, _) - | (_, C.Implicit) -> if R.are_convertible t1 t2 then () - else raise UnificationFailed - | (C.Cast (te,ty), _) -> fo_unif k te t2 - | (_, C.Cast (te,ty)) -> fo_unif k t1 te - | (C.Prod (_,s1,t1), C.Prod (_,s2,t2)) -> fo_unif k s1 s2; - fo_unif (k+1) t1 t2 - | (C.Lambda (_,s1,t1), C.Lambda (_,s2,t2)) -> fo_unif k s1 s2; - fo_unif (k+1) t1 t2 - | (C.LetIn (_,s1,t1), _) -> fo_unif k (S.subst s1 t1) t2 - | (_, C.LetIn (_,s2,t2)) -> fo_unif k t1 (S.subst s2 t2) - | (C.Appl (h1::l1), C.Appl (h2::l2)) -> - let lr1 = List.rev l1 in - let lr2 = List.rev l2 in - let rec fo_unif_aux = function - ([],l2) -> ([],l2) - | (l1,[]) -> (l1,[]) - | ((h1::l1),(h2::l2)) -> fo_unif k h1 h2; - fo_unif_aux (l1,l2) - in - (match fo_unif_aux (lr1, lr2) with - ([],[]) -> fo_unif k h1 h2 - | ([],l2) -> fo_unif k h1 (C.Appl (h2::List.rev l2)) - | (l1,[]) -> fo_unif k (C.Appl (h1::List.rev l1)) h2 - | (_,_) -> raise Impossible) - | (C.Const _, _) - | (_, C.Const _) - | (C.Abst _, _) - | (_, C.Abst _) - | (C.MutInd _, _) - | (_, C.MutInd _) - | (C.MutConstruct _, _) - | (_, C.MutConstruct _) -> print_endline "siamo qui"; flush stdout; - if R.are_convertible t1 t2 then () - else raise UnificationFailed - | (C.MutCase (_,_,_,outt1,t1,pl1), C.MutCase (_,_,_,outt2,t2,pl2))-> - fo_unif k outt1 outt2; - fo_unif k t1 t2; - List.iter2 (fo_unif k) pl1 pl2 - | (C.Fix _, _) - | (_, C.Fix _) - | (C.CoFix _, _) - | (_, C.CoFix _) -> if R.are_convertible t1 t2 then () - else raise UnificationFailed - | (_,_) -> raise UnificationFailed - in fo_unif k t1 t2;mgu ;; -*) - (* unwind mgu mark m applies mgu to the term m; mark is an array of integers mark.(n) = 0 if the term has not been unwinded, is 2 if it is under uwinding, and is 1 if it has been succesfully unwinded. Meeting the value 2 during @@ -385,68 +253,6 @@ let unwind subst unwinded t = um_aux 0 t,!unwinded ;; -(* -let unwind_meta mgu mark = - let rec um_aux k = - let module C = Cic in - let module S = CicSubstitution in - function - C.Rel _ as t -> t - | C.Var _ as t -> t - | C.Meta i as t -> if mark.(i)=2 then raise OccurCheck else - if mark.(i)=1 then S.lift k mgu.(i) - else (match mgu.(i) with - C.Meta k as t1 -> if k = i then t - else (mark.(i) <- 2; - mgu.(i) <- (um_aux 0 t1); - mark.(i) <- 1; - S.lift k mgu.(i)) - | _ -> (mark.(i) <- 2; - mgu.(i) <- (um_aux 0 mgu.(i)); - mark.(i) <- 1; - S.lift k mgu.(i))) - | C.Sort _ as t -> t - | C.Implicit as t -> t - | C.Cast (te,ty) -> C.Cast (um_aux k te, um_aux k ty) - | C.Prod (n,s,t) -> C.Prod (n, um_aux k s, um_aux (k+1) t) - | C.Lambda (n,s,t) -> C.Lambda (n, um_aux k s, um_aux (k+1) t) - | C.LetIn (n,s,t) -> C.LetIn (n, um_aux k s, um_aux (k+1) t) - | C.Appl (he::tl) -> - let tl' = List.map (um_aux k) tl in - begin - match um_aux k he with - C.Appl l -> C.Appl (l@tl') - | _ as he' -> C.Appl (he'::tl') - end - | C.Appl _ -> assert false - | 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,outty,t,pl) -> - C.MutCase (sp, cookingsno, i, um_aux k outty, um_aux k t, - List.map (um_aux k) pl) - | C.Fix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, i, ty, bo) -> (name, i, um_aux k ty, um_aux (k+len) bo)) - fl - in - C.Fix (i, liftedfl) - | C.CoFix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, ty, bo) -> (name, um_aux k ty, um_aux (k+len) bo)) - fl - in - C.CoFix (i, liftedfl) - in - um_aux 0 -;; -*) - (* apply_subst_reducing subst (Some (mtr,reductions_no)) t *) (* performs as (apply_subst subst t) until it finds an application of *) (* (META [meta_to_reduce]) that, once unwinding is performed, creates *) @@ -527,84 +333,6 @@ let apply_subst_reducing subst meta_to_reduce t = um_aux 0 t ;; -(* unwind mgu mark mm m applies mgu to the term m; mark is an array of integers -mark.(n) = 0 if the term has not been unwinded, is 2 if it is under uwinding, -and is 1 if it has been succesfully unwinded. Meeting the value 2 during -the computation is an error: occur-check. When the META mm is to be unfolded -and it is applied to something, one-step beta reduction is performed just -after the unfolding. *) - -(* -let unwind_meta_reducing mgu mark meta_to_reduce = - let rec um_aux k = - let module C = Cic in - let module S = CicSubstitution in - function - C.Rel _ as t -> t - | C.Var _ as t -> t - | C.Meta i as t -> if mark.(i)=2 then raise OccurCheck else - if mark.(i)=1 then S.lift k mgu.(i) - else (match mgu.(i) with - C.Meta k as t1 -> if k = i then t - else (mark.(i) <- 2; - mgu.(i) <- (um_aux 0 t1); - mark.(i) <- 1; - S.lift k mgu.(i)) - | _ -> (mark.(i) <- 2; - mgu.(i) <- (um_aux 0 mgu.(i)); - mark.(i) <- 1; - S.lift k mgu.(i))) - | C.Sort _ as t -> t - | C.Implicit as t -> t - | C.Cast (te,ty) -> C.Cast (um_aux k te, um_aux k ty) - | C.Prod (n,s,t) -> C.Prod (n, um_aux k s, um_aux (k+1) t) - | C.Lambda (n,s,t) -> C.Lambda (n, um_aux k s, um_aux (k+1) t) - | C.LetIn (n,s,t) -> C.LetIn (n, um_aux k s, um_aux (k+1) t) - | C.Appl (he::tl) -> - let tl' = List.map (um_aux k) tl in - let t' = - match um_aux k he with - C.Appl l -> C.Appl (l@tl') - | _ as he' -> C.Appl (he'::tl') - in - begin - match t', meta_to_reduce with - (C.Appl (C.Lambda (n,s,t)::he'::tl')),Some mtr - when he = C.Meta mtr -> -(*CSC: Sbagliato!!! Effettua beta riduzione solo del primo argomento - *CSC: mentre dovrebbe farla dei primi n, dove n sono quelli eta-astratti -*) - C.Appl((CicSubstitution.subst he' t)::tl') - | _ -> t' - end - | C.Appl _ -> assert false - | 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,outty,t,pl) -> - C.MutCase (sp, cookingsno, i, um_aux k outty, um_aux k t, - List.map (um_aux k) pl) - | C.Fix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, i, ty, bo) -> (name, i, um_aux k ty, um_aux (k+len) bo)) - fl - in - C.Fix (i, liftedfl) - | C.CoFix (i, fl) -> - let len = List.length fl in - let liftedfl = - List.map - (fun (name, ty, bo) -> (name, um_aux k ty, um_aux (k+len) bo)) - fl - in - C.CoFix (i, liftedfl) - in - um_aux 0 -;; *) - (* UNWIND THE MGU INSIDE THE MGU *) (* let unwind mgu = let mark = Array.make (Array.length mgu) 0 in