Added input syntax for specifying the last type variable of a type constructor.
This commit is contained in:
parent
d0fc49b78c
commit
479c60b2f3
|
@ -82,8 +82,10 @@ signature HIDE_TVAR = sig
|
||||||
val lookup : theory -> string -> hide_varT option
|
val lookup : theory -> string -> hide_varT option
|
||||||
val hide_tvar_tr' : string -> Proof.context -> term list -> term
|
val hide_tvar_tr' : string -> Proof.context -> term list -> term
|
||||||
val hide_tvar_ast_tr : Proof.context -> Ast.ast list -> Ast.ast
|
val hide_tvar_ast_tr : Proof.context -> Ast.ast list -> Ast.ast
|
||||||
val hide_tvar_subst_ast_tr : tvar_subst -> Proof.context -> Ast.ast list -> Ast.ast
|
val hide_tvar_subst_ast_tr : tvar_subst -> Proof.context -> Ast.ast list
|
||||||
|
-> Ast.ast
|
||||||
|
val hide_tvar_subst_return_ast_tr : tvar_subst -> Proof.context
|
||||||
|
-> Ast.ast list -> Ast.ast
|
||||||
end
|
end
|
||||||
|
|
||||||
structure Hide_Tvar : HIDE_TVAR = struct
|
structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
|
@ -378,7 +380,7 @@ structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
handle Symtab.DUP _ => error("Type shorthand already registered: "^name)
|
handle Symtab.DUP _ => error("Type shorthand already registered: "^name)
|
||||||
end
|
end
|
||||||
|
|
||||||
fun hide_tvar_subst_ast_tr hole ctx (ast::[]) =
|
fun hide_tvar_subst_ast_tr hole ctx (ast::[]) =
|
||||||
let
|
let
|
||||||
|
|
||||||
val thy = Proof_Context.theory_of ctx
|
val thy = Proof_Context.theory_of ctx
|
||||||
|
@ -404,11 +406,20 @@ structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
end
|
end
|
||||||
| hide_tvar_subst_ast_tr _ _ _ = error("hide_tvar_subst_ast_tr: empty AST.")
|
| hide_tvar_subst_ast_tr _ _ _ = error("hide_tvar_subst_ast_tr: empty AST.")
|
||||||
|
|
||||||
|
fun hide_tvar_subst_return_ast_tr hole ctx (retval::constructor::[]) =
|
||||||
|
hide_tvar_subst_ast_tr hole ctx [Ast.Appl (constructor::retval::[])]
|
||||||
|
| hide_tvar_subst_return_ast_tr _ _ _ =
|
||||||
|
error("hide_tvar_subst_return_ast_tr: error in parsing AST")
|
||||||
|
|
||||||
|
|
||||||
end
|
end
|
||||||
\<close>
|
\<close>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subsection\<open>Register Parse Translations\<close>
|
subsection\<open>Register Parse Translations\<close>
|
||||||
syntax "_tvars_wildcard" :: "type \<Rightarrow> type" ("'('_') _")
|
syntax "_tvars_wildcard" :: "type \<Rightarrow> type" ("'('_') _")
|
||||||
|
syntax "_tvars_wildcard_retval" :: "type \<Rightarrow> type \<Rightarrow> type" ("'('_, _') _")
|
||||||
syntax "_tvars_wildcard_sort" :: "sort \<Rightarrow> type \<Rightarrow> type" ("'('_::_') _")
|
syntax "_tvars_wildcard_sort" :: "sort \<Rightarrow> type \<Rightarrow> type" ("'('_::_') _")
|
||||||
syntax "_tvars_wildcard_right" :: "type \<Rightarrow> type" ("_ '_.")
|
syntax "_tvars_wildcard_right" :: "type \<Rightarrow> type" ("_ '_.")
|
||||||
syntax "_tvars_wildcard_left" :: "type \<Rightarrow> type" ("_ .'_")
|
syntax "_tvars_wildcard_left" :: "type \<Rightarrow> type" ("_ .'_")
|
||||||
|
@ -417,6 +428,7 @@ parse_ast_translation\<open>
|
||||||
[
|
[
|
||||||
(@{syntax_const "_tvars_wildcard_sort"}, Hide_Tvar.hide_tvar_ast_tr),
|
(@{syntax_const "_tvars_wildcard_sort"}, Hide_Tvar.hide_tvar_ast_tr),
|
||||||
(@{syntax_const "_tvars_wildcard"}, Hide_Tvar.hide_tvar_ast_tr),
|
(@{syntax_const "_tvars_wildcard"}, Hide_Tvar.hide_tvar_ast_tr),
|
||||||
|
(@{syntax_const "_tvars_wildcard_retval"}, Hide_Tvar.hide_tvar_subst_return_ast_tr Hide_Tvar.right),
|
||||||
(@{syntax_const "_tvars_wildcard_right"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.right),
|
(@{syntax_const "_tvars_wildcard_right"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.right),
|
||||||
(@{syntax_const "_tvars_wildcard_left"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.left)
|
(@{syntax_const "_tvars_wildcard_left"}, Hide_Tvar.hide_tvar_subst_ast_tr Hide_Tvar.left)
|
||||||
]
|
]
|
||||||
|
@ -517,5 +529,9 @@ definition E :: "(_::linorder) baz \<Rightarrow> (_::linorder) foobar \<Rightarr
|
||||||
assert[string_of_thm_equal,
|
assert[string_of_thm_equal,
|
||||||
thm_def="C_def", str="C (x::(_) baz) (y::(_) foobar) = x"]
|
thm_def="C_def", str="C (x::(_) baz) (y::(_) foobar) = x"]
|
||||||
|
|
||||||
|
definition X :: "(_, 'retval::linorder) baz
|
||||||
|
\<Rightarrow> (_,'retval) foobar
|
||||||
|
\<Rightarrow> (_,'retval) baz"
|
||||||
|
where "X x y = x"
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
Loading…
Reference in New Issue