X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FgrafiteAst.ml;h=cba5acd1f8322dd0d3d30dc64f10f9bad3118d3e;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=e845e575557cf9c0a86cf13b82baf3a2d60697dc;hpb=e20f3963028a966fc93ba0d611c4aa8341d20e2c;p=helm.git diff --git a/helm/ocaml/cic_notation/grafiteAst.ml b/helm/ocaml/cic_notation/grafiteAst.ml index e845e5755..cba5acd1f 100644 --- a/helm/ocaml/cic_notation/grafiteAst.ml +++ b/helm/ocaml/cic_notation/grafiteAst.ml @@ -23,19 +23,33 @@ * http://helm.cs.unibo.it/ *) +module Ast = CicNotationPt + type direction = [ `LeftToRight | `RightToLeft ] -type reduction_kind = [ `Reduce | `Simpl | `Whd | `Normalize ] -type loc = CicNotationPt.location +type loc = Ast.location + +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) pattern = 'term option * ('ident * 'term) list * 'term +type reduction = + [ `Normalize + | `Reduce + | `Simpl + | `Unfold of CicNotationPt.term option + | `Whd ] -type ('term, 'ident) tactic = +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 (* depth, width *) - | 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 @@ -43,17 +57,17 @@ type ('term, 'ident) tactic = | Contradiction of loc | Cut of loc * 'ident option * 'term | DecideEquality of loc - | Decompose of loc * 'term + | Decompose of loc * ('term, 'ident) type_spec list * 'ident * 'ident list | Discriminate of loc * 'term | Elim of loc * 'term * 'term option * int option * 'ident list | ElimType of loc * 'term * 'term option * int option * 'ident list | Exact of loc * 'term | Exists of loc | Fail of loc - | Fold of loc * 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 @@ -61,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 * 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 @@ -106,19 +121,31 @@ type alias_spec = | Number_alias of int * string (* instance no, description *) type obj = - | Inductive of (string * CicNotationPt.term) list * - CicNotationPt.term inductive_type list + | Inductive of (string * Ast.term) list * + Ast.term inductive_type list (** parameters, list of loc * mutual inductive types *) - | Theorem of thm_flavour * string * CicNotationPt.term * CicNotationPt.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 * - body is present when its given along with the command, otherwise it * will be given in proof editing mode using the tactical language *) - | Record of - (string * CicNotationPt.term) list * string * CicNotationPt.term * - (string * CicNotationPt.term) list + | 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 @@ -133,41 +160,90 @@ type ('term,'obj) command = | Alias of loc * alias_spec (** parameters, name, type, fields *) | Obj of loc * 'obj - | Notation of loc * CicNotationPt.term * Gramext.g_assoc option * int option * - CicNotationPt.term - (* level 1 pattern, associativity, precedence, level 2 pattern *) + | Notation of loc * direction option * Ast.term * Gramext.g_assoc * + int * Ast.term + (* direction, l1 pattern, associativity, precedence, l2 pattern *) | Interpretation of loc * - string * (string * CicNotationPt.argument_pattern list) * - CicNotationPt.cic_appl_pattern + string * (string * Ast.argument_pattern list) * + 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