X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=inline;f=helm%2Fsoftware%2Fcomponents%2Fgrafite_parser%2FgrafiteParser.ml;h=dfef4d237a0ea34c8883b2b23b1e734fb46b8fcd;hb=72cd94b68037956a70b98cfa54f316fd54e52bae;hp=ea74231adb46762d2a5c41e7af435b0855a38e62;hpb=df1201e37d6f2631dc31ffc87b979a6c81180a3a;p=helm.git diff --git a/helm/software/components/grafite_parser/grafiteParser.ml b/helm/software/components/grafite_parser/grafiteParser.ml index ea74231ad..dfef4d237 100644 --- a/helm/software/components/grafite_parser/grafiteParser.ml +++ b/helm/software/components/grafite_parser/grafiteParser.ml @@ -51,11 +51,11 @@ type 'status parser_status = { statement : #LE.status as 'status statement Grammar.Entry.e; } -let grafite_callback = ref (fun _ _ -> ()) -let set_grafite_callback cb = grafite_callback := Obj.magic cb +let grafite_callback = ref (fun _ -> ()) +let set_grafite_callback cb = grafite_callback := cb -let lexicon_callback = ref (fun _ _ -> ()) -let set_lexicon_callback cb = lexicon_callback := Obj.magic cb +let lexicon_callback = ref (fun _ -> ()) +let set_lexicon_callback cb = lexicon_callback := cb let initial_parser () = let grammar = CicNotationParser.level2_ast_grammar () in @@ -262,8 +262,12 @@ EXTEND G.NLetIn (loc,where,t,name) | kind = nreduction_kind; p = pattern_spec -> G.NReduce (loc, kind, p) - | IDENT "nrewrite"; dir = direction; what = tactic_term ; where = pattern_spec -> + | IDENT "nrewrite"; dir = direction; what = tactic_term ; where = pattern_spec -> G.NRewrite (loc, dir, what, where) + | IDENT "ntry"; tac = SELF -> G.NTry (loc,tac) + | IDENT "nrepeat"; tac = SELF -> G.NRepeat (loc,tac) + | LPAREN; l = LIST1 SELF; RPAREN -> G.NBlock (loc,l) + | IDENT "nassumption" -> G.NAssumption loc | SYMBOL "#"; n=IDENT -> G.NIntro (loc,n) | SYMBOL "#"; SYMBOL "_" -> G.NIntro (loc,"_") | SYMBOL "*" -> G.NCase1 (loc,"_") @@ -825,6 +829,11 @@ EXTEND G.NUnivConstraint (loc, strict,u1,u2) | IDENT "unification"; IDENT "hint"; n = int; t = tactic_term -> G.UnificationHint (loc, t, n) + | IDENT "ncoercion"; name = IDENT; SYMBOL ":"; ty = term; + SYMBOL <:unicode>; t = term; "on"; + id = [ IDENT | PIDENT ]; SYMBOL ":"; source = term; + "to"; target = term -> + G.NCoercion(loc,name,t,ty,(id,source),target) | IDENT "nrecord" ; (params,name,ty,fields) = record_spec -> G.NObj (loc, N.Record (params,name,ty,fields)) ]]; @@ -938,33 +947,35 @@ EXTEND [ ex = executable -> fun ?(never_include=false) ~include_paths status -> let stm = G.Executable (loc, ex) in - Obj.magic !grafite_callback status stm; + !grafite_callback stm; status, LSome stm | com = comment -> fun ?(never_include=false) ~include_paths status -> let stm = G.Comment (loc, com) in - Obj.magic !grafite_callback status stm; + !grafite_callback stm; status, LSome stm | (iloc,fname,normal,mode) = include_command ; SYMBOL "." -> fun ?(never_include=false) ~include_paths status -> + let _root, buri, fullpath, _rrelpath = + Librarian.baseuri_of_script ~include_paths fname in + if never_include then raise (NoInclusionPerformed fullpath) + else + begin let stm = - G.Executable (loc, G.Command (loc, G.Include (iloc, normal, fname))) - in - Obj.magic !grafite_callback status stm; - let _root, buri, fullpath, _rrelpath = - Librarian.baseuri_of_script ~include_paths fname - in + G.Executable + (loc, G.Command (loc, G.Include (iloc,normal,`OldAndNew,fname))) in + !grafite_callback stm; let status = - if never_include then raise (NoInclusionPerformed fullpath) - else LE.eval_command status (L.Include (iloc,buri,mode,fullpath)) - in + LE.eval_command status (L.Include (iloc,buri,mode,fullpath)) in let stm = - G.Executable (loc, G.Command (loc, G.Include (iloc, normal, buri))) + G.Executable + (loc,G.Command (loc,G.Include (iloc,normal,`OldAndNew,buri))) in - status, LSome stm + status, LSome stm + end | scom = lexicon_command ; SYMBOL "." -> fun ?(never_include=false) ~include_paths status -> - !lexicon_callback status scom; + !lexicon_callback scom; let status = LE.eval_command status scom in status, LNone loc | EOI -> raise End_of_file