return_term loc (CicAst.LetRec (ind_kind, defs, body))
| outtyp = OPT [ PAREN "["; typ = term; PAREN "]" -> typ ];
"match"; t = term;
- SYMBOL ":"; indty = IDENT;
+ indty_ident = OPT [ SYMBOL ":"; id = IDENT -> id ];
"with";
PAREN "[";
patterns = LIST0 [
] SEP SYMBOL "|";
PAREN "]" ->
return_term loc
- (CicAst.Case (t, indty, outtyp, patterns))
+ (CicAst.Case (t, indty_ident, outtyp, patterns))
| PAREN "("; t = term; PAREN ")" -> return_term loc t
]
];
do_branch' context args
in
let (indtype_uri, indtype_no) =
- match resolve env (Id indty_ident) () with
- | Cic.MutInd (uri, tyno, _) -> uri, tyno
- | Cic.Implicit _ -> raise Try_again
- | _ -> raise DisambiguateChoices.Invalid_choice
+ match indty_ident with
+ | Some indty_ident ->
+ (match resolve env (Id indty_ident) () with
+ | Cic.MutInd (uri, tyno, _) -> (uri, tyno)
+ | Cic.Implicit _ -> raise Try_again
+ | _ -> raise DisambiguateChoices.Invalid_choice)
+ | None ->
+ let fst_constructor =
+ match branches with
+ | ((head, _), _) :: _ -> head
+ | [] -> raise DisambiguateChoices.Invalid_choice
+ in
+ (match resolve env (Id fst_constructor) () with
+ | Cic.MutConstruct (indtype_uri, indtype_no, _, _) ->
+ (indtype_uri, indtype_no)
+ | Cic.Implicit _ -> raise Try_again
+ | _ -> raise DisambiguateChoices.Invalid_choice)
in
Cic.MutCase (indtype_uri, indtype_no, cic_outtype, cic_term,
(List.map do_branch branches))
let branches_dom =
List.fold_left (fun dom branch -> do_branch branch @ dom) [] branches
in
- branches_dom @ outtype_dom @ term_dom @ [ Id indty_ident ]
+ branches_dom @ outtype_dom @ term_dom @
+ (match indty_ident with None -> [] | Some ident -> [ Id ident ])
| CicAst.LetIn ((var, typ), body, where) ->
let body_dom = aux loc context body in
let type_dom = aux_option loc context typ in
((name, capture_variables), rhs))
constructors patterns
in
- idref id (Ast.Case (aux te, name, Some (aux ty), patterns))
+ idref id (Ast.Case (aux te, Some name, Some (aux ty), patterns))
| Cic.AFix (id, no, funs) ->
let defs =
List.map
| Appl of term list
| Binder of binder_kind * capture_variable * term (* kind, name, body *)
- | Case of term * string * term option * (case_pattern * term) list
+ | Case of term * string option * term option * (case_pattern * term) list
(* what to match, inductive type, out type, <pattern,action> list *)
| LetIn of capture_variable * term * term (* name, body, where *)
| LetRec of induction_kind * (capture_variable * term * int) list * term