X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_procedural%2FproceduralTypes.ml;h=55516bf34aebd02241badb49501372493227f511;hb=14e2489ae86ecb6467fe9a7ba3b742a8d53c47ea;hp=9bb2e576c41d71f0c4e3fae06b11f64a8108af09;hpb=89519c7b52e06304a94019dd528925300380cdc0;p=helm.git diff --git a/helm/software/components/acic_procedural/proceduralTypes.ml b/helm/software/components/acic_procedural/proceduralTypes.ml index 9bb2e576c..55516bf34 100644 --- a/helm/software/components/acic_procedural/proceduralTypes.ml +++ b/helm/software/components/acic_procedural/proceduralTypes.ml @@ -74,6 +74,7 @@ type step = Note of note | Statement of flavour * name * what * body * note | Qed of note | Id of note + | Exact of what * note | Intros of count option * name list * note | Cut of name * what * note | LetIn of name * what * note @@ -85,6 +86,7 @@ type step = Note of note | Clear of hyp list * note | ClearBody of hyp * note | Branch of step list list * note + | Reflexivity of note (* annterm constructors *****************************************************) @@ -166,6 +168,10 @@ let mk_id punctation = let tactic = G.IdTac floc in mk_tactic tactic punctation +let mk_exact t punctation = + let tactic = G.Exact (floc, t) in + mk_tactic tactic punctation + let mk_intros xi xids punctation = let tactic = G.Intros (floc, (xi, xids)) in mk_tactic tactic punctation @@ -201,7 +207,7 @@ let mk_cases what pattern punctation = mk_tactic tactic punctation let mk_apply t punctation = - let tactic = G.ApplyP (floc, t) in + let tactic = G.Apply (floc, t) in mk_tactic tactic punctation let mk_change t where pattern punctation = @@ -220,6 +226,10 @@ let mk_clearbody id punctation = let tactic = G.ClearBody (floc, id) in mk_tactic tactic punctation +let mk_reflexivity punctation = + let tactic = G.Reflexivity floc in + mk_tactic tactic punctation + let mk_ob = let punctation = G.Branch floc in mk_punctation punctation @@ -239,6 +249,7 @@ let rec render_step sep a = function | Statement (f, n, t, v, s) -> mk_statement f n t v :: mk_thnote s a | Inductive (lps, ts, s) -> mk_inductive lps ts :: mk_thnote s a | Qed s -> mk_qed :: mk_tacnote s a + | Exact (t, s) -> mk_exact t sep :: mk_tacnote s a | Id s -> mk_id sep :: mk_tacnote s a | Intros (c, ns, s) -> mk_intros c ns sep :: mk_tacnote s a | Cut (n, t, s) -> mk_cut n t sep :: mk_tacnote s a @@ -252,10 +263,11 @@ let rec render_step sep a = function | ClearBody (n, s) -> mk_clearbody n sep :: mk_tacnote s a | Branch ([], s) -> a | Branch ([ps], s) -> render_steps sep a ps - | Branch (ps :: pss, s) -> + | Branch (ps :: pss, s) -> let a = mk_ob :: mk_tacnote s a in let a = List.fold_left (render_steps mk_vb) a (List.rev pss) in mk_punctation sep :: render_steps mk_cb a ps + | Reflexivity s -> mk_reflexivity sep :: mk_tacnote s a and render_steps sep a = function | [] -> a @@ -273,24 +285,40 @@ let render_steps a = render_steps mk_dot a let rec count_step a = function | Note _ - | Statement _ - | Qed _ -> a - | Branch (pps, _) -> List.fold_left count_steps a pps - | _ -> succ a + | Statement _ + | Inductive _ + | Qed _ -> a +(* level A0 *) + | Branch (pps, _) -> List.fold_left count_steps a pps + | Clear _ + | ClearBody _ + | Id _ + | Intros (Some 0, [], _) +(* leval A1 *) + | Exact _ +(* level B1 *) + | Cut _ + | LetIn _ +(* level B2 *) + | Change _ -> a +(* level C *) + | _ -> succ a and count_steps a = List.fold_left count_step a -let count = I.count_nodes ~implicit:false +let count = I.count_nodes ~meta:false let rec count_node a = function | Note _ | Inductive _ | Statement _ - | Qed _ + | Qed _ + | Reflexivity _ | Id _ | Intros _ | Clear _ | ClearBody _ -> a + | Exact (t, _) | Cut (_, t, _) | LetIn (_, t, _) | Apply (t, _) -> count a (H.cic t) @@ -301,3 +329,25 @@ let rec count_node a = function | Branch (ss, _) -> List.fold_left count_nodes a ss and count_nodes a = List.fold_left count_node a + +(* helpers ******************************************************************) + +let rec note_of_step = function + | Note s + | Statement (_, _, _, _, s) + | Inductive (_, _, s) + | Qed s + | Exact (_, s) + | Id s + | Intros (_, _, s) + | Cut (_, _, s) + | LetIn (_, _, s) + | Rewrite (_, _, _, _, s) + | Elim (_, _, _, s) + | Cases (_, _, s) + | Apply (_, s) + | Change (_, _, _, _, s) + | Clear (_, s) + | ClearBody (_, s) + | Reflexivity s + | Branch (_, s) -> s