diff -r 64559e1ca05b -r 1f9f973eed2a src/HOL/Imperative_HOL/Heap_Monad.thy --- a/src/HOL/Imperative_HOL/Heap_Monad.thy Tue Apr 24 14:17:57 2018 +0000 +++ b/src/HOL/Imperative_HOL/Heap_Monad.thy Tue Apr 24 14:17:58 2018 +0000 @@ -230,8 +230,10 @@ obtains "r = x" "h' = h" using assms by (rule effectE) (simp add: execute_simps) -definition raise :: "string \ 'a Heap" where \ \the string is just decoration\ - [code del]: "raise s = Heap (\_. None)" +definition raise :: "String.literal \ 'a Heap" \ \the literal is just decoration\ + where "raise s = Heap (\_. None)" + +code_datatype raise \ \avoid @{const "Heap"} formally\ lemma execute_raise [execute_simps]: "execute (raise s) = (\_. None)" @@ -309,7 +311,7 @@ subsubsection \Assertions\ definition assert :: "('a \ bool) \ 'a \ 'a Heap" where - "assert P x = (if P x then return x else raise ''assert'')" + "assert P x = (if P x then return x else raise STR ''assert'')" lemma execute_assert [execute_simps]: "P x \ execute (assert P x) h = Some (x, h)" @@ -516,32 +518,17 @@ subsection \Code generator setup\ -subsubsection \Logical intermediate layer\ - -definition raise' :: "String.literal \ 'a Heap" where - [code del]: "raise' s = raise (String.explode s)" - -lemma [code_abbrev]: "raise' (STR s) = raise s" - unfolding raise'_def by (simp add: STR_inverse) - -lemma raise_raise': (* FIXME delete candidate *) - "raise s = raise' (STR s)" - unfolding raise'_def by (simp add: STR_inverse) - -code_datatype raise' \ \avoid @{const "Heap"} formally\ - - subsubsection \SML and OCaml\ code_printing type_constructor Heap \ (SML) "(unit/ ->/ _)" code_printing constant bind \ (SML) "!(fn/ f'_/ =>/ fn/ ()/ =>/ f'_/ (_/ ())/ ())" code_printing constant return \ (SML) "!(fn/ ()/ =>/ _)" -code_printing constant Heap_Monad.raise' \ (SML) "!(raise/ Fail/ _)" +code_printing constant Heap_Monad.raise \ (SML) "!(raise/ Fail/ _)" code_printing type_constructor Heap \ (OCaml) "(unit/ ->/ _)" code_printing constant bind \ (OCaml) "!(fun/ f'_/ ()/ ->/ f'_/ (_/ ())/ ())" code_printing constant return \ (OCaml) "!(fun/ ()/ ->/ _)" -code_printing constant Heap_Monad.raise' \ (OCaml) "failwith" +code_printing constant Heap_Monad.raise \ (OCaml) "failwith" subsubsection \Haskell\ @@ -588,7 +575,7 @@ code_printing type_constructor Heap \ (Haskell) "Heap.ST/ Heap.RealWorld/ _" code_monad bind Haskell code_printing constant return \ (Haskell) "return" -code_printing constant Heap_Monad.raise' \ (Haskell) "error" +code_printing constant Heap_Monad.raise \ (Haskell) "error" subsubsection \Scala\ @@ -633,7 +620,7 @@ code_printing type_constructor Heap \ (Scala) "(Unit/ =>/ _)" code_printing constant bind \ (Scala) "Heap.bind" code_printing constant return \ (Scala) "('_: Unit)/ =>/ _" -code_printing constant Heap_Monad.raise' \ (Scala) "!sys.error((_))" +code_printing constant Heap_Monad.raise \ (Scala) "!sys.error((_))" subsubsection \Target variants with less units\ @@ -703,7 +690,7 @@ \ -hide_const (open) Heap heap guard raise' fold_map +hide_const (open) Heap heap guard fold_map end