X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fgrafite_parser%2FgrafiteParser.ml;h=fd9c2946d9476a956821248b07f0ee3deaa15042;hb=1b4d894e7349bba991823249f1716fb8f18239b7;hp=0a2103c9a89ea34be89a4585d1ee62c9c80a79ec;hpb=f7da48c844105a52a705872dfa0d4104de010c82;p=helm.git

diff --git a/matita/components/grafite_parser/grafiteParser.ml b/matita/components/grafite_parser/grafiteParser.ml
index 0a2103c9a..fd9c2946d 100644
--- a/matita/components/grafite_parser/grafiteParser.ml
+++ b/matita/components/grafite_parser/grafiteParser.ml
@@ -58,27 +58,20 @@ 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
-   let attrs = `Provided, `Definition, `Regular in 
-   (loc, N.Theorem(name, ty, Some (N.LetRec (ind_kind, defs, body)), attrs))
+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)
 
+let shift_vars binder (vars, ty) bo =
+   let map var bo = N.Binder (binder, (var, ty), bo) in
+   List.fold_right map vars bo
+
+let shift_params binder params bo = 
+   List.fold_right (shift_vars binder) params bo
 (*
 let nnon_punct_of_punct = function
   | G.Skip loc -> G.NSkip loc
@@ -255,6 +248,7 @@ EXTEND
    | IDENT "width"
    | IDENT "size"
    | IDENT "nohyps"
+(*   | IDENT "timeout" *)
    ]
 ];
   auto_params: [
@@ -505,33 +499,49 @@ EXTEND
 
   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;
+      params = LIST0 protected_binder_vars; SYMBOL ":"; typ = term; (* FG: params added *)
       body = OPT [ SYMBOL <:unicode<def>> (* ≝ *); body = term -> body ] ->
-        let attrs = `Provided, nflavour, `Regular in
+        let typ = shift_params `Forall params typ in
+        let body = match body with
+           | Some bo -> Some (shift_params `Lambda params bo)
+           | None    -> None
+        in
+        let attrs = src, nflavour, `Regular in
 	G.NObj (loc, N.Theorem (name, typ, body, attrs),true)
-    | nflavour = ntheorem_flavour; name = IDENT; SYMBOL <:unicode<def>> (* ≝ *);
+    | src = source; nflavour = ntheorem_flavour; name = IDENT;
+      params = LIST0 protected_binder_vars; SYMBOL <:unicode<def>> (* ≝ *); (* FG: params added *)
       body = term ->
-        let attrs = `Provided, nflavour, `Regular in
+        let body = shift_params `Lambda params body in
+        let attrs = src, nflavour, `Regular in
         G.NObj (loc, 
           N.Theorem(name, N.Implicit `JustOne, Some body, attrs),
           true)
-    | IDENT "axiom"; i = index; name = IDENT; SYMBOL ":"; typ = term ->
-        let attrs = `Provided, `Axiom, `Regular in
+    | 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) *)
@@ -559,6 +569,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";