X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=matita%2Fcomponents%2Fgrafite_parser%2FgrafiteParser.ml;h=70fe2f4157621800d93c37c44f4442182d675d54;hb=6c15dd2d7c372dc163c24e96bf56376c5bcb5a6c;hp=376c5c9cc5ba985079fe1880386428b4852c959b;hpb=f5b9e1d5511a13ca5bb424c149781087aa0c8e31;p=helm.git diff --git a/matita/components/grafite_parser/grafiteParser.ml b/matita/components/grafite_parser/grafiteParser.ml index 376c5c9cc..70fe2f415 100644 --- a/matita/components/grafite_parser/grafiteParser.ml +++ b/matita/components/grafite_parser/grafiteParser.ml @@ -32,13 +32,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))) @@ -50,7 +50,7 @@ let parsable_statement status buf = let parse_statement grafite_parser parsable = exc_located_wrapper - (fun () -> (Grammar.Entry.parse_parsable (Obj.magic grafite_parser) (fst parsable))) + (fun () -> (Grammar.Entry.parse_parsable grafite_parser (fst parsable))) let strm_of_parsable (_,buf) = buf @@ -58,24 +58,12 @@ let add_raw_attribute ~text t = N.AttributedTerm (`Raw text, t) let default_associativity = Gramext.NonA -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 `JustOne in - let ty = - List.fold_right - (fun var ty -> N.Binder (`Pi,var,ty) - ) params ty - in - name,ty - | _ -> assert false - in - let body = N.Ident (name,None) in - (loc, N.Theorem(`Definition, name, ty, Some (N.LetRec (ind_kind, defs, body)), `Regular)) +let mk_rec_corec src ind_kind defs loc = + let attrs = src, `Definition, `Regular in + (loc, N.LetRec (ind_kind, defs, attrs)) -let nmk_rec_corec ind_kind defs loc index = - let loc,t = mk_rec_corec ind_kind defs loc in +let nmk_rec_corec src ind_kind defs loc index = + let loc,t = mk_rec_corec src ind_kind defs loc in G.NObj (loc,t,index) (* @@ -253,6 +241,8 @@ EXTEND | IDENT "paramod" | IDENT "width" | IDENT "size" + | IDENT "nohyps" +(* | IDENT "timeout" *) ] ]; auto_params: [ @@ -501,32 +491,43 @@ EXTEND loc,path,G.WithoutPreferences ]]; - index: [[ b = OPT SYMBOL "-" -> match b with None -> false | _ -> true ]]; + index: [[ b = OPT SYMBOL "-" -> match b with None -> true | _ -> false ]]; + + source: [[ + src = OPT IDENT "implied" -> + match src with None -> `Provided | _ -> `Implied + ]]; grafite_ncommand: [ [ IDENT "qed" ; i = index -> G.NQed (loc,i) - | nflavour = ntheorem_flavour; name = IDENT; SYMBOL ":"; typ = term; + | IDENT "defined" ; i = index -> G.NQed (loc,i) (* FG: presentational qed for definitions *) + | src = source; nflavour = ntheorem_flavour; name = IDENT; SYMBOL ":"; typ = term; body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> - G.NObj (loc, N.Theorem (nflavour, name, typ, body,`Regular),true) - | nflavour = ntheorem_flavour; name = IDENT; SYMBOL <:unicode> (* ≝ *); + let attrs = src, nflavour, `Regular in + G.NObj (loc, N.Theorem (name, typ, body, attrs),true) + | src = source; nflavour = ntheorem_flavour; name = IDENT; SYMBOL <:unicode> (* ≝ *); body = term -> + let attrs = src, nflavour, `Regular in G.NObj (loc, - N.Theorem(nflavour, name, N.Implicit `JustOne, Some body,`Regular), + N.Theorem(name, N.Implicit `JustOne, Some body, attrs), true) - | i = index; IDENT "axiom"; name = IDENT; SYMBOL ":"; typ = term -> - G.NObj (loc, N.Theorem (`Axiom, name, typ, None, `Regular),i) + | src = source; IDENT "axiom"; i = index; name = IDENT; SYMBOL ":"; typ = term -> + let attrs = src, `Axiom, `Regular in + G.NObj (loc, N.Theorem (name, typ, None, attrs),i) | IDENT "discriminator" ; indty = tactic_term -> G.NDiscriminator (loc,indty) | IDENT "inverter"; 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) - | LETCOREC ; defs = let_codefs -> - nmk_rec_corec `CoInductive defs loc true - | LETREC ; defs = let_defs -> - nmk_rec_corec `Inductive defs loc true + | src = source; LETCOREC ; defs = let_codefs -> + nmk_rec_corec src `CoInductive defs loc true + | src = source; LETREC ; defs = let_defs -> + nmk_rec_corec src `Inductive defs loc true +(* FG: no source since no i_attr in N.Inductive *) | IDENT "inductive"; spec = inductive_spec -> let (params, ind_types) = spec in G.NObj (loc, N.Inductive (params, ind_types),true) +(* FG: no source since no i_attr in N.Inductive *) | IDENT "coinductive"; spec = inductive_spec -> let (params, ind_types) = spec in let ind_types = (* set inductive flags to false (coinductive) *) @@ -554,6 +555,7 @@ EXTEND "to"; target = term -> t,ty,(id,source),target ] -> let compose = compose = None in G.NCoercion(loc,name,compose,spec) +(* FG: no source since no i_attr in N.Record *) | IDENT "record" ; (params,name,ty,fields) = record_spec -> G.NObj (loc, N.Record (params,name,ty,fields),true) | IDENT "copy" ; s = IDENT; IDENT "from"; u = URI; "with";