src/HOL/Predicate_Compile_Examples/Examples.thy
changeset 80914 d97fdabd9e2b
parent 67443 3abf6a722518
equal deleted inserted replaced
80913:46f59511b7bb 80914:d97fdabd9e2b
   164 
   164 
   165 subsection \<open>Lambda\<close>
   165 subsection \<open>Lambda\<close>
   166 
   166 
   167 datatype type =
   167 datatype type =
   168     Atom nat
   168     Atom nat
   169   | Fun type type    (infixr "\<Rightarrow>" 200)
   169   | Fun type type    (infixr \<open>\<Rightarrow>\<close> 200)
   170 
   170 
   171 datatype dB =
   171 datatype dB =
   172     Var nat
   172     Var nat
   173   | App dB dB (infixl "\<degree>" 200)
   173   | App dB dB (infixl \<open>\<degree>\<close> 200)
   174   | Abs type dB
   174   | Abs type dB
   175 
   175 
   176 primrec
   176 primrec
   177   nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" ("_\<langle>_\<rangle>" [90, 0] 91)
   177   nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" (\<open>_\<langle>_\<rangle>\<close> [90, 0] 91)
   178 where
   178 where
   179   "[]\<langle>i\<rangle> = None"
   179   "[]\<langle>i\<rangle> = None"
   180 | "(x # xs)\<langle>i\<rangle> = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>)"
   180 | "(x # xs)\<langle>i\<rangle> = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>)"
   181 
   181 
   182 inductive nth_el' :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
   182 inductive nth_el' :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
   183 where
   183 where
   184   "nth_el' (x # xs) 0 x"
   184   "nth_el' (x # xs) 0 x"
   185 | "nth_el' xs i y \<Longrightarrow> nth_el' (x # xs) (Suc i) y"
   185 | "nth_el' xs i y \<Longrightarrow> nth_el' (x # xs) (Suc i) y"
   186 
   186 
   187 inductive typing :: "type list \<Rightarrow> dB \<Rightarrow> type \<Rightarrow> bool"  ("_ \<turnstile> _ : _" [50, 50, 50] 50)
   187 inductive typing :: "type list \<Rightarrow> dB \<Rightarrow> type \<Rightarrow> bool"  (\<open>_ \<turnstile> _ : _\<close> [50, 50, 50] 50)
   188   where
   188   where
   189     Var [intro!]: "nth_el' env x T \<Longrightarrow> env \<turnstile> Var x : T"
   189     Var [intro!]: "nth_el' env x T \<Longrightarrow> env \<turnstile> Var x : T"
   190   | Abs [intro!]: "T # env \<turnstile> t : U \<Longrightarrow> env \<turnstile> Abs T t : (T \<Rightarrow> U)"
   190   | Abs [intro!]: "T # env \<turnstile> t : U \<Longrightarrow> env \<turnstile> Abs T t : (T \<Rightarrow> U)"
   191   | App [intro!]: "env \<turnstile> s : T \<Rightarrow> U \<Longrightarrow> env \<turnstile> t : T \<Longrightarrow> env \<turnstile> (s \<degree> t) : U"
   191   | App [intro!]: "env \<turnstile> s : T \<Rightarrow> U \<Longrightarrow> env \<turnstile> t : T \<Longrightarrow> env \<turnstile> (s \<degree> t) : U"
   192 
   192 
   196     "lift (Var i) k = (if i < k then Var i else Var (i + 1))"
   196     "lift (Var i) k = (if i < k then Var i else Var (i + 1))"
   197   | "lift (s \<degree> t) k = lift s k \<degree> lift t k"
   197   | "lift (s \<degree> t) k = lift s k \<degree> lift t k"
   198   | "lift (Abs T s) k = Abs T (lift s (k + 1))"
   198   | "lift (Abs T s) k = Abs T (lift s (k + 1))"
   199 
   199 
   200 primrec
   200 primrec
   201   subst :: "[dB, dB, nat] => dB"  ("_[_'/_]" [300, 0, 0] 300)
   201   subst :: "[dB, dB, nat] => dB"  (\<open>_[_'/_]\<close> [300, 0, 0] 300)
   202 where
   202 where
   203     subst_Var: "(Var i)[s/k] =
   203     subst_Var: "(Var i)[s/k] =
   204       (if k < i then Var (i - 1) else if i = k then s else Var i)"
   204       (if k < i then Var (i - 1) else if i = k then s else Var i)"
   205   | subst_App: "(t \<degree> u)[s/k] = t[s/k] \<degree> u[s/k]"
   205   | subst_App: "(t \<degree> u)[s/k] = t[s/k] \<degree> u[s/k]"
   206   | subst_Abs: "(Abs T t)[s/k] = Abs T (t[lift s 0 / k+1])"
   206   | subst_Abs: "(Abs T t)[s/k] = Abs T (t[lift s 0 / k+1])"
   207 
   207 
   208 inductive beta :: "[dB, dB] => bool"  (infixl "\<rightarrow>\<^sub>\<beta>" 50)
   208 inductive beta :: "[dB, dB] => bool"  (infixl \<open>\<rightarrow>\<^sub>\<beta>\<close> 50)
   209   where
   209   where
   210     beta [simp, intro!]: "Abs T s \<degree> t \<rightarrow>\<^sub>\<beta> s[t/0]"
   210     beta [simp, intro!]: "Abs T s \<degree> t \<rightarrow>\<^sub>\<beta> s[t/0]"
   211   | appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> s \<degree> u \<rightarrow>\<^sub>\<beta> t \<degree> u"
   211   | appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> s \<degree> u \<rightarrow>\<^sub>\<beta> t \<degree> u"
   212   | appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> u \<degree> s \<rightarrow>\<^sub>\<beta> u \<degree> t"
   212   | appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> u \<degree> s \<rightarrow>\<^sub>\<beta> u \<degree> t"
   213   | abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"
   213   | abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"
   282 "bval (And b1 b2) st = (bval b1 st \<and> bval b2 st)" |
   282 "bval (And b1 b2) st = (bval b1 st \<and> bval b2 st)" |
   283 "bval (Less a\<^sub>1 a\<^sub>2) st = (aval a\<^sub>1 st < aval a\<^sub>2 st)"
   283 "bval (Less a\<^sub>1 a\<^sub>2) st = (aval a\<^sub>1 st < aval a\<^sub>2 st)"
   284 
   284 
   285 datatype
   285 datatype
   286   com' = SKIP 
   286   com' = SKIP 
   287       | Assign name aexp         ("_ ::= _" [1000, 61] 61)
   287       | Assign name aexp         (\<open>_ ::= _\<close> [1000, 61] 61)
   288       | Semi   com'  com'          ("_; _"  [60, 61] 60)
   288       | Semi   com'  com'          (\<open>_; _\<close>  [60, 61] 60)
   289       | If     bexp com' com'     ("IF _ THEN _ ELSE _"  [0, 0, 61] 61)
   289       | If     bexp com' com'     (\<open>IF _ THEN _ ELSE _\<close>  [0, 0, 61] 61)
   290       | While  bexp com'         ("WHILE _ DO _"  [0, 61] 61)
   290       | While  bexp com'         (\<open>WHILE _ DO _\<close>  [0, 61] 61)
   291 
   291 
   292 inductive
   292 inductive
   293   big_step :: "com' * state' \<Rightarrow> state' \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
   293   big_step :: "com' * state' \<Rightarrow> state' \<Rightarrow> bool" (infix \<open>\<Rightarrow>\<close> 55)
   294 where
   294 where
   295   Skip:    "(SKIP,s) \<Rightarrow> s"
   295   Skip:    "(SKIP,s) \<Rightarrow> s"
   296 | Assign:  "(x ::= a,s) \<Rightarrow> s(x := aval a s)"
   296 | Assign:  "(x ::= a,s) \<Rightarrow> s(x := aval a s)"
   297 
   297 
   298 | Semi:    "(c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2  \<Longrightarrow>  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3  \<Longrightarrow> (c\<^sub>1;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3"
   298 | Semi:    "(c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2  \<Longrightarrow>  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3  \<Longrightarrow> (c\<^sub>1;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3"