(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

{

open Names
open Constr
open Libnames
open Glob_term
open Constrexpr
open Constrexpr_ops
open Util
open Namegen

open Pcoq
open Pcoq.Prim
open Pcoq.Constr

(* TODO: avoid this redefinition without an extra dep to Notation_ops *)
let ldots_var = Id.of_string ".."

let mk_cast = function
    (c,(_,None)) -> c
  | (c,(_,Some ty)) ->
    let loc = Loc.merge_opt (constr_loc c) (constr_loc ty)
    in CAst.make ?loc @@ CCast(c, CastConv ty)

let binder_of_name expl { CAst.loc = loc; v = na } =
  CLocalAssum ([CAst.make ?loc na], Default expl,
    CAst.make ?loc @@ CHole (Some (Evar_kinds.BinderType na), IntroAnonymous, None))

let binders_of_names l =
  List.map (binder_of_name Explicit) l

let err () = raise Stream.Failure

(* Hack to parse "(x:=t)" as an explicit argument without conflicts with the *)
(* admissible notation "(x t)" *)
let test_lpar_id_coloneq =
  let open Pcoq.Lookahead in
  to_entry "test_lpar_id_coloneq" begin
    lk_kw "(" >> lk_ident >> lk_kw ":="
  end

let ensure_fixannot =
  let open Pcoq.Lookahead in
  to_entry "check_fixannot" begin
    lk_kw "{" >> lk_kws ["wf"; "struct"; "measure"]
  end

let lk_name = Pcoq.Lookahead.(lk_ident <+> lk_kw "_")

let test_name_colon =
  let open Pcoq.Lookahead in
  to_entry "test_name_colon" begin
    lk_name >> lk_kw ":"
  end

let aliasvar = function { CAst.v = CPatAlias (_, na) } -> Some na | _ -> None

let test_array_opening =
  let open Pcoq.Lookahead in
  to_entry "test_array_opening" begin
    lk_kw "[" >> lk_kw "|" >> check_no_space
  end

let test_array_closing =
  let open Pcoq.Lookahead in
  to_entry "test_array_closing" begin
    lk_kw "|" >> lk_kw "]" >> check_no_space
  end

}

GRAMMAR EXTEND Gram
  GLOBAL: binder_constr lconstr constr operconstr
  universe_level universe_name sort sort_family
  global constr_pattern lconstr_pattern Constr.ident
  closed_binder open_binders binder binders binders_fixannot
  record_declaration typeclass_constraint pattern appl_arg type_cstr;
  Constr.ident:
    [ [ id = Prim.ident -> { id } ] ]
  ;
  Prim.name:
    [ [ "_" -> { CAst.make ~loc Anonymous } ] ]
  ;
  global:
    [ [ r = Prim.reference -> { r } ] ]
  ;
  constr_pattern:
    [ [ c = constr -> { c } ] ]
  ;
  lconstr_pattern:
    [ [ c = lconstr -> { c } ] ]
  ;
  sort:
    [ [ "Set"  -> { UNamed [GSet,0] }
      | "Prop" -> { UNamed [GProp,0] }
      | "SProp" -> { UNamed [GSProp,0] }
      | "Type" -> { UAnonymous {rigid=true} }
      | "Type"; "@{"; "_"; "}" -> { UAnonymous {rigid=false} }
      | "Type"; "@{"; u = universe; "}" -> { UNamed u } ] ]
  ;
  sort_family:
    [ [ "Set"  -> { Sorts.InSet }
      | "Prop" -> { Sorts.InProp }
      | "SProp" -> { Sorts.InSProp }
      | "Type" -> { Sorts.InType } ] ]
  ;
  universe_increment:
    [ [ "+"; n = natural -> { n }
      | -> { 0 } ] ]
  ;
  universe_name:
    [ [ id = global -> { GType id }
      | "Set"  -> { GSet }
      | "Prop" -> { GProp } ] ]
  ;
  universe_expr:
    [ [ id = universe_name; n = universe_increment -> { (id,n) } ] ]
  ;
  universe:
    [ [ IDENT "max"; "("; ids = LIST1 universe_expr SEP ","; ")" -> { ids }
      | u = universe_expr -> { [u] } ] ]
  ;
  lconstr:
    [ [ c = operconstr LEVEL "200" -> { c } ] ]
  ;
  constr:
    [ [ c = operconstr LEVEL "8" -> { c }
      | "@"; f=global; i = univ_instance -> { CAst.make ~loc @@ CAppExpl((None,f,i),[]) } ] ]
  ;
  operconstr:
    [ "200" RIGHTA
      [ c = binder_constr -> { c } ]
    | "100" RIGHTA
      [ c1 = operconstr; "<:"; c2 = operconstr LEVEL "200" ->
                 { CAst.make ~loc @@ CCast(c1, CastVM c2) }
      | c1 = operconstr; "<<:"; c2 = operconstr LEVEL "200" ->
                 { CAst.make ~loc @@ CCast(c1, CastNative c2) }
      | c1 = operconstr; ":"; c2 = operconstr LEVEL "200" ->
                 { CAst.make ~loc @@ CCast(c1, CastConv c2) }
      | c1 = operconstr; ":>" ->
                 { CAst.make ~loc @@ CCast(c1, CastCoerce) } ]
    | "99" RIGHTA [ ]
    | "90" RIGHTA [ ]
    | "10" LEFTA
      [ f = operconstr; args = LIST1 appl_arg -> { CAst.make ~loc @@ CApp((None,f),args) }
      | "@"; f = global; i = univ_instance; args = LIST0 NEXT -> { CAst.make ~loc @@ CAppExpl((None,f,i),args) }
      | "@"; lid = pattern_identref; args = LIST1 identref ->
        { let { CAst.loc = locid; v = id } = lid in
          let args = List.map (fun x -> CAst.make @@ CRef (qualid_of_ident ?loc:x.CAst.loc x.CAst.v, None), None) args in
          CAst.make ~loc @@ CApp((None, CAst.make ?loc:locid @@ CPatVar id),args) } ]
    | "9"
      [ ".."; c = operconstr LEVEL "0"; ".." ->
        { CAst.make ~loc @@ CAppExpl ((None, (qualid_of_ident ~loc ldots_var), None),[c]) } ]
    | "8" [ ]
    | "1" LEFTA
      [ c = operconstr; ".("; f = global; args = LIST0 appl_arg; ")" ->
        { CAst.make ~loc @@ CApp((Some (List.length args+1), CAst.make @@ CRef (f,None)),args@[c,None]) }
      | c = operconstr; ".("; "@"; f = global;
        args = LIST0 (operconstr LEVEL "9"); ")" ->
        { CAst.make ~loc @@ CAppExpl((Some (List.length args+1),f,None),args@[c]) }
      | c = operconstr; "%"; key = IDENT -> { CAst.make ~loc @@ CDelimiters (key,c) } ]
    | "0"
      [ c = atomic_constr -> { c }
      | c = match_constr -> { c }
      | "("; c = operconstr LEVEL "200"; ")" ->
        { (* Preserve parentheses around numerals so that constrintern does not
             collapse -(3) into the numeral -3. *)
          (match c.CAst.v with
            | CPrim (Numeral (NumTok.SPlus,n)) ->
                CAst.make ~loc @@ CNotation(None,(InConstrEntry,"( _ )"),([c],[],[],[]))
            | _ -> c) }
      | "{|"; c = record_declaration; bar_cbrace -> { c }
      | "{"; c = binder_constr ; "}" ->
        { CAst.make ~loc @@ CNotation(None,(InConstrEntry,"{ _ }"),([c],[],[],[])) }
      | "`{"; c = operconstr LEVEL "200"; "}" ->
        { CAst.make ~loc @@ CGeneralization (MaxImplicit, None, c) }
      | test_array_opening; "["; "|"; ls = array_elems; "|"; def = lconstr; ty = type_cstr; test_array_closing; "|"; "]"; u = univ_instance ->
        { let t = Array.make (List.length ls) def in
          List.iteri (fun i e -> t.(i) <- e) ls;
          CAst.make ~loc @@ CArray(u, t, def, ty)
        }
      | "`("; c = operconstr LEVEL "200"; ")" ->
        { CAst.make ~loc @@ CGeneralization (Explicit, None, c) } ] ]
  ;
  array_elems:
    [ [ fs = LIST0 lconstr SEP ";" -> { fs } ]]
  ;
  record_declaration:
    [ [ fs = fields_def -> { CAst.make ~loc @@ CRecord fs } ] ]
  ;
  fields_def:
    [ [ f = field_def; ";"; fs = fields_def -> { f :: fs }
      | f = field_def -> { [f] }
      | -> { [] } ] ]
  ;
  field_def:
    [ [ id = global; bl = binders; ":="; c = lconstr ->
        { (id, mkLambdaCN ~loc bl c) } ] ]
  ;
  binder_constr:
    [ [ "forall"; bl = open_binders; ","; c = operconstr LEVEL "200" ->
        { mkProdCN ~loc bl c }
      | "fun"; bl = open_binders; "=>"; c = operconstr LEVEL "200" ->
        { mkLambdaCN ~loc bl c }
      | "let"; id=name; bl = binders; ty = let_type_cstr; ":=";
        c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
        { let ty,c1 = match ty, c1 with
          | (_,None), { CAst.v = CCast(c, CastConv t) } -> (Loc.tag ?loc:(constr_loc t) @@ Some t), c (* Tolerance, see G_vernac.def_body *)
          | _, _ -> ty, c1 in
          CAst.make ~loc @@ CLetIn(id,mkLambdaCN ?loc:(constr_loc c1) bl c1,
                 Option.map (mkProdCN ?loc:(fst ty) bl) (snd ty), c2) }
      | "let"; "fix"; fx = fix_decl; "in"; c = operconstr LEVEL "200" ->
        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_,_ as dcl)} = fx in
          let fix = CAst.make ?loc:locf @@ CFix (lid,[dcl]) in
          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,fix,None,c) }
      | "let"; "cofix"; fx = cofix_decl; "in"; c = operconstr LEVEL "200" ->
        { let {CAst.loc=locf;CAst.v=({CAst.loc=li;CAst.v=id} as lid,_,_,_ as dcl)} = fx in
          let cofix = CAst.make ?loc:locf @@ CCoFix (lid,[dcl]) in
          CAst.make ~loc @@ CLetIn( CAst.make ?loc:li @@ Name id,cofix,None,c) }
      | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> { l } | "()" -> { [] } ];
        po = return_type; ":="; c1 = operconstr LEVEL "200"; "in";
        c2 = operconstr LEVEL "200" ->
        { CAst.make ~loc @@ CLetTuple (lb,po,c1,c2) }
      | "let"; "'"; p = pattern LEVEL "200"; ":="; c1 = operconstr LEVEL "200";
        "in"; c2 = operconstr LEVEL "200" ->
        { CAst.make ~loc @@
          CCases (LetPatternStyle, None,    [c1, None, None],       [CAst.make ~loc ([[p]], c2)]) }
      | "let"; "'"; p = pattern LEVEL "200"; ":="; c1 = operconstr LEVEL "200";
        rt = case_type; "in"; c2 = operconstr LEVEL "200" ->
        { CAst.make ~loc @@
          CCases (LetPatternStyle, Some rt, [c1, aliasvar p, None], [CAst.make ~loc ([[p]], c2)]) }
      | "let"; "'"; p = pattern LEVEL "200"; "in"; t = pattern LEVEL "200";
        ":="; c1 = operconstr LEVEL "200"; rt = case_type;
        "in"; c2 = operconstr LEVEL "200" ->
        { CAst.make ~loc @@
          CCases (LetPatternStyle, Some rt, [c1, aliasvar p, Some t], [CAst.make ~loc ([[p]], c2)]) }
      | "if"; c = operconstr LEVEL "200"; po = return_type;
        "then"; b1 = operconstr LEVEL "200";
        "else"; b2 = operconstr LEVEL "200" ->
        { CAst.make ~loc @@ CIf (c, po, b1, b2) }
      | "fix"; c = fix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CFix (id,dcls) }
      | "cofix"; c = cofix_decls -> { let (id,dcls) = c in CAst.make ~loc @@ CCoFix (id,dcls) } ] ]
  ;
  appl_arg:
    [ [ test_lpar_id_coloneq; "("; id = identref; ":="; c = lconstr; ")" -> { (c,Some (CAst.make ?loc:id.CAst.loc @@ ExplByName id.CAst.v)) }
      | c=operconstr LEVEL "9" -> { (c,None) } ] ]
  ;
  atomic_constr:
    [ [ g = global; i = univ_instance -> { CAst.make ~loc @@ CRef (g,i) }
      | s = sort   -> { CAst.make ~loc @@  CSort s }
      | n = NUMBER-> { CAst.make ~loc @@ CPrim (Numeral (NumTok.SPlus,n)) }
      | s = string -> { CAst.make ~loc @@ CPrim (String s) }
      | "_"      -> { CAst.make ~loc @@ CHole (None, IntroAnonymous, None) }
      | "?"; "["; id = identref; "]"  -> { CAst.make ~loc @@  CHole (None, IntroIdentifier id.CAst.v, None) }
      | "?"; "["; id = pattern_ident; "]"  -> { CAst.make ~loc @@  CHole (None, IntroFresh id, None) }
      | id = pattern_ident; inst = evar_instance -> { CAst.make ~loc @@ CEvar(id,inst) } ] ]
  ;
  inst:
    [ [ id = identref; ":="; c = lconstr -> { (id,c) } ] ]
  ;
  evar_instance:
    [ [ "@{"; l = LIST1 inst SEP ";"; "}" -> { l }
      | -> { [] } ] ]
  ;
  univ_instance:
    [ [ "@{"; l = LIST0 universe_level; "}" -> { Some l }
      | -> { None } ] ]
  ;
  universe_level:
    [ [ "Set" -> { UNamed GSet }
      (* no parsing SProp as a level *)
      | "Prop" -> { UNamed GProp }
      | "Type" -> { UAnonymous {rigid=true} }
      | "_" -> { UAnonymous {rigid=false} }
      | id = global -> { UNamed (GType id) } ] ]
  ;
  fix_decls:
    [ [ dcl = fix_decl -> { let (id,_,_,_,_) = dcl.CAst.v in (id,[dcl.CAst.v]) }
      | dcl = fix_decl; "with"; dcls = LIST1 fix_decl SEP "with"; "for"; id = identref ->
        { (id,List.map (fun x -> x.CAst.v) (dcl::dcls)) } ] ]
  ;
  cofix_decls:
    [ [ dcl = cofix_decl -> { let (id,_,_,_) = dcl.CAst.v in (id,[dcl.CAst.v]) }
      | dcl = cofix_decl; "with"; dcls = LIST1 cofix_decl SEP "with"; "for"; id = identref ->
        { (id,List.map (fun x -> x.CAst.v) (dcl::dcls)) } ] ]
  ;
  fix_decl:
    [ [ id = identref; bl = binders_fixannot; ty = type_cstr; ":=";
        c = operconstr LEVEL "200" ->
        { CAst.make ~loc (id,snd bl,fst bl,ty,c) } ] ]
  ;
  cofix_decl:
    [ [ id = identref; bl = binders; ty = type_cstr; ":=";
        c = operconstr LEVEL "200" ->
        { CAst.make ~loc (id,bl,ty,c) } ] ]
  ;
  match_constr:
    [ [ "match"; ci = LIST1 case_item SEP ","; ty = OPT case_type; "with";
        br = branches; "end" -> { CAst.make ~loc @@ CCases(RegularStyle,ty,ci,br) } ] ]
  ;
  case_item:
    [ [ c = operconstr LEVEL "100";
        ona = OPT ["as"; id = name -> { id } ];
        ty = OPT ["in"; t = pattern LEVEL "200" -> { t } ] ->
        { (c,ona,ty) } ] ]
  ;
  case_type:
    [ [ "return"; ty = operconstr LEVEL "100" -> { ty } ] ]
  ;
  return_type:
    [ [ a = OPT [ na = OPT["as"; na = name -> { na } ];
                  ty = case_type -> { (na,ty) } ] ->
        { match a with
          | None -> None, None
          | Some (na,t) -> (na, Some t) } ] ]
  ;
  branches:
    [ [ OPT"|"; br = LIST0 eqn SEP "|" -> { br } ] ]
  ;
  mult_pattern:
    [ [ pl = LIST1 pattern LEVEL "200" SEP "," -> { pl } ] ]
  ;
  eqn:
    [ [ pll = LIST1 mult_pattern SEP "|";
        "=>"; rhs = lconstr -> { (CAst.make ~loc (pll,rhs)) } ] ]
  ;
  record_pattern:
    [ [ id = global; ":="; pat = pattern LEVEL "200" -> { (id, pat) } ] ]
  ;
  record_patterns:
    [ [ p = record_pattern; ";"; ps = record_patterns -> { p :: ps }
      | p = record_pattern-> { [p] }
      | -> { [] } ] ]
  ;
  pattern:
    [ "200" RIGHTA [ ]
    | "100" RIGHTA
      [ p = pattern; ":"; ty = operconstr LEVEL "200" ->
        { CAst.make ~loc @@ CPatCast (p, ty) } ]
    | "99" RIGHTA [ ]
    | "90" RIGHTA [ ]
    | "10" LEFTA
      [ p = pattern; "as"; na = name ->
        { CAst.make ~loc @@ CPatAlias (p, na) }
      | p = pattern; lp = LIST1 NEXT -> { mkAppPattern ~loc p lp }
      | "@"; r = Prim.reference; lp = LIST0 NEXT ->
        { CAst.make ~loc @@ CPatCstr (r, Some lp, []) } ]
    | "1" LEFTA
      [ c = pattern; "%"; key = IDENT -> { CAst.make ~loc @@ CPatDelimiters (key,c) } ]
    | "0"
      [ r = Prim.reference                -> { CAst.make ~loc @@ CPatAtom (Some r) }
      | "{|"; pat = record_patterns; bar_cbrace -> { CAst.make ~loc @@ CPatRecord pat }
      | "_" -> { CAst.make ~loc @@ CPatAtom None }
      | "("; p = pattern LEVEL "200"; ")" ->
        { (* Preserve parentheses around numerals so that constrintern does not
             collapse -(3) into the numeral -3. *)
          match p.CAst.v with
          | CPatPrim (Numeral (NumTok.SPlus,n)) ->
              CAst.make ~loc @@ CPatNotation(None,(InConstrEntry,"( _ )"),([p],[]),[])
          | _ -> p }
      | "("; p = pattern LEVEL "200"; "|" ; pl = LIST1 pattern LEVEL "200" SEP "|"; ")" ->
        { CAst.make ~loc @@ CPatOr (p::pl) }
      | n = NUMBER-> { CAst.make ~loc @@ CPatPrim (Numeral (NumTok.SPlus,n)) }
      | s = string -> { CAst.make ~loc @@ CPatPrim (String s) } ] ]
  ;
  fixannot:
    [ [ "{"; IDENT "struct"; id = identref; "}" -> { CAst.make ~loc @@ CStructRec id }
      | "{"; IDENT "wf"; rel = constr; id = identref; "}" -> { CAst.make ~loc @@ CWfRec(id,rel) }
      | "{"; IDENT "measure"; m = constr; id = OPT identref; rel = OPT constr; "}" ->
        { CAst.make ~loc @@ CMeasureRec (id,m,rel) } ] ]
  ;
  binders_fixannot:
    [ [ ensure_fixannot; f = fixannot -> { [], Some f }
      | b = binder; bl = binders_fixannot -> { b @ fst bl, snd bl }
      | -> { [], None } ] ]
  ;
  open_binders:
    (* Same as binders but parentheses around a closed binder are optional if
       the latter is unique *)
    [ [ id = name; idl = LIST0 name; ":"; c = lconstr ->
        { [CLocalAssum (id::idl,Default Explicit,c)] }
        (* binders factorized with open binder *)
      | id = name; idl = LIST0 name; bl = binders ->
        { binders_of_names (id::idl) @ bl }
      | id1 = name; ".."; id2 = name ->
        { [CLocalAssum ([id1;(CAst.make ~loc (Name ldots_var));id2],
                        Default Explicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))] }
      | bl = closed_binder; bl' = binders ->
        { bl@bl' } ] ]
  ;
  binders:
    [ [ l = LIST0 binder -> { List.flatten l } ] ]
  ;
  binder:
    [ [ id = name -> { [CLocalAssum ([id],Default Explicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))] }
      | bl = closed_binder -> { bl } ] ]
  ;
  closed_binder:
    [ [ "("; id = name; idl = LIST1 name; ":"; c = lconstr; ")" ->
        { [CLocalAssum (id::idl,Default Explicit,c)] }
      | "("; id = name; ":"; c = lconstr; ")" ->
        { [CLocalAssum ([id],Default Explicit,c)] }
      | "("; id = name; ":="; c = lconstr; ")" ->
        { match c.CAst.v with
          | CCast(c, CastConv t) -> [CLocalDef (id,c,Some t)]
          | _ -> [CLocalDef (id,c,None)] }
      | "("; id = name; ":"; t = lconstr; ":="; c = lconstr; ")" ->
        { [CLocalDef (id,c,Some t)] }
      | "{"; id = name; "}" ->
        { [CLocalAssum ([id],Default MaxImplicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))] }
      | "{"; id = name; idl = LIST1 name; ":"; c = lconstr; "}" ->
        { [CLocalAssum (id::idl,Default MaxImplicit,c)] }
      | "{"; id = name; ":"; c = lconstr; "}" ->
        { [CLocalAssum ([id],Default MaxImplicit,c)] }
      | "{"; id = name; idl = LIST1 name; "}" ->
        { List.map (fun id -> CLocalAssum ([id],Default MaxImplicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))) (id::idl) }
      | "["; id = name; "]" ->
        { [CLocalAssum ([id],Default NonMaxImplicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))] }
      | "["; id = name; idl = LIST1 name; ":"; c = lconstr; "]" ->
        { [CLocalAssum (id::idl,Default NonMaxImplicit,c)] }
      | "["; id = name; ":"; c = lconstr; "]" ->
        { [CLocalAssum ([id],Default NonMaxImplicit,c)] }
      | "["; id = name; idl = LIST1 name; "]" ->
        { List.map (fun id -> CLocalAssum ([id],Default NonMaxImplicit, CAst.make ~loc @@ CHole (None, IntroAnonymous, None))) (id::idl) }
      | "`("; tc = LIST1 typeclass_constraint SEP "," ; ")" ->
        { List.map (fun (n, b, t) -> CLocalAssum ([n], Generalized (Explicit, b), t)) tc }
      | "`{"; tc = LIST1 typeclass_constraint SEP "," ; "}" ->
        { List.map (fun (n, b, t) -> CLocalAssum ([n], Generalized (MaxImplicit, b), t)) tc }
      | "`["; tc = LIST1 typeclass_constraint SEP "," ; "]" ->
        { List.map (fun (n, b, t) -> CLocalAssum ([n], Generalized (NonMaxImplicit, b), t)) tc }
      | "'"; p = pattern LEVEL "0" ->
        { let (p, ty) =
            match p.CAst.v with
            | CPatCast (p, ty) -> (p, Some ty)
            | _ -> (p, None)
          in
          [CLocalPattern (CAst.make ~loc (p, ty))] } ] ]
  ;
  typeclass_constraint:
    [ [ "!" ; c = operconstr LEVEL "200" -> { (CAst.make ~loc Anonymous), true, c }
      | "{"; id = name; "}"; ":" ; expl = [ "!" -> { true } | -> { false } ] ; c = operconstr LEVEL "200" ->
          { id, expl, c }
      | test_name_colon; iid = name; ":" ; expl = [ "!" -> { true } | -> { false } ] ; c = operconstr LEVEL "200" ->
          { iid, expl, c }
      | c = operconstr LEVEL "200" ->
          { (CAst.make ~loc Anonymous), false, c } ] ]
  ;
  type_cstr:
    [ [ ":"; c = lconstr -> { c }
      | -> { CAst.make ~loc @@ CHole (None, IntroAnonymous, None) } ] ]
  ;
  let_type_cstr:
    [ [ c = OPT [":"; c = lconstr -> { c } ] -> { Loc.tag ~loc c } ] ]
  ;
  END