Tests/Rec_def2.thy
author Christian Urban <christian.urban@kcl.ac.uk>
Thu, 22 Feb 2024 14:06:37 +0000
changeset 299 a2707a5652d9
parent 230 49dcc0b9b0b3
permissions -rw-r--r--
test
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     1
theory Rec_def2
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     2
imports Main
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
begin
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
datatype recf =  z
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
              |  s
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
              |  id nat nat
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
              |  Cn nat recf "recf list"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
              |  Pr nat recf recf
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
              |  Mn nat recf 
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    12
definition pred_of_nl :: "nat list \<Rightarrow> nat list"
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    13
  where
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    14
  "pred_of_nl xs = butlast xs @ [last xs - 1]"
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    15
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
function rec_exec :: "recf \<Rightarrow> nat list \<Rightarrow> nat"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
  where
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    18
  "rec_exec z xs = 0" |
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
  "rec_exec s xs = (Suc (xs ! 0))" |
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
  "rec_exec (id m n) xs = (xs ! n)" |
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    21
  "rec_exec (Cn n f gs) xs = 
219
a3ea0b0f8bad updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 216
diff changeset
    22
     rec_exec f (map (\<lambda> a. rec_exec a xs) gs)" | 
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
  "rec_exec (Pr n f g) xs = 
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    24
     (if last xs = 0 then rec_exec f (butlast xs)
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    25
      else rec_exec g (butlast xs @ (last xs - 1) # [rec_exec (Pr n f g) (butlast xs @ [last xs - 1])]))" |
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    26
  "rec_exec (Mn n f) xs = (LEAST x. rec_exec f (xs @ [x]) = 0)"
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    27
by pat_completeness auto
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
termination
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    30
apply(relation "measures [\<lambda> (r, xs). size r, (\<lambda> (r, xs). last xs)]")
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
apply(auto simp add: less_Suc_eq_le intro: trans_le_add2 list_size_estimation')
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
done
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
inductive terminate :: "recf \<Rightarrow> nat list \<Rightarrow> bool"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
  where
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
  termi_z: "terminate z [n]"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
| termi_s: "terminate s [n]"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
| termi_id: "\<lbrakk>n < m; length xs = m\<rbrakk> \<Longrightarrow> terminate (id m n) xs"
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
| termi_cn: "\<lbrakk>terminate f (map (\<lambda>g. rec_exec g xs) gs); 
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
              \<forall>g \<in> set gs. terminate g xs; length xs = n\<rbrakk> \<Longrightarrow> terminate (Cn n f gs) xs"
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    41
| termi_pr: "\<lbrakk>\<forall> y < x. terminate g (xs @ y # [rec_exec (Pr n f g) (xs @ [y])]);
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    42
              terminate f xs;
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    43
              length xs = n\<rbrakk> 
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    44
              \<Longrightarrow> terminate (Pr n f g) (xs @ [x])"
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    45
| termi_mn: "\<lbrakk>length xs = n; rec_exec f (xs @ [r]) = 0;
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 220
diff changeset
    46
              \<forall> i < r. terminate f (xs @ [i]) \<and> rec_exec f (xs @ [i]) > 0\<rbrakk> \<Longrightarrow> terminate (Mn n f) xs"
216
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
38ed0ed6de3d added definition of termination for rec_exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
end