src/Tools/isac/ProgLang/ListC.thy
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 01 Mar 2011 15:23:59 +0100
branchdecompose-isar
changeset 41905 b772eb34c16c
parent 41900 8391d3789efb
child 41943 f33f6959948b
permissions -rw-r--r--
intermed.update to Isabelle2011: test/../syntax added

present problem: test/Tools/isac/ADDTESTS/filed-depend does not update
neuper@37965
     1
(* Title:  functions on lists for Scripts
neuper@37965
     2
   Author: Walther Neuper 0108
neuper@37965
     3
   (c) due to copyright terms
neuper@37906
     4
*)
neuper@37906
     5
neuper@37947
     6
theory ListC imports Complex_Main
neuper@40836
     7
uses ("../library.sml")("../calcelems.sml")
neuper@40836
     8
("termC.sml")("calculate.sml")
neuper@40836
     9
("rewrite.sml")
neuper@37906
    10
begin
neuper@40836
    11
use "../library.sml"        (*indent,...*)
neuper@40836
    12
use "../calcelems.sml"      (*str_of_type, Thm,...*)
neuper@40836
    13
use "termC.sml"  (*num_str,...*)
neuper@40836
    14
use "calculate.sml" (*???*)
neuper@40836
    15
use "rewrite.sml"   (*?*** At command "end" (line 205../ListC.thy*)
neuper@37906
    16
neuper@37906
    17
text {* 'nat' in List.thy replaced by 'real' *}
neuper@37906
    18
neuper@37997
    19
primrec LENGTH   :: "'a list => real"
neuper@37906
    20
where
neuper@37997
    21
  LENGTH_NIL:	"LENGTH [] = 0"     (*length: 'a list => nat*)
neuper@37997
    22
| LENGTH_CONS: "LENGTH (x#xs) = 1 + LENGTH xs"
neuper@37906
    23
neuper@37906
    24
primrec del :: "['a list, 'a] => 'a list"
neuper@37906
    25
where
neuper@37906
    26
  del_base: "del [] x = []"
neuper@37906
    27
| del_rec:  "del (y#ys) x = (if x = y then ys else y#(del ys x))"
neuper@37906
    28
neuper@37906
    29
definition
neuper@37906
    30
  list_diff :: "['a list, 'a list] => 'a list"         (* as -- bs *)
neuper@37906
    31
              ("(_ --/ _)" [66, 66] 65)
neuper@37906
    32
  where "a -- b == foldl del a b"
neuper@37906
    33
  
neuper@37997
    34
consts NTH ::  "[real, 'a list] => 'a"
neuper@37906
    35
axioms
neuper@37906
    36
 (*** more than one non-variable in pattern in "nth_ 1 [x] = x"--*)
neuper@37997
    37
  NTH_NIL:      "NTH 1 (x#xs) = x"
neuper@37997
    38
(*  NTH_CONS:     "NTH n (x#xs) = NTH (n+ -1) xs"  *)
neuper@37906
    39
neuper@37906
    40
(*rewriter does not reach base case   ......    ;
neuper@37906
    41
  the condition involves another rule set (erls, eval_binop in Atools):*)
neuper@37997
    42
  NTH_CONS:     "1 < n ==> NTH n (x#xs) = NTH (n+ - 1) xs"
neuper@37906
    43
neuper@37906
    44
(*primrec from Isabelle/src/HOL/List.thy -- def.twice not allowed*)
neuper@37906
    45
(*primrec*)
neuper@37906
    46
  hd_thm:	"hd(x#xs) = x"
neuper@37906
    47
(*primrec*)
neuper@37906
    48
  tl_Nil:	"tl([])   = []"
neuper@37906
    49
  tl_Cons:		"tl(x#xs) = xs"
neuper@37906
    50
(*primrec*)
neuper@37906
    51
  null_Nil:	"null([])   = True"
neuper@37906
    52
  null_Cons:	"null(x#xs) = False"
neuper@37906
    53
(*primrec*)
neuper@37906
    54
  LAST:	"last(x#xs) = (if xs=[] then x else last xs)"
neuper@37906
    55
(*primrec*)
neuper@37906
    56
  butlast_Nil:	"butlast []    = []"
neuper@37906
    57
  butlast_Cons:	"butlast(x#xs) = (if xs=[] then [] else x#butlast xs)"
neuper@41899
    58
(*primrec
neuper@37906
    59
  mem_Nil:	"x mem []     = False"
neuper@37906
    60
  mem_Cons:	"x mem (y#ys) = (if y=x then True else x mem ys)"
neuper@41899
    61
*)
neuper@41899
    62
  mem_Nil:	"x : set []     = False"
neuper@41899
    63
  mem_Cons:	"x : set (y#ys) = (if y=x then True else x : set ys)"
neuper@37906
    64
(*primrec-------already named---
neuper@37906
    65
  "set [] = {}"
neuper@37906
    66
  "set (x#xs) = insert x (set xs)"
neuper@37906
    67
  primrec
neuper@37906
    68
  list_all_Nil  "list_all P [] = True"
neuper@37906
    69
  list_all_Cons "list_all P (x#xs) = (P(x) & list_all P xs)"
neuper@37906
    70
----------------*)
neuper@37906
    71
(*primrec*)
neuper@37906
    72
  map_Nil:	"map f []     = []"
neuper@37906
    73
  map_Cons:	"map f (x#xs) = f(x)#map f xs"
neuper@37906
    74
(*primrec*)
neuper@37906
    75
  append_Nil:  "[]    @ys = ys"
neuper@37906
    76
  append_Cons: "(x#xs)@ys = x#(xs@ys)"
neuper@37906
    77
(*primrec*)
neuper@37906
    78
  rev_Nil:	"rev([])   = []"
neuper@37906
    79
  rev_Cons:	"rev(x#xs) = rev(xs) @ [x]"
neuper@37906
    80
(*primrec*)
neuper@37906
    81
  filter_Nil:	"filter P []     = []"
neuper@37906
    82
  filter_Cons:	"filter P (x#xs) =(if P x then x#filter P xs else filter P xs)"
neuper@37906
    83
(*primrec-------already named---
neuper@37906
    84
  foldl_Nil  "foldl f a [] = a"
neuper@37906
    85
  foldl_Cons "foldl f a (x#xs) = foldl f (f a x) xs"
neuper@37906
    86
----------------*)
neuper@37906
    87
(*primrec*)
neuper@37906
    88
  foldr_Nil:	"foldr f [] a     = a"
neuper@37906
    89
  foldr_Cons:	"foldr f (x#xs) a = f x (foldr f xs a)"
neuper@37906
    90
(*primrec*)
neuper@37906
    91
  concat_Nil:	"concat([])   = []"
neuper@37906
    92
  concat_Cons:	"concat(x#xs) = x @ concat(xs)"
neuper@37906
    93
(*primrec-------already named---
neuper@37906
    94
  drop_Nil  "drop n [] = []"
neuper@37906
    95
  drop_Cons "drop n (x#xs) = (case n of 0 => x#xs | Suc(m) => drop m xs)"
neuper@37906
    96
  (* Warning: simpset does not contain this definition but separate theorems 
neuper@37906
    97
     for n=0 / n=Suc k*)
neuper@37906
    98
(*primrec*)
neuper@37906
    99
  take_Nil  "take n [] = []"
neuper@37906
   100
  take_Cons "take n (x#xs) = (case n of 0 => [] | Suc(m) => x # take m xs)"
neuper@37906
   101
  (* Warning: simpset does not contain this definition but separate theorems 
neuper@37906
   102
     for n=0 / n=Suc k*)
neuper@37906
   103
(*primrec*) 
neuper@37906
   104
  nth_Cons  "(x#xs)!n = (case n of 0 => x | (Suc k) => xs!k)"
neuper@37906
   105
  (* Warning: simpset does not contain this definition but separate theorems 
neuper@37906
   106
     for n=0 / n=Suc k*)
neuper@37906
   107
(*primrec*)
neuper@37906
   108
 "    [][i:=v] = []"
neuper@37906
   109
 "(x#xs)[i:=v] = (case i of 0     => v # xs 
neuper@37906
   110
			  | Suc j => x # xs[j:=v])"
neuper@37906
   111
----------------*)
neuper@37906
   112
(*primrec*)
neuper@37906
   113
  takeWhile_Nil:	"takeWhile P []     = []"
neuper@37906
   114
  takeWhile_Cons:
neuper@37906
   115
  "takeWhile P (x#xs) = (if P x then x#takeWhile P xs else [])"
neuper@37906
   116
(*primrec*)
neuper@37906
   117
  dropWhile_Nil:	"dropWhile P []     = []"
neuper@37906
   118
  dropWhile_Cons:
neuper@37906
   119
  "dropWhile P (x#xs) = (if P x then dropWhile P xs else x#xs)"
neuper@37906
   120
(*primrec*)
neuper@37906
   121
  zip_Nil:	"zip xs []     = []"
neuper@37906
   122
  zip_Cons:	"zip xs (y#ys) =(case xs of [] => [] | z#zs =>(z,y)#zip zs ys)"
neuper@37906
   123
  (* Warning: simpset does not contain this definition but separate theorems 
neuper@37906
   124
     for xs=[] / xs=z#zs *)
neuper@37906
   125
(*primrec
neuper@37906
   126
  upt_0   "[i..0(] = []"
neuper@37906
   127
  upt_Suc "[i..(Suc j)(] = (if i <= j then [i..j(] @ [j] else [])"
neuper@37906
   128
*)
neuper@37906
   129
(*primrec*)
neuper@37906
   130
  distinct_Nil:	"distinct []     = True"
neuper@37906
   131
  distinct_Cons:	"distinct (x#xs) = (x ~: set xs & distinct xs)"
neuper@37906
   132
(*primrec*)
neuper@37906
   133
  remdups_Nil:	"remdups [] = []"
neuper@37906
   134
  remdups_Cons:	"remdups (x#xs) =
neuper@37906
   135
		 (if x : set xs then remdups xs else x # remdups xs)"
neuper@37906
   136
(*primrec-------already named---
neuper@37906
   137
  replicate_0   "replicate  0      x = []"
neuper@37906
   138
  replicate_Suc "replicate (Suc n) x = x # replicate n x"
neuper@37906
   139
----------------*)
neuper@37906
   140
neuper@37906
   141
(** Lexicographic orderings on lists ...!!!**)
neuper@37906
   142
neuper@37947
   143
ML{* (*the former ListC.ML*)
neuper@37906
   144
(** rule set for evaluating listexpr in scripts **)
neuper@37906
   145
val list_rls = 
neuper@37906
   146
  Rls{id="list_rls",preconds = [], rew_ord = ("dummy_ord",dummy_ord), 
neuper@37906
   147
      erls = e_rls, srls = Erls, calc = [], (*asm_thm=[],*)
neuper@37906
   148
      rules = (*8.01: copied from*)
neuper@37966
   149
      [Thm ("refl", num_str @{thm refl}),  (*'a<>b -> FALSE' by fun eval_equal*)
neuper@37906
   150
       Thm ("o_apply", num_str @{thm o_apply}),
neuper@37906
   151
neuper@37906
   152
       Thm ("NTH_CONS",num_str @{thm NTH_CONS}),(*erls for cond. in Atools.ML*)
neuper@37906
   153
       Thm ("NTH_NIL",num_str @{thm NTH_NIL}),
neuper@37906
   154
       Thm ("append_Cons",num_str @{thm append_Cons}),
neuper@37906
   155
       Thm ("append_Nil",num_str @{thm append_Nil}),
neuper@37906
   156
       Thm ("butlast_Cons",num_str @{thm butlast_Cons}),
neuper@37906
   157
       Thm ("butlast_Nil",num_str @{thm butlast_Nil}),
neuper@37906
   158
       Thm ("concat_Cons",num_str @{thm concat_Cons}),
neuper@37906
   159
       Thm ("concat_Nil",num_str @{thm concat_Nil}),
neuper@37906
   160
       Thm ("del_base",num_str @{thm del_base}),
neuper@37906
   161
       Thm ("del_rec",num_str @{thm del_rec}),
neuper@37906
   162
neuper@37906
   163
       Thm ("distinct_Cons",num_str @{thm distinct_Cons}),
neuper@37906
   164
       Thm ("distinct_Nil",num_str @{thm distinct_Nil}),
neuper@37906
   165
       Thm ("dropWhile_Cons",num_str @{thm dropWhile_Cons}),
neuper@37906
   166
       Thm ("dropWhile_Nil",num_str @{thm dropWhile_Nil}),
neuper@37906
   167
       Thm ("filter_Cons",num_str @{thm filter_Cons}),
neuper@37906
   168
       Thm ("filter_Nil",num_str @{thm filter_Nil}),
neuper@37906
   169
       Thm ("foldr_Cons",num_str @{thm foldr_Cons}),
neuper@37906
   170
       Thm ("foldr_Nil",num_str @{thm foldr_Nil}),
neuper@37906
   171
       Thm ("hd_thm",num_str @{thm hd_thm}),
neuper@37906
   172
       Thm ("LAST",num_str @{thm LAST}),
neuper@37906
   173
       Thm ("LENGTH_CONS",num_str @{thm LENGTH_CONS}),
neuper@37906
   174
       Thm ("LENGTH_NIL",num_str @{thm LENGTH_NIL}),
neuper@37906
   175
       Thm ("list_diff_def",num_str @{thm list_diff_def}),
neuper@37906
   176
       Thm ("map_Cons",num_str @{thm map_Cons}),
neuper@37906
   177
       Thm ("map_Nil",num_str @{thm map_Cons}),
neuper@37906
   178
       Thm ("mem_Cons",num_str @{thm mem_Cons}),
neuper@37906
   179
       Thm ("mem_Nil",num_str @{thm mem_Nil}),
neuper@37906
   180
       Thm ("null_Cons",num_str @{thm null_Cons}),
neuper@37906
   181
       Thm ("null_Nil",num_str @{thm null_Nil}),
neuper@37906
   182
       Thm ("remdups_Cons",num_str @{thm remdups_Cons}),
neuper@37906
   183
       Thm ("remdups_Nil",num_str @{thm remdups_Nil}),
neuper@37906
   184
       Thm ("rev_Cons",num_str @{thm rev_Cons}),
neuper@37906
   185
       Thm ("rev_Nil",num_str @{thm rev_Nil}),
neuper@37906
   186
       Thm ("take_Nil",num_str @{thm take_Nil}),
neuper@37906
   187
       Thm ("take_Cons",num_str @{thm take_Cons}),
neuper@37906
   188
       Thm ("tl_Cons",num_str @{thm tl_Cons}),
neuper@37906
   189
       Thm ("tl_Nil",num_str @{thm tl_Nil}),
neuper@37906
   190
       Thm ("zip_Cons",num_str @{thm zip_Cons}),
neuper@37906
   191
       Thm ("zip_Nil",num_str @{thm zip_Nil})
neuper@37906
   192
       ], scr = EmptyScr}:rls;
neuper@37906
   193
*}
neuper@37906
   194
neuper@37906
   195
ML{*
neuper@37906
   196
ruleset' := overwritelthy @{theory} (!ruleset',
neuper@37906
   197
  [("list_rls",list_rls)
neuper@37906
   198
   ]);
neuper@37906
   199
*}
neuper@37906
   200
end