X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_procedural%2FproceduralTypes.ml;h=d505a8b152ebdc73cc5d362a2f2c80bee8747cec;hb=298868e07163c21863d542136733d24bfbec2482;hp=5e1bc3a24add64ceb4fe31766a8f5d5c828c0611;hpb=3b8d99d5fdb79a5d979a8e200a4a4307fe362009;p=helm.git diff --git a/helm/software/components/acic_procedural/proceduralTypes.ml b/helm/software/components/acic_procedural/proceduralTypes.ml index 5e1bc3a24..d505a8b15 100644 --- a/helm/software/components/acic_procedural/proceduralTypes.ml +++ b/helm/software/components/acic_procedural/proceduralTypes.ml @@ -54,6 +54,7 @@ let list_init f i = (****************************************************************************) +type flavour = Cic.object_flavour type name = string option type hyp = string type what = Cic.annterm @@ -64,9 +65,10 @@ type note = string type where = (hyp * name) option type inferred = Cic.annterm type pattern = Cic.annterm +type body = Cic.annterm option type step = Note of note - | Theorem of name * what * note + | Statement of flavour * name * what * body * note | Qed of note | Id of note | Intros of count option * name list * note @@ -99,9 +101,9 @@ let mk_notenote str a = let mk_thnote str a = if str = "" then a else mk_note "" :: mk_note str :: a -let mk_theorem name t = +let mk_statement flavour name t v = let name = match name with Some name -> name | None -> assert false in - let obj = N.Theorem (`Theorem, name, t, None) in + let obj = N.Theorem (flavour, name, t, v) in G.Executable (floc, G.Command (floc, G.Obj (floc, obj))) let mk_qed = @@ -134,8 +136,9 @@ let mk_letin name what punctation = let mk_rewrite direction what where pattern punctation = let direction = if direction then `RightToLeft else `LeftToRight in let pattern, rename = match where with - | None -> (None, [], Some pattern), [] - | Some (premise, name) -> (None, [premise, pattern], None), [name] + | None -> (None, [], Some pattern), [] + | Some (premise, Some name) -> (None, [premise, pattern], None), [Some name] + | Some (premise, None) -> (None, [premise, pattern], None), [] in let tactic = G.Rewrite (floc, direction, what, pattern, rename) in mk_tactic tactic punctation @@ -180,22 +183,22 @@ let mk_vb = G.Shift floc (* rendering ****************************************************************) let rec render_step sep a = function - | Note s -> mk_notenote s a - | Theorem (n, t, s) -> mk_theorem n t :: mk_thnote s a - | Qed s -> mk_qed :: 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 - | LetIn (n, t, s) -> mk_letin n t sep :: mk_tacnote s a - | Rewrite (b, t, w, e, s) -> mk_rewrite b t w e sep :: mk_tacnote s a - | Elim (t, xu, e, s) -> mk_elim t xu e sep :: mk_tacnote s a - | Apply (t, s) -> mk_apply t sep :: mk_tacnote s a - | Change (t, _, w, e, s) -> mk_change t w e sep :: mk_tacnote s a - | Clear (ns, s) -> mk_clear ns sep :: mk_tacnote s a - | 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) -> + | Note s -> mk_notenote s a + | Statement (f, n, t, v, s) -> mk_statement f n t v :: mk_thnote s a + | Qed s -> mk_qed :: 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 + | LetIn (n, t, s) -> mk_letin n t sep :: mk_tacnote s a + | Rewrite (b, t, w, e, s) -> mk_rewrite b t w e sep :: mk_tacnote s a + | Elim (t, xu, e, s) -> mk_elim t xu e sep :: mk_tacnote s a + | Apply (t, s) -> mk_apply t sep :: mk_tacnote s a + | Change (t, _, w, e, s) -> mk_change t w e sep :: mk_tacnote s a + | Clear (ns, s) -> mk_clear ns sep :: mk_tacnote s a + | 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) -> 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 @@ -216,7 +219,7 @@ let render_steps a = render_steps mk_dot a let rec count_step a = function | Note _ - | Theorem _ + | Statement _ | Qed _ -> a | Branch (pps, _) -> List.fold_left count_steps a pps | _ -> succ a @@ -225,7 +228,7 @@ and count_steps a = List.fold_left count_step a let rec count_node a = function | Note _ - | Theorem _ + | Statement _ | Qed _ | Id _ | Intros _