X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FgrafiteAst.ml;h=cba5acd1f8322dd0d3d30dc64f10f9bad3118d3e;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=82d90498989cabec1ac8209a22b6042135649e8f;hpb=1ca0ec89cfc2c3f85af95d5b1bdad07597d976bd;p=helm.git diff --git a/helm/ocaml/cic_notation/grafiteAst.ml b/helm/ocaml/cic_notation/grafiteAst.ml index 82d904989..cba5acd1f 100644 --- a/helm/ocaml/cic_notation/grafiteAst.ml +++ b/helm/ocaml/cic_notation/grafiteAst.ml @@ -26,23 +26,30 @@ module Ast = CicNotationPt type direction = [ `LeftToRight | `RightToLeft ] -type 'term reduction_kind = - [ `Normalize | `Reduce | `Simpl | `Unfold of 'term option | `Whd ] type loc = Ast.location -type ('term, 'ident) pattern = 'term option * ('ident * 'term) list * 'term +type ('term, 'lazy_term, 'ident) pattern = + 'lazy_term option * ('ident * 'term) list * 'term type ('term, 'ident) type_spec = | Ident of 'ident | Type of UriManager.uri * int -type ('term, 'ident) tactic = +type reduction = + [ `Normalize + | `Reduce + | `Simpl + | `Unfold of CicNotationPt.term option + | `Whd ] + +type ('term, 'lazy_term, 'reduction, 'ident) tactic = | Absurd of loc * 'term | Apply of loc * 'term | Assumption of loc - | Auto of loc * int option * int option * string option (* depth, width, paramodulation ALB *) - | Change of loc * ('term,'ident) pattern * 'term + | Auto of loc * int option * int option * string option * string option + (* depth, width, paramodulation, full *) (* ALB *) + | Change of loc * ('term, 'lazy_term, 'ident) pattern * 'lazy_term | Clear of loc * 'ident | ClearBody of loc * 'ident | Compare of loc * 'term @@ -57,10 +64,10 @@ type ('term, 'ident) tactic = | Exact of loc * 'term | Exists of loc | Fail of loc - | Fold of loc * 'term reduction_kind * 'term * ('term, 'ident) pattern + | Fold of loc * 'reduction * 'lazy_term * ('term, 'lazy_term, 'ident) pattern | Fourier of loc | FwdSimpl of loc * string * 'ident list - | Generalize of loc * ('term, 'ident) pattern * 'ident option + | Generalize of loc * ('term, 'lazy_term, 'ident) pattern * 'ident option | Goal of loc * int (* change current goal, argument is goal number 1-based *) | IdTac of loc | Injection of loc * 'term @@ -68,10 +75,11 @@ type ('term, 'ident) tactic = | LApply of loc * int option * 'term list * 'term * 'ident option | Left of loc | LetIn of loc * 'term * 'ident - | Reduce of loc * 'term reduction_kind * ('term, 'ident) pattern + | Reduce of loc * 'reduction * ('term, 'lazy_term, 'ident) pattern | Reflexivity of loc - | Replace of loc * ('term, 'ident) pattern * 'term - | Rewrite of loc * direction * 'term * ('term, 'ident) pattern + | Replace of loc * ('term, 'lazy_term, 'ident) pattern * 'lazy_term + | Rewrite of loc * direction * 'term * + ('term, 'lazy_term, 'ident) pattern | Right of loc | Ring of loc | Split of loc @@ -116,8 +124,7 @@ type obj = | Inductive of (string * Ast.term) list * Ast.term inductive_type list (** parameters, list of loc * mutual inductive types *) - | Theorem of thm_flavour * string * Ast.term * - Ast.term option + | Theorem of thm_flavour * string * Ast.term * Ast.term option (** flavour, name, type, body * - name is absent when an unnamed theorem is being proved, tipically in * interactive usage @@ -126,6 +133,19 @@ type obj = *) | Record of (string * Ast.term) list * string * Ast.term * (string * Ast.term) list + (** left parameters, name, type, fields *) + +type metadata = + | Dependency of string (* baseuri without trailing slash *) + | Baseuri of string + +let compare_metadata = Pervasives.compare + +let eq_metadata = (=) + +(** To be increased each time the command type below changes, used for "safe" + * marshalling *) +let magic = 2 type ('term,'obj) command = | Default of loc * string * UriManager.uri list @@ -148,33 +168,82 @@ type ('term,'obj) command = Ast.cic_appl_pattern (* description (i.e. id), symbol, arg pattern, appl pattern *) + | Metadata of loc * metadata + (* DEBUGGING *) | Dump of loc (* dump grammar on stdout *) (* DEBUGGING *) | Render of loc * UriManager.uri (* render library object *) -type ('term, 'ident) tactical = - | Tactic of loc * ('term, 'ident) tactic - | Do of loc * int * ('term, 'ident) tactical - | Repeat of loc * ('term, 'ident) tactical - | Seq of loc * ('term, 'ident) tactical list (* sequential composition *) - | Then of loc * ('term, 'ident) tactical * ('term, 'ident) tactical list - | First of loc * ('term, 'ident) tactical list - (* try a sequence of loc * tacticals until one succeeds, fail otherwise *) - | Try of loc * ('term, 'ident) tactical (* try a tactical and mask failures *) - | Solve of loc * ('term, 'ident) tactical list - - -type ('term, 'obj, 'ident) code = +(* composed magic: term + command magics. No need to change this value *) +let magic = magic + 10000 * CicNotationPt.magic + +let reash_cmd_uris = + let reash_uri uri = UriManager.uri_of_string (UriManager.string_of_uri uri) in + function + | Default (loc, name, uris) -> + let uris = List.map reash_uri uris in + Default (loc, name, uris) + | Interpretation (loc, dsc, args, cic_appl_pattern) -> + let rec aux = + function + | CicNotationPt.UriPattern uri -> + CicNotationPt.UriPattern (reash_uri uri) + | CicNotationPt.ApplPattern args -> + CicNotationPt.ApplPattern (List.map aux args) + | CicNotationPt.VarPattern _ + | CicNotationPt.ImplicitPattern as pat -> pat + in + let appl_pattern = aux cic_appl_pattern in + Interpretation (loc, dsc, args, appl_pattern) + | cmd -> cmd + +type ('term, 'lazy_term, 'reduction, 'ident) tactical = + | Tactic of loc * ('term, 'lazy_term, 'reduction, 'ident) tactic + | Do of loc * int * ('term, 'lazy_term, 'reduction, 'ident) tactical + | Repeat of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical + | Seq of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list + (* sequential composition *) + | Then of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical * + ('term, 'lazy_term, 'reduction, 'ident) tactical list + | First of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list + (* try a sequence of loc * tactical until one succeeds, fail otherwise *) + | Try of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical + (* try a tactical and mask failures *) + | Solve of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical list + + | Dot of loc + | Semicolon of loc + | Branch of loc + | Shift of loc + | Pos of loc * int + | Merge of loc + | Focus of loc * int list + | Unfocus of loc + | Skip of loc + +let is_punctuation = + function + | Dot _ | Semicolon _ | Branch _ | Shift _ | Merge _ | Pos _ -> true + | _ -> false + +type ('term, 'lazy_term, 'reduction, 'obj, 'ident) code = | Command of loc * ('term,'obj) command | Macro of loc * 'term macro - | Tactical of loc * ('term, 'ident) tactical + | Tactical of loc * ('term, 'lazy_term, 'reduction, 'ident) tactical + * ('term, 'lazy_term, 'reduction, 'ident) tactical option(* punctuation *) -type ('term, 'obj, 'ident) comment = +type ('term, 'lazy_term, 'reduction, 'obj, 'ident) comment = | Note of loc * string - | Code of loc * ('term, 'obj, 'ident) code + | Code of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) code -type ('term, 'obj, 'ident) statement = - | Executable of loc * ('term, 'obj, 'ident) code - | Comment of loc * ('term, 'obj, 'ident) comment +type ('term, 'lazy_term, 'reduction, 'obj, 'ident) statement = + | Executable of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) code + | Comment of loc * ('term, 'lazy_term, 'reduction, 'obj, 'ident) comment + + (* statements meaningful for matitadep *) +type dependency = + | IncludeDep of string + | BaseuriDep of string + | UriDep of UriManager.uri