51 lines
1.7 KiB
Plaintext
51 lines
1.7 KiB
Plaintext
(*
|
|
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
|
|
*
|
|
* SPDX-License-Identifier: BSD-2-Clause
|
|
*)
|
|
|
|
theory ShowTypes_Test
|
|
imports
|
|
Lib.ShowTypes
|
|
CLib.LemmaBucket_C
|
|
CParser.CTranslation
|
|
begin
|
|
|
|
text \<open>
|
|
Simple demo and test. The main HOL theories don't have that much
|
|
hidden polymorphism, so we use l4.verified.
|
|
\<close>
|
|
|
|
experiment
|
|
(* The point of this test is to confirm that the generic 'show types' feature
|
|
shows enough type information to fully reconstruct a term; the pointer type
|
|
feature does something similar so we disable it here. *)
|
|
notes [[show_ptr_types = false]]
|
|
begin
|
|
lemma c_guard_cast_byte: "c_guard (x :: ('a :: {mem_type}) ptr) \<Longrightarrow> c_guard (ptr_coerce x :: 8 word ptr)"
|
|
goal_show_types 0
|
|
using [[show_sorts]]
|
|
goal_show_types 0
|
|
apply (case_tac x)
|
|
apply (fastforce intro!: byte_ptr_guarded simp: c_guard_def dest: c_null_guard)
|
|
done
|
|
|
|
thm c_guard_cast_byte[where x = "Ptr (ucast (0 :: 8 word))"]
|
|
thm_show_types c_guard_cast_byte[where x = "Ptr (ucast (0 :: 8 word))"]
|
|
|
|
(* Round-trip test *)
|
|
ML \<open>
|
|
let val ctxt = Config.put show_sorts true @{context}
|
|
(* NB: this test fails if we leave some polymorphism in the term *)
|
|
val term = @{thm c_guard_cast_byte[where x = "Ptr (ucast (0 :: 8 word)) :: unit ptr"]} |> Thm.prop_of
|
|
val string_no_types = Syntax.pretty_term ctxt term
|
|
|> Pretty.string_of |> YXML.content_of
|
|
val string_show_types = Show_Types.term_show_types true ctxt term
|
|
|
|
val _ = assert (Syntax.read_term ctxt string_no_types <> term) "Show_Types test (baseline)"
|
|
val _ = assert (Syntax.read_term ctxt string_show_types = term) "Show_Types test"
|
|
in () end
|
|
\<close>
|
|
end
|
|
|
|
end |