Made top-level user interface more consistent.
This commit is contained in:
parent
92ea551113
commit
66307c1c2b
|
@ -49,8 +49,8 @@ text\<open>This theory implements a mechanism for declaring default type
|
||||||
section\<open>Theory Managed Data Structure\<close>
|
section\<open>Theory Managed Data Structure\<close>
|
||||||
ML\<open>
|
ML\<open>
|
||||||
signature HIDE_TVAR = sig
|
signature HIDE_TVAR = sig
|
||||||
datatype print_mode = always | default_only | noprint
|
datatype print_mode = print_all | print | noprint
|
||||||
datatype parse_mode = active | noparse
|
datatype parse_mode = parse | noparse
|
||||||
type hide_varT = {
|
type hide_varT = {
|
||||||
name: string,
|
name: string,
|
||||||
tvars: typ list,
|
tvars: typ list,
|
||||||
|
@ -70,8 +70,8 @@ signature HIDE_TVAR = sig
|
||||||
end
|
end
|
||||||
|
|
||||||
structure Hide_Tvar : HIDE_TVAR = struct
|
structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
datatype print_mode = always | default_only | noprint
|
datatype print_mode = print_all | print | noprint
|
||||||
datatype parse_mode = active | noparse
|
datatype parse_mode = parse | noparse
|
||||||
type hide_varT = {
|
type hide_varT = {
|
||||||
name: string,
|
name: string,
|
||||||
tvars: typ list,
|
tvars: typ list,
|
||||||
|
@ -92,14 +92,14 @@ structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|
||||||
fun parse_print_mode "always" = always
|
fun parse_print_mode "print_all" = print_all
|
||||||
| parse_print_mode "default_only" = default_only
|
| parse_print_mode "print" = print
|
||||||
| parse_print_mode "noprint" = noprint
|
| parse_print_mode "noprint" = noprint
|
||||||
| parse_print_mode s = error("Print mode not supported: "^s)
|
| parse_print_mode s = error("Print mode not supported: "^s)
|
||||||
|
|
||||||
fun parse_parse_mode "active" = active
|
fun parse_parse_mode "parse" = parse
|
||||||
| parse_parse_mode "noparse" = noparse
|
| parse_parse_mode "noparse" = noparse
|
||||||
| parse_parse_mode s = error("Parse mode not supported: "^s)
|
| parse_parse_mode s = error("Parse mode not supported: "^s)
|
||||||
|
|
||||||
fun update_mode typ_str print_mode parse_mode thy =
|
fun update_mode typ_str print_mode parse_mode thy =
|
||||||
let
|
let
|
||||||
|
@ -249,8 +249,8 @@ structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
| SOME (s,_) => local_name_of s
|
| SOME (s,_) => local_name_of s
|
||||||
in
|
in
|
||||||
case (#print_mode e) of
|
case (#print_mode e) of
|
||||||
always => hide_type tname
|
print_all => hide_type tname
|
||||||
| default_only => hide_type tname (* TODO *)
|
| print => hide_type tname (* TODO *)
|
||||||
| noprint => raise Match
|
| noprint => raise Match
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
@ -293,10 +293,10 @@ structure Hide_Tvar : HIDE_TVAR = struct
|
||||||
|
|
||||||
val print_m = case print_mode of
|
val print_m = case print_mode of
|
||||||
SOME m => m
|
SOME m => m
|
||||||
| NONE => always
|
| NONE => print_all
|
||||||
val parse_m = case parse_mode of
|
val parse_m = case parse_mode of
|
||||||
SOME m => m
|
SOME m => m
|
||||||
| NONE => active
|
| NONE => parse
|
||||||
val entry = {
|
val entry = {
|
||||||
name = name,
|
name = name,
|
||||||
tvars = tvars,
|
tvars = tvars,
|
||||||
|
@ -360,7 +360,7 @@ ML\<open>
|
||||||
|-- (Parse.name --| Parse.$$$ ","
|
|-- (Parse.name --| Parse.$$$ ","
|
||||||
-- Parse.name --|
|
-- Parse.name --|
|
||||||
Parse.$$$ ")"))
|
Parse.$$$ ")"))
|
||||||
val typ_modeP = Parse.typ -- (Scan.optional modeP ("always","active"))
|
val typ_modeP = Parse.typ -- (Scan.optional modeP ("print_all","parse"))
|
||||||
|
|
||||||
val _ = Outer_Syntax.command @{command_keyword "register_default_tvars"}
|
val _ = Outer_Syntax.command @{command_keyword "register_default_tvars"}
|
||||||
"Register default variables (and hiding mechanims) for a type."
|
"Register default variables (and hiding mechanims) for a type."
|
||||||
|
@ -396,8 +396,8 @@ assert[string_of_thm_equal,
|
||||||
thm_def="g_def",
|
thm_def="g_def",
|
||||||
str="g (a::('a + 'b, 'a \<times> 'b) foobar) (b::('a + 'b, 'a \<times> 'b) foobar) = a"]
|
str="g (a::('a + 'b, 'a \<times> 'b) foobar) (b::('a + 'b, 'a \<times> 'b) foobar) = a"]
|
||||||
|
|
||||||
register_default_tvars "('alpha, 'beta) foobar" (always,active)
|
register_default_tvars "('alpha, 'beta) foobar" (print_all,parse)
|
||||||
register_default_tvars "('alpha, 'beta, 'gamma, 'delta) baz" (always,active)
|
register_default_tvars "('alpha, 'beta, 'gamma, 'delta) baz" (print_all,parse)
|
||||||
|
|
||||||
update_default_tvars_mode "_ foobar" (noprint,noparse)
|
update_default_tvars_mode "_ foobar" (noprint,noparse)
|
||||||
assert[string_of_thm_equal,
|
assert[string_of_thm_equal,
|
||||||
|
@ -407,7 +407,7 @@ assert[string_of_thm_equal,
|
||||||
thm_def="g_def",
|
thm_def="g_def",
|
||||||
str="g (a::('a + 'b, 'a \<times> 'b) foobar) (b::('a + 'b, 'a \<times> 'b) foobar) = a"]
|
str="g (a::('a + 'b, 'a \<times> 'b) foobar) (b::('a + 'b, 'a \<times> 'b) foobar) = a"]
|
||||||
|
|
||||||
update_default_tvars_mode "_ foobar" (always,noparse)
|
update_default_tvars_mode "_ foobar" (print_all,noparse)
|
||||||
|
|
||||||
assert[string_of_thm_equal,
|
assert[string_of_thm_equal,
|
||||||
thm_def="f_def", str="f (a::(_) foobar) (b::(_) foobar) = a"]
|
thm_def="f_def", str="f (a::(_) foobar) (b::(_) foobar) = a"]
|
||||||
|
@ -415,7 +415,7 @@ assert[string_of_thm_equal,
|
||||||
thm_def="g_def", str="g (a::(_) baz) (b::(_) baz) = a"]
|
thm_def="g_def", str="g (a::(_) baz) (b::(_) baz) = a"]
|
||||||
|
|
||||||
subsection\<open>Parse Translation\<close>
|
subsection\<open>Parse Translation\<close>
|
||||||
update_default_tvars_mode "_ foobar" (noprint,active)
|
update_default_tvars_mode "_ foobar" (print_all,parse)
|
||||||
|
|
||||||
declare [[show_types]]
|
declare [[show_types]]
|
||||||
definition A :: "'alpha \<Rightarrow> (_) foobar"
|
definition A :: "'alpha \<Rightarrow> (_) foobar"
|
||||||
|
|
Loading…
Reference in New Issue