X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FgrafiteParser.ml;h=b1362b0f648c97bb131cae47537f4c848718d4be;hb=HEAD;hp=cc2bf2cdac6d96cd98feff25951991af05ece7cb;hpb=a7237500e8a2a4237a6ae8ba4b8301f7bbcb6acb;p=helm.git diff --git a/helm/software/components/grafite_parser/grafiteParser.ml b/helm/software/components/grafite_parser/grafiteParser.ml index cc2bf2cda..b1362b0f6 100644 --- a/helm/software/components/grafite_parser/grafiteParser.ml +++ b/helm/software/components/grafite_parser/grafiteParser.ml @@ -79,7 +79,7 @@ let mk_rec_corec ind_kind defs loc = let name,ty = match defs with | (params,(N.Ident (name, None), ty),_,_) :: _ -> - let ty = match ty with Some ty -> ty | None -> N.Implicit in + let ty = match ty with Some ty -> ty | None -> N.Implicit `JustOne in let ty = List.fold_right (fun var ty -> N.Binder (`Pi,var,ty) @@ -95,7 +95,7 @@ let mk_rec_corec ind_kind defs loc = else `MutualDefinition in - (loc, N.Theorem(flavour, name, ty, Some (N.LetRec (ind_kind, defs, body)))) + (loc, N.Theorem(flavour, name, ty, Some (N.LetRec (ind_kind, defs, body)), `Regular)) let nmk_rec_corec ind_kind defs loc = let loc,t = mk_rec_corec ind_kind defs loc in @@ -128,6 +128,11 @@ let npunct_of_punct = function | G.Semicolon loc -> G.NSemicolon loc | G.Dot loc -> G.NDot loc ;; +let cons_ntac t p = + match t with + | G.NTactic(loc,[t]) -> G.NTactic(loc,[t;p]) + | x -> x +;; type by_continuation = BYC_done @@ -150,6 +155,7 @@ EXTEND | id = IDENT -> Some id ] ]; ident_list0: [ [ LPAREN; idents = LIST0 new_name; RPAREN -> idents ] ]; + ident_list1: [ [ LPAREN; idents = LIST1 IDENT; RPAREN -> idents ] ]; tactic_term_list1: [ [ tactic_terms = LIST1 tactic_term SEP SYMBOL "," -> tactic_terms ] ]; @@ -209,11 +215,11 @@ EXTEND let deannotate = function | N.AttributedTerm (_,t) | t -> t in match deannotate params with - | N.Implicit -> [false] + | N.Implicit _ -> [false] | N.UserInput -> [true] | N.Appl l -> List.map (fun x -> match deannotate x with - | N.Implicit -> false + | N.Implicit _ -> false | N.UserInput -> true | _ -> raise (Invalid_argument "malformed target parameter list 1")) l | _ -> raise (Invalid_argument ("malformed target parameter list 2\n" ^ CicNotationPp.pp_term params)) ] @@ -237,7 +243,8 @@ EXTEND ]; using: [ [ using = OPT [ IDENT "using"; t = tactic_term -> t ] -> using ] ]; ntactic: [ - [ IDENT "napply"; t = tactic_term -> G.NApply (loc, t) + [ IDENT "napply"; t = tactic_term -> G.NTactic(loc,[G.NApply (loc, t)]) + | IDENT "napplyS"; t = tactic_term -> G.NTactic(loc,[G.NSmartApply(loc, t)]) | IDENT "nassert"; seqs = LIST0 [ hyps = LIST0 @@ -247,30 +254,76 @@ EXTEND id,`Def (bo,ty)]; SYMBOL <:unicode>; concl = tactic_term -> (List.rev hyps,concl) ] -> - G.NAssert (loc, seqs) - | IDENT "nauto"; params = auto_params -> G.NAuto (loc, params) + G.NTactic(loc,[G.NAssert (loc, seqs)]) + | IDENT "nauto"; params = auto_params -> + G.NTactic(loc,[G.NAuto (loc, params)]) + | SYMBOL "/"; num = OPT NUMBER ; + params = nauto_params; SYMBOL "/" ; + just = OPT [ IDENT "by"; by = + [ univ = tactic_term_list1 -> `Univ univ + | SYMBOL "{"; SYMBOL "}" -> `EmptyUniv + | SYMBOL "_" -> `Trace ] -> by ] -> + let depth = match num with Some n -> n | None -> "1" in + (match just with + | None -> + G.NTactic(loc, + [G.NAuto(loc,(None,["slir","";"depth",depth]@params))]) + | Some (`Univ univ) -> + G.NTactic(loc, + [G.NAuto(loc,(Some univ,["slir","";"depth",depth]@params))]) + | Some `EmptyUniv -> + G.NTactic(loc, + [G.NAuto(loc,(Some [],["slir","";"depth",depth]@params))]) + | Some `Trace -> + G.NMacro(loc, + G.NAutoInteractive (loc, (None,["slir","";"depth",depth]@params)))) + | IDENT "nintros" -> G.NMacro (loc, G.NIntroGuess loc) + | IDENT "ncheck"; t = term -> G.NMacro(loc,G.NCheck (loc,t)) + | IDENT "screenshot"; fname = QSTRING -> + G.NMacro(loc,G.Screenshot (loc, fname)) | IDENT "ncases"; what = tactic_term ; where = pattern_spec -> - G.NCases (loc, what, where) + G.NTactic(loc,[G.NCases (loc, what, where)]) | IDENT "nchange"; what = pattern_spec; "with"; with_what = tactic_term -> - G.NChange (loc, what, with_what) + G.NTactic(loc,[G.NChange (loc, what, with_what)]) + | SYMBOL "@"; num = OPT NUMBER; l = LIST0 tactic_term -> + G.NTactic(loc,[G.NConstructor (loc, (match num with None -> None | Some x -> Some (int_of_string x)),l)]) + | IDENT "ncut"; t = tactic_term -> G.NTactic(loc,[G.NCut (loc, t)]) +(* | IDENT "ndiscriminate"; t = tactic_term -> G.NDiscriminate (loc, t) + | IDENT "nsubst"; t = tactic_term -> G.NSubst (loc, t) *) + | IDENT "ndestruct"; just = OPT [ dom = ident_list1 -> dom ]; + exclude = OPT [ IDENT "skip"; skip = ident_list1 -> skip ] + -> let exclude' = match exclude with None -> [] | Some l -> l in + G.NTactic(loc,[G.NDestruct (loc,just,exclude')]) | IDENT "nelim"; what = tactic_term ; where = pattern_spec -> - G.NElim (loc, what, where) + G.NTactic(loc,[G.NElim (loc, what, where)]) | IDENT "ngeneralize"; p=pattern_spec -> - G.NGeneralize (loc, p) + G.NTactic(loc,[G.NGeneralize (loc, p)]) + | IDENT "ninversion"; what = tactic_term ; where = pattern_spec -> + G.NTactic(loc,[G.NInversion (loc, what, where)]) + | IDENT "nlapply"; t = tactic_term -> G.NTactic(loc,[G.NLApply (loc, t)]) | IDENT "nletin"; name = IDENT ; SYMBOL <:unicode> ; t = tactic_term; where = pattern_spec -> - G.NLetIn (loc,where,t,name) + G.NTactic(loc,[G.NLetIn (loc,where,t,name)]) | kind = nreduction_kind; p = pattern_spec -> - G.NReduce (loc, kind, p) + G.NTactic(loc,[G.NReduce (loc, kind, p)]) | IDENT "nrewrite"; dir = direction; what = tactic_term ; where = pattern_spec -> - G.NRewrite (loc, dir, what, where) - | IDENT "ntry"; LPAREN ; tac = SELF ; RPAREN -> G.NTry (loc,tac) - | IDENT "nassumption" -> G.NAssumption loc - | SYMBOL "#"; n=IDENT -> G.NIntro (loc,n) - | SYMBOL "#"; SYMBOL "_" -> G.NIntro (loc,"_") - | SYMBOL "*" -> G.NCase1 (loc,"_") - | SYMBOL "*"; n=IDENT -> - G.NCase1 (loc,n) + G.NTactic(loc,[G.NRewrite (loc, dir, what, where)]) + | IDENT "ntry"; tac = SELF -> + let tac = match tac with G.NTactic(_,[t]) -> t | _ -> assert false in + G.NTactic(loc,[ G.NTry (loc,tac)]) + | IDENT "nrepeat"; tac = SELF -> + let tac = match tac with G.NTactic(_,[t]) -> t | _ -> assert false in + G.NTactic(loc,[ G.NRepeat (loc,tac)]) + | LPAREN; l = LIST1 SELF; RPAREN -> + let l = + List.flatten + (List.map (function G.NTactic(_,t) -> t | _ -> assert false) l) in + G.NTactic(loc,[G.NBlock (loc,l)]) + | IDENT "nassumption" -> G.NTactic(loc,[ G.NAssumption loc]) + | SYMBOL "#"; ns=LIST0 IDENT -> G.NTactic(loc,[ G.NIntros (loc,ns)]) + | SYMBOL "#"; SYMBOL "_" -> G.NTactic(loc,[ G.NIntro (loc,"_")]) + | SYMBOL "*" -> G.NTactic(loc,[ G.NCase1 (loc,"_")]) + | SYMBOL "*"; n=IDENT -> G.NTactic(loc,[ G.NCase1 (loc,n)]) ] ]; tactic: [ @@ -406,7 +459,7 @@ EXTEND | "let" ; id1 = IDENT ; SYMBOL ":" ; t1 = tactic_term ; IDENT "such" ; IDENT "that" ; t2=tactic_term ; LPAREN ; id2 = IDENT ; RPAREN -> - G.ExistsElim (loc, `Auto ([],[]), id1, t1, id2, t2) + G.ExistsElim (loc, `Auto (None,[]), id1, t1, id2, t2) | just = [ IDENT "using"; t=tactic_term -> `Term t | params = auto_params -> `Auto params] ; @@ -468,6 +521,10 @@ EXTEND ]; auto_fixed_param: [ [ IDENT "paramodulation" + | IDENT "demod" + | IDENT "fast_paramod" + | IDENT "paramod" + | IDENT "slir" | IDENT "depth" | IDENT "width" | IDENT "size" @@ -478,16 +535,26 @@ EXTEND ] ]; auto_params: [ - [ params = + [ params = LIST0 [ i = auto_fixed_param -> i,"" | i = auto_fixed_param ; SYMBOL "="; v = [ v = int -> string_of_int v | v = IDENT -> v ] -> i,v ]; - tl = OPT [ IDENT "by"; tl = tactic_term_list1 -> tl] -> - (match tl with Some l -> l | None -> []), + tl = OPT [ IDENT "by"; tl = tactic_term_list1 -> tl] -> tl, + (* (match tl with Some l -> l | None -> []), *) + params + ] +]; + nauto_params: [ + [ params = + LIST0 [ + i = auto_fixed_param -> i,"" + | i = auto_fixed_param ; SYMBOL "="; v = [ v = int -> + string_of_int v | v = IDENT -> v ] -> i,v ] -> params ] ]; + inline_params:[ [ params = LIST0 [ IDENT "prefix"; SYMBOL "="; prefix = QSTRING -> G.IPPrefix prefix @@ -559,6 +626,7 @@ EXTEND | SYMBOL "|" -> G.NShift loc | i = LIST1 int SEP SYMBOL ","; SYMBOL ":" -> G.NPos (loc, i) | SYMBOL "*"; SYMBOL ":" -> G.NWildcard loc + | name = IDENT; SYMBOL ":" -> G.NPosbyname (loc, name) | SYMBOL "]" -> G.NMerge loc | SYMBOL ";" -> G.NSemicolon loc | SYMBOL "." -> G.NDot loc @@ -650,7 +718,7 @@ EXTEND in (params,name,typ,fields) ] ]; - + macro: [ [ [ IDENT "check" ]; t = term -> G.Check (loc, t) @@ -784,12 +852,17 @@ EXTEND IDENT "nqed" -> G.NQed loc | nflavour = ntheorem_flavour; name = IDENT; SYMBOL ":"; typ = term; body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> - G.NObj (loc, N.Theorem (nflavour, name, typ, body)) + G.NObj (loc, N.Theorem (nflavour, name, typ, body,`Regular)) | nflavour = ntheorem_flavour; name = IDENT; SYMBOL <:unicode> (* ≝ *); body = term -> - G.NObj (loc, N.Theorem (nflavour, name, N.Implicit, Some body)) + G.NObj (loc, N.Theorem (nflavour, name, N.Implicit `JustOne, Some body,`Regular)) | IDENT "naxiom"; name = IDENT; SYMBOL ":"; typ = term -> - G.NObj (loc, N.Theorem (`Axiom, name, typ, None)) + G.NObj (loc, N.Theorem (`Axiom, name, typ, None, `Regular)) + | IDENT "ndiscriminator" ; indty = tactic_term -> G.NDiscriminator (loc,indty) + | IDENT "ninverter"; name = IDENT; IDENT "for" ; indty = tactic_term ; + paramspec = OPT inverter_param_list ; + outsort = OPT [ SYMBOL ":" ; outsort = term -> outsort ] -> + G.NInverter (loc,name,indty,paramspec,outsort) | NLETCOREC ; defs = let_defs -> nmk_rec_corec `CoInductive defs loc | NLETREC ; defs = let_defs -> @@ -805,30 +878,28 @@ EXTEND in G.NObj (loc, N.Inductive (params, ind_types)) | IDENT "universe"; IDENT "constraint"; u1 = tactic_term; - strict = [ SYMBOL <:unicode> -> true - | SYMBOL <:unicode> -> false ]; - u2 = tactic_term -> - let u1 = - match u1 with - | CicNotationPt.AttributedTerm (_, CicNotationPt.Sort (`NType i)) -> - NUri.uri_of_string ("cic:/matita/pts/Type"^i^".univ") - | CicNotationPt.AttributedTerm (_, CicNotationPt.Sort (`NCProp i)) -> - NUri.uri_of_string ("cic:/matita/pts/CProp"^i^".univ") - | _ -> raise (Failure "only a sort can be constrained") - in - let u2 = - match u2 with + SYMBOL <:unicode> ; u2 = tactic_term -> + let urify = function | CicNotationPt.AttributedTerm (_, CicNotationPt.Sort (`NType i)) -> NUri.uri_of_string ("cic:/matita/pts/Type"^i^".univ") - | CicNotationPt.AttributedTerm (_, CicNotationPt.Sort (`NCProp i)) -> - NUri.uri_of_string ("cic:/matita/pts/CProp"^i^".univ") - | _ -> raise (Failure "only a sort can be constrained") + | _ -> raise (Failure "only a Type[…] sort can be constrained") in - G.NUnivConstraint (loc, strict,u1,u2) + let u1 = urify u1 in + let u2 = urify u2 in + G.NUnivConstraint (loc,u1,u2) | IDENT "unification"; IDENT "hint"; n = int; t = tactic_term -> G.UnificationHint (loc, t, n) + | IDENT "ncoercion"; name = IDENT; SYMBOL ":"; ty = term; + SYMBOL <:unicode>; t = term; "on"; + id = [ IDENT | PIDENT ]; SYMBOL ":"; source = term; + "to"; target = term -> + G.NCoercion(loc,name,t,ty,(id,source),target) | IDENT "nrecord" ; (params,name,ty,fields) = record_spec -> G.NObj (loc, N.Record (params,name,ty,fields)) + | IDENT "ncopy" ; s = IDENT; IDENT "from"; u = URI; "with"; + m = LIST0 [ u1 = URI; SYMBOL <:unicode>; u2 = URI -> u1,u2 ] -> + G.NCopy (loc,s,NUri.uri_of_string u, + List.map (fun a,b -> NUri.uri_of_string a, NUri.uri_of_string b) m) ]]; grafite_command: [ [ @@ -841,16 +912,16 @@ EXTEND typ = term; SYMBOL <:unicode> ; newname = IDENT -> G.Obj (loc, N.Theorem - (`Variant,name,typ,Some (N.Ident (newname, None)))) + (`Variant,name,typ,Some (N.Ident (newname, None)), `Regular)) | flavour = theorem_flavour; name = IDENT; SYMBOL ":"; typ = term; body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> - G.Obj (loc, N.Theorem (flavour, name, typ, body)) + G.Obj (loc, N.Theorem (flavour, name, typ, body,`Regular)) | flavour = theorem_flavour; name = IDENT; SYMBOL <:unicode> (* ≝ *); body = term -> G.Obj (loc, - N.Theorem (flavour, name, N.Implicit, Some body)) + N.Theorem (flavour, name, N.Implicit `JustOne, Some body,`Regular)) | IDENT "axiom"; name = IDENT; SYMBOL ":"; typ = term -> - G.Obj (loc, N.Theorem (`Axiom, name, typ, None)) + G.Obj (loc, N.Theorem (`Axiom, name, typ, None, `Regular)) | LETCOREC ; defs = let_defs -> mk_rec_corec `CoInductive defs loc | LETREC ; defs = let_defs -> @@ -912,10 +983,13 @@ EXTEND | tac = atomic_tactical LEVEL "loops"; punct = punctuation_tactical -> G.Tactic (loc, Some tac, punct) | punct = punctuation_tactical -> G.Tactic (loc, None, punct) - | tac = ntactic; SYMBOL "#" ; SYMBOL "#" ; punct = punctuation_tactical -> - G.NTactic (loc, [tac; npunct_of_punct punct]) + | tac = ntactic; OPT [ SYMBOL "#" ; SYMBOL "#" ] ; + punct = punctuation_tactical -> + cons_ntac tac (npunct_of_punct punct) +(* | tac = ntactic; punct = punctuation_tactical -> - G.NTactic (loc, [tac; npunct_of_punct punct]) + cons_ntac tac (npunct_of_punct punct) +*) | SYMBOL "#" ; SYMBOL "#" ; punct = npunctuation_tactical -> G.NTactic (loc, [punct]) | tac = non_punctuation_tactical; punct = punctuation_tactical -> @@ -984,13 +1058,13 @@ let exc_located_wrapper f = try f () with - | Stdpp.Exc_located (_, End_of_file) -> raise End_of_file - | Stdpp.Exc_located (floc, Stream.Error msg) -> + | Ploc.Exc (_, End_of_file) -> raise End_of_file + | Ploc.Exc (floc, Stream.Error msg) -> raise (HExtlib.Localized (floc,CicNotationParser.Parse_error msg)) - | Stdpp.Exc_located (floc, HExtlib.Localized(_,exn)) -> + | Ploc.Exc (floc, HExtlib.Localized(_,exn)) -> raise (HExtlib.Localized (floc,CicNotationParser.Parse_error (Printexc.to_string exn))) - | Stdpp.Exc_located (floc, exn) -> + | Ploc.Exc (floc, exn) -> raise (HExtlib.Localized (floc,CicNotationParser.Parse_error (Printexc.to_string exn)))