X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_disambiguation%2FcicTextualParser2.ml;h=feb161d7fe84aaa022271e5d7338b839a0f9e17b;hb=358cefe50cccd4cb7d8e2a9cecb7efcb5780b8a3;hp=238eb93673f6f46830c3f6784d32e187f479e0fb;hpb=21fac7762b3376d0c7d2eee4066aae9ce7268ba8;p=helm.git diff --git a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml index 238eb9367..feb161d7f 100644 --- a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml +++ b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml @@ -171,14 +171,16 @@ EXTEND (head, vars) ] ]; + arg: [ + [ PAREN "(" ; names = LIST1 IDENT SEP SYMBOL ","; + SYMBOL ":"; ty = term; PAREN ")" -> names,ty + | name = IDENT -> [name],CicAst.Implicit + ] + ]; let_defs:[ [ defs = LIST1 [ name = IDENT; - args = LIST1 [ - PAREN "(" ; names = LIST1 IDENT SEP SYMBOL ","; SYMBOL ":"; - ty = term; PAREN ")" -> - (names, ty) - ]; + args = LIST1 [arg = arg -> arg]; index_name = OPT [ IDENT "on"; idx = IDENT -> idx ]; ty = OPT [ SYMBOL ":" ; t = term -> t ]; SYMBOL <:unicode> (* ≝ *); @@ -279,6 +281,7 @@ EXTEND | n = substituted_name -> return_term loc n | i = NUM -> return_term loc (CicAst.Num (i, (fresh_num_instance ()))) | IMPLICIT -> return_term loc CicAst.Implicit + | PLACEHOLDER -> return_term loc CicAst.UserInput | m = META; substs = [ PAREN "["; substs = LIST0 meta_subst SEP SYMBOL ";" ; PAREN "]" -> @@ -293,7 +296,7 @@ EXTEND return_term loc (CicAst.Meta (index, substs)) | outtyp = OPT [ PAREN "["; typ = term; PAREN "]" -> typ ]; "match"; t = term; - indty_ident = OPT [ SYMBOL ":"; id = IDENT -> id ]; + indty_ident = OPT ["in" ; id = IDENT -> id ]; "with"; PAREN "["; patterns = LIST0 [ @@ -322,7 +325,8 @@ EXTEND reduction_kind: [ [ [ IDENT "reduce" ] -> `Reduce | [ IDENT "simplify" ] -> `Simpl - | [ IDENT "whd" ] -> `Whd ] + | [ IDENT "whd" ] -> `Whd + | [ IDENT "normalize" ] -> `Normalize ] ]; tactic: [ [ [ IDENT "absurd" ]; t = tactic_term -> @@ -375,8 +379,8 @@ EXTEND | [ IDENT "intro" ] -> TacticAst.Intros (loc, Some 1, []) | [ IDENT "left" ] -> TacticAst.Left loc - | [ "let" | "Let" ]; - t = tactic_term; "in"; where = IDENT -> + | [ IDENT "letin" ]; + where = IDENT ; SYMBOL <:unicode> ; t = tactic_term -> TacticAst.LetIn (loc, t, where) | kind = reduction_kind; pat = OPT [ @@ -389,6 +393,8 @@ EXTEND | None, terms -> TacticAst.Reduce (loc, kind, Some (terms, `Goal)) | Some pat, [] -> fail loc "Missing term [list]" | Some pat, terms -> TacticAst.Reduce (loc, kind, Some (terms, pat))) + | kind = reduction_kind; where = IDENT ; IDENT "at" ; pat = term -> + TacticAst.ReduceAt (loc, kind, where, pat) | [ IDENT "reflexivity" ] -> TacticAst.Reflexivity loc | [ IDENT "replace" ]; @@ -446,9 +452,7 @@ EXTEND ] ]; inductive_spec: [ [ - fst_name = IDENT; params = LIST0 [ - PAREN "("; names = LIST1 IDENT SEP SYMBOL ","; SYMBOL ":"; - typ = term; PAREN ")" -> (names, typ) ]; + fst_name = IDENT; params = LIST0 [ arg=arg -> arg ]; SYMBOL ":"; fst_typ = term; SYMBOL <:unicode>; OPT SYMBOL "|"; fst_constructors = LIST0 constructor SEP SYMBOL "|"; tl = OPT [ "with"; @@ -468,7 +472,22 @@ EXTEND let ind_types = fst_ind_type :: tl_ind_types in (params, ind_types) ] ]; - + + record_spec: [ [ + name = IDENT; params = LIST0 [ arg = arg -> arg ] ; + SYMBOL ":"; typ = term; SYMBOL <:unicode>; PAREN "{" ; + fields = LIST0 [ + name = IDENT ; SYMBOL ":" ; ty = term -> (name,ty) + ] SEP SYMBOL ";"; PAREN "}" -> + let params = + List.fold_right + (fun (names, typ) acc -> + (List.map (fun name -> (name, typ)) names) @ acc) + params [] + in + (params,name,typ,fields) + ] ]; + macro: [ [ [ IDENT "quit" ] -> TacticAst.Quit loc (* | [ IDENT "abort" ] -> TacticAst.Abort loc *) @@ -534,38 +553,42 @@ EXTEND [ IDENT "set" ]; n = QSTRING; v = QSTRING -> TacticAst.Set (loc, n, v) | [ IDENT "qed" ] -> TacticAst.Qed loc - | flavour = theorem_flavour; name = OPT IDENT; SYMBOL ":"; typ = term; + | flavour = theorem_flavour; name = IDENT; SYMBOL ":"; typ = term; + body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> + TacticAst.Obj (loc,TacticAst.Theorem (flavour, name, typ, body)) + | flavour = theorem_flavour; name = IDENT; body = OPT [ SYMBOL <:unicode> (* ≝ *); body = term -> body ] -> - TacticAst.Theorem (loc, flavour, name, typ, body) + TacticAst.Obj (loc,TacticAst.Theorem (flavour, name, CicAst.Implicit, body)) | "let"; ind_kind = [ "corec" -> `CoInductive | "rec"-> `Inductive ]; defs = let_defs -> let name,ty = match defs with | ((Cic.Name name,Some ty),_,_) :: _ -> name,ty - | ((Cic.Name name,None),_,_) :: _ -> - fail loc ("No type given for " ^ name) + | ((Cic.Name name,None),_,_) :: _ -> name,CicAst.Implicit | _ -> assert false in let body = CicAst.Ident (name,None) in - TacticAst.Theorem(loc, `Definition, Some name, ty, - Some (CicAst.LetRec (ind_kind, defs, body))) + TacticAst.Obj (loc,TacticAst.Theorem(`Definition, name, ty, + Some (CicAst.LetRec (ind_kind, defs, body)))) | [ IDENT "inductive" ]; spec = inductive_spec -> let (params, ind_types) = spec in - TacticAst.Inductive (loc, params, ind_types) + TacticAst.Obj (loc,TacticAst.Inductive (params, ind_types)) | [ IDENT "coinductive" ]; spec = inductive_spec -> let (params, ind_types) = spec in let ind_types = (* set inductive flags to false (coinductive) *) List.map (fun (name, _, term, ctors) -> (name, false, term, ctors)) ind_types in - TacticAst.Inductive (loc, params, ind_types) + TacticAst.Obj (loc,TacticAst.Inductive (params, ind_types)) | [ IDENT "coercion" ] ; name = IDENT -> TacticAst.Coercion (loc, CicAst.Ident (name,Some [])) | [ IDENT "coercion" ] ; name = URI -> TacticAst.Coercion (loc, CicAst.Uri (name,Some [])) | [ IDENT "alias" ]; spec = alias_spec -> TacticAst.Alias (loc, spec) + | [ IDENT "record" ]; (params,name,ty,fields) = record_spec -> + TacticAst.Obj (loc,TacticAst.Record (params,name,ty,fields)) ]]; executable: [