X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_disambiguation%2FcicTextualParser2.ml;h=2bcbb88e8da8a984c5b29c77a4620cd5be539652;hb=6f0f31787fb03ea4956227e8fcdbc12abd366931;hp=507d897fbdea8104181ae767e427e3ed9d3b6957;hpb=444a1e5087b872a07ce43dda40211f9e3613d647;p=helm.git diff --git a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml index 507d897fb..2bcbb88e8 100644 --- a/helm/ocaml/cic_disambiguation/cicTextualParser2.ml +++ b/helm/ocaml/cic_disambiguation/cicTextualParser2.ml @@ -46,12 +46,16 @@ let term0 = Grammar.Entry.create grammar "term0" (* let tactic = Grammar.Entry.create grammar "tactic" *) (* let tactical = Grammar.Entry.create grammar "tactical" *) -let return_term loc term = CicTextualParser2Ast.LocatedTerm (loc, term) +let return_term loc term = CicAst.AttributedTerm (`Loc loc, term) (* let return_term loc term = term *) let fail (x, y) msg = failwith (Printf.sprintf "Error at characters %d - %d: %s" x y msg) +let name_of_string = function + | "_" -> Cic.Anonymous + | s -> Cic.Name s + EXTEND GLOBAL: term term0; meta_subst: [ @@ -65,6 +69,12 @@ EXTEND | SYMBOL <:unicode> (* ∀ *) -> `Forall ] ]; + typed_name: [ + [ PAREN "("; i = IDENT; SYMBOL ":"; typ = term; PAREN ")" -> + (name_of_string i, Some typ) + | i = IDENT -> (name_of_string i, None) + ] + ]; substituted_name: [ (* a subs.name is an explicit substitution subject *) [ s = [ IDENT | SYMBOL ]; subst = OPT [ @@ -77,45 +87,48 @@ EXTEND substs ] -> (match subst with - | Some l -> CicTextualParser2Ast.Ident (s, l) - | None -> CicTextualParser2Ast.Ident (s, [])) + | Some l -> CicAst.Ident (s, l) + | None -> CicAst.Ident (s, [])) ] ]; name: [ (* as substituted_name with no explicit substitution *) [ s = [ IDENT | SYMBOL ] -> s ] ]; pattern: [ - [ n = name -> [n] - | PAREN "("; names = LIST1 name; PAREN ")" -> names ] + [ n = name -> (n, []) + | PAREN "("; head = name; vars = LIST1 typed_name; PAREN ")" -> + (head, vars) + ] ]; term0: [ [ t = term -> return_term loc t ] ]; term: [ "arrow" RIGHTA [ t1 = term; SYMBOL <:unicode>; t2 = term -> return_term loc - (CicTextualParser2Ast.Binder (`Pi, Cic.Anonymous, Some t1, t2)) + (CicAst.Binder (`Pi, (Cic.Anonymous, Some t1), t2)) ] | "binder" RIGHTA [ - b = binder; vars = LIST1 IDENT SEP SYMBOL ","; - typ = OPT [ SYMBOL ":"; t = term -> t ]; + b = binder; + (vars, typ) = + [ vars = LIST1 IDENT SEP SYMBOL ","; + typ = OPT [ SYMBOL ":"; t = term -> t ] -> (vars, typ) + | PAREN "("; vars = LIST1 IDENT SEP SYMBOL ","; + typ = OPT [ SYMBOL ":"; t = term -> t ]; PAREN ")" -> (vars, typ) + ]; SYMBOL "."; body = term -> let binder = List.fold_right (fun var body -> - let name = - match var with - | "_" -> Cic.Anonymous - | var -> Cic.Name var - in - CicTextualParser2Ast.Binder (b, name, typ, body)) + let name = name_of_string var in + CicAst.Binder (b, (name, typ), body)) vars body in return_term loc binder ] | "eq" LEFTA [ t1 = term; SYMBOL "="; t2 = term -> - return_term loc (CicTextualParser2Ast.Appl_symbol ("eq", 0, [t1; t2])) + return_term loc (CicAst.Appl [CicAst.Symbol ("eq", 0); t1; t2]) ] | "add" LEFTA [ (* nothing here by default *) ] | "mult" LEFTA [ (* nothing here by default *) ] @@ -125,11 +138,12 @@ EXTEND sort_kind = [ "Prop" -> `Prop | "Set" -> `Set | "Type" -> `Type | "CProp" -> `CProp ] -> - CicTextualParser2Ast.Sort sort_kind + CicAst.Sort sort_kind | n = substituted_name -> return_term loc n | PAREN "("; head = term; args = LIST1 term; PAREN ")" -> - return_term loc (CicTextualParser2Ast.Appl (head :: args)) - | i = NUM -> return_term loc (CicTextualParser2Ast.Num (i, 0)) + return_term loc (CicAst.Appl (head :: args)) + | i = NUM -> return_term loc (CicAst.Num (i, 0)) + | IMPLICIT -> return_term loc CicAst.Implicit | m = META; substs = [ PAREN "["; substs = LIST0 meta_subst SEP SYMBOL ";" ; PAREN "]" -> @@ -141,41 +155,40 @@ EXTEND with Failure "int_of_string" -> fail loc ("Invalid meta variable number: " ^ m) in - return_term loc (CicTextualParser2Ast.Meta (index, substs)) + return_term loc (CicAst.Meta (index, substs)) (* actually "in" and "and" are _not_ keywords. Parsing works anyway * since applications are required to be bound by parens *) - | "let"; name = IDENT; + | "let"; var = typed_name; (* SYMBOL <:unicode> (* ≝ *); *) SYMBOL "="; t1 = term; IDENT "in"; t2 = term -> - return_term loc (CicTextualParser2Ast.LetIn (name, t1, t2)) + return_term loc (CicAst.LetIn (var, t1, t2)) | "let"; ind_kind = [ "corec" -> `CoInductive | "rec"-> `Inductive ]; defs = LIST1 [ - name = IDENT; + var = typed_name; index = OPT [ PAREN "("; index = NUM; PAREN ")" -> int_of_string index ]; - typ = OPT [ SYMBOL ":"; typ = term -> typ ]; (* SYMBOL <:unicode> (* ≝ *); *) SYMBOL "="; t1 = term -> - (name, t1, typ, (match index with None -> 1 | Some i -> i)) + (var, t1, (match index with None -> 0 | Some i -> i)) ] SEP (IDENT "and"); IDENT "in"; body = term -> - return_term loc (CicTextualParser2Ast.LetRec (ind_kind, defs, body)) + return_term loc (CicAst.LetRec (ind_kind, defs, body)) | outtyp = OPT [ PAREN "["; typ = term; PAREN "]" -> typ ]; "match"; t = term; SYMBOL ":"; indty = IDENT; "with"; PAREN "["; patterns = LIST0 [ - p = pattern; SYMBOL <:unicode> (* ⇒ *); t = term -> - (p, t) + lhs = pattern; SYMBOL <:unicode> (* ⇒ *); rhs = term -> + ((lhs: CicAst.case_pattern), rhs) ] SEP SYMBOL "|"; PAREN "]" -> return_term loc - (CicTextualParser2Ast.Case (t, indty, outtyp, patterns)) + (CicAst.Case (t, indty, outtyp, patterns)) | PAREN "("; t = term; PAREN ")" -> return_term loc t ] ];