aboutsummaryrefslogtreecommitdiffhomepage
path: root/parsing/g_constr.ml4
diff options
context:
space:
mode:
Diffstat (limited to 'parsing/g_constr.ml4')
-rw-r--r--parsing/g_constr.ml473
1 files changed, 47 insertions, 26 deletions
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index c93acba58..cbe3a14c2 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -14,10 +14,10 @@ open Pcoq
open Constr
GEXTEND Gram
- GLOBAL: ident constr0 constr1 constr2 constr3 lassoc_constr4 constr5
+ GLOBAL: constr0 constr1 constr2 constr3 lassoc_constr4 constr5
constr6 constr7 constr8 constr9 constr10 lconstr constr
ne_ident_comma_list ne_constr_list sort ne_binders_list qualid
- global;
+ global constr_pattern ident;
ident:
[ [ id = Prim.var -> id
@@ -25,14 +25,14 @@ GEXTEND Gram
| id = Prim.metaident -> id ] ]
;
global:
- [ [ l = qualid -> <:ast< (QUALID ($LIST $l)) >>
+ [ [ l = qualid -> l
(* This is used in quotations *)
| id = Prim.metaident -> id ] ]
;
qualid:
- [ [ id = Prim.var; l = fields -> id :: l
- | id = Prim.var -> [ id ]
+ [ [ id = Prim.var; l = fields -> <:ast< (QUALID $id ($LIST $l)) >>
+ | id = Prim.var -> <:ast< (QUALID $id) >>
] ]
;
fields:
@@ -40,30 +40,23 @@ GEXTEND Gram
| id = FIELD -> [ <:ast< ($VAR $id) >> ]
] ]
;
-(*
- qualid:
- [ [ id = IDENT; l = fields -> <:ast< ($VAR $id) >> :: l ] ]
- ;
- fields:
- [ [ id = FIELD; l = fields -> <:ast< ($VAR $id) >> :: l
- | -> []
- ] ]
- ;
-*)
raw_constr:
[ [ c = Prim.ast -> c ] ]
;
constr:
- [ [ c = constr8 -> c
- | IDENT "Inst"; id = ident; "["; c = constr8; "]" ->
- <:ast<(CONTEXT $id $c)>>
- | IDENT "Eval"; rtc = Tactic.red_tactic; "in"; c = constr8 ->
- <:ast<(EVAL $c (REDEXP $rtc))>>
- | IDENT "Check"; c = constr8 -> <:ast<(CHECK $c)>> ] ]
+ [ [ c = constr8 -> (* Genarg.ConstrTerm *) c
+(* | IDENT "Inst"; id = Prim.rawident; "["; c = constr; "]" ->
+ Genarg.ConstrContext (id, c)
+ | IDENT "Eval"; rtc = Tactic.raw_red_tactic; "in"; c = constr ->
+ Genarg.ConstrEval (rtc,c)
+ | IDENT "Check"; c = constr8 -> <:ast<(CHECK $c)>> *)] ]
;
lconstr:
[ [ c = constr10 -> c ] ]
;
+ constr_pattern:
+ [ [ c = constr -> c ] ]
+ ;
ne_constr_list:
[ [ c1 = constr; cl = ne_constr_list -> c1::cl
| c1 = constr -> [c1] ] ]
@@ -75,7 +68,8 @@ GEXTEND Gram
;
constr0:
[ [ "?" -> <:ast< (ISEVAR) >>
- | "?"; n = Prim.number -> <:ast< (META $n) >>
+ | "?"; n = Prim.natural ->
+ let n = Coqast.Num (loc,n) in <:ast< (META $n) >>
| bl = binders; c = constr -> <:ast< ($ABSTRACT "LAMBDALIST" $bl $c) >>
| "("; lc1 = lconstr; ":"; c = constr; body = product_tail ->
let id = Ast.coerce_to_var lc1 in
@@ -122,12 +116,17 @@ GEXTEND Gram
| IDENT "Match"; c = constr; "with"; cl = ne_constr_list; "end" ->
<:ast< (MATCH "SYNTH" $c ($LIST $cl)) >>
| IDENT "let"; "("; b = ne_ident_comma_list; ")"; "=";
- c = constr; "in"; c1 = constr ->
+ c = constr; "in"; c1 = constr->
<:ast< (LET "SYNTH" $c ($ABSTRACT "LAMBDALIST"
(BINDERS (BINDER (ISEVAR) ($LIST $b))) $c1)) >>
| IDENT "let"; id1 = ident ; "="; c = opt_casted_constr;
+ "in"; c1 = constr ->
+ <:ast< (LETIN $c [$id1]$c1) >>
+(*
+ | IDENT "let"; id1 = ident ; "="; c = opt_casted_constr;
"in"; c1 = constr ->
<:ast< (LETIN $c [$id1]$c1) >>
+*)
| IDENT "if"; c1 = constr; IDENT "then"; c2 = constr;
IDENT "else"; c3 = constr ->
<:ast< ( IF "SYNTH" $c1 $c2 $c3) >>
@@ -170,9 +169,28 @@ GEXTEND Gram
[ [ c1 = constr8 -> c1
| c1 = constr8; "::"; c2 = constr8 -> <:ast< (CAST $c1 $c2) >> ] ]
;
+ simple_binding:
+ [ [ id = ident; ":="; c = constr -> <:ast< (BINDING $id $c) >>
+ | n = Prim.numarg; ":="; c = constr -> <:ast< (BINDING $n $c) >> ] ]
+ ;
+ simple_binding_list:
+ [ [ b = simple_binding; l = simple_binding_list -> b :: l | -> [] ] ]
+ ;
+ binding_list:
+ [ [ c1 = constr; ":="; c2 = constr; bl = simple_binding_list ->
+ Coqast.Node
+ (loc, "EXPLICITBINDINGS",
+ (Coqast.Node (loc, "BINDING", [Ast.coerce_to_var c1; c2]) :: bl))
+ | n = Prim.numarg; ":="; c = constr; bl = simple_binding_list ->
+ <:ast<(EXPLICITBINDINGS (BINDING $n $c) ($LIST $bl))>>
+ | c1 = constr; bl = LIST0 constr ->
+ <:ast<(IMPLICITBINDINGS $c1 ($LIST $bl))>> ] ]
+ ;
constr10:
[ [ "!"; f = global; args = ne_constr9_list ->
<:ast< (APPLISTEXPL $f ($LIST $args)) >>
+ | "!"; f = global; "with"; b = binding_list ->
+ <:ast< (APPLISTWITH $f $b) >>
| f = constr9; args = ne_constr91_list ->
<:ast< (APPLIST $f ($LIST $args)) >>
| f = constr9 -> f ] ]
@@ -216,7 +234,8 @@ GEXTEND Gram
| -> <:ast< (ISEVAR) >> ] ]
;
constr91:
- [ [ n = Prim.number; "!"; c1 = constr9 ->
+ [ [ n = Prim.natural; "!"; c1 = constr9 ->
+ let n = Coqast.Num (loc,n) in
<:ast< (EXPL $n $c1) >>
| c1 = constr9 -> c1 ] ]
;
@@ -229,8 +248,10 @@ GEXTEND Gram
| c1 = constr9 -> [c1] ] ]
;
fixbinder:
- [ [ id = ident; "/"; recarg = Prim.number; ":"; type_ = constr;
- ":="; def = constr -> <:ast< (NUMFDECL $id $recarg $type_ $def) >>
+ [ [ id = ident; "/"; recarg = Prim.natural; ":"; type_ = constr;
+ ":="; def = constr ->
+ let recarg = Coqast.Num (loc,recarg) in
+ <:ast< (NUMFDECL $id $recarg $type_ $def) >>
| id = ident; bl = ne_binders_list; ":"; type_ = constr;
":="; def = constr ->
<:ast< (FDECL $id (BINDERS ($LIST $bl)) $type_ $def) >> ] ]