src/HOL/Library/State_Monad.thy
changeset 24195 7d1a16c77f7c
parent 22664 e965391e2864
child 24224 a5c95bbeb31d
--- a/src/HOL/Library/State_Monad.thy	Thu Aug 09 15:52:42 2007 +0200
+++ b/src/HOL/Library/State_Monad.thy	Thu Aug 09 15:52:45 2007 +0200
@@ -221,26 +221,22 @@
   "_do f" => "CONST run f"
   "_mbind x f g" => "f \<guillemotright>= (\<lambda>x. g)"
   "_fcomp f g" => "f \<guillemotright> g"
-  "_let x t f" => "Let t (\<lambda>x. f)"
+  "_let x t f" => "CONST Let t (\<lambda>x. f)"
   "_nil f" => "f"
 
 print_translation {*
 let
-  val name_mbind = @{const_syntax "mbind"};
-  val name_fcomp = @{const_syntax "fcomp"};
-  fun unfold_monad (t as Const (name, _) $ f $ g) =
-        if name = name_mbind then let
-            val ([(v, ty)], g') = Term.strip_abs_eta 1 g;
-          in Const ("_mbind", dummyT) $ Free (v, ty) $ f $ unfold_monad g' end
-        else if name = name_fcomp then
-          Const ("_fcomp", dummyT) $ f $ unfold_monad g
-        else t
-    | unfold_monad (Const ("Let", _) $ f $ g) =
+  fun unfold_monad (Const (@{const_syntax mbind}, _) $ f $ g) =
         let
-          
+          val ([(v, ty)], g') = Term.strip_abs_eta 1 g;
+        in Const ("_mbind", dummyT) $ Free (v, ty) $ f $ unfold_monad g' end
+    | unfold_monad (Const (@{const_syntax fcomp}, _) $ f $ g) =
+        Const ("_fcomp", dummyT) $ f $ unfold_monad g
+    | unfold_monad (Const (@{const_syntax Let}, _) $ f $ g) =
+        let
           val ([(v, ty)], g') = Term.strip_abs_eta 1 g;
         in Const ("_let", dummyT) $ Free (v, ty) $ f $ unfold_monad g' end
-    | unfold_monad (Const ("Pair", _) $ f) =
+    | unfold_monad (Const (@{const_syntax Pair}, _) $ f) =
         Const ("return", dummyT) $ f
     | unfold_monad f = f;
   fun tr' (f::ts) =
@@ -248,6 +244,7 @@
 in [(@{const_syntax "run"}, tr')] end;
 *}
 
+
 subsection {* Combinators *}
 
 definition
@@ -258,12 +255,10 @@
   list :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where
   "list f [] = id"
 | "list f (x#xs) = (do f x; list f xs done)"
-lemmas [code] = list.simps
 
 fun list_yield :: "('a \<Rightarrow> 'b \<Rightarrow> 'c \<times> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'c list \<times> 'b" where
   "list_yield f [] = return []"
 | "list_yield f (x#xs) = (do y \<leftarrow> f x; ys \<leftarrow> list_yield f xs; return (y#ys) done)"
-lemmas [code] = list_yield.simps
   
 text {* combinator properties *}
 
@@ -304,7 +299,7 @@
 *}
 
 text {*
-  For an example, see HOL/ex/CodeRandom.thy (more examples coming soon).
+  For an example, see HOL/ex/Random.thy.
 *}
 
 end