src/Tools/isac/ProgLang/Script.thy
author Walther Neuper <neuper@ist.tugraz.at>
Tue, 03 May 2011 15:58:04 +0200
branchdecompose-isar
changeset 41969 a350b4ed575b
parent 41968 3228aa46fd30
child 42400 dcacb8077a98
permissions -rw-r--r--
tuned, tests work
neuper@37944
     1
(* Title:  tactics, tacticals etc. for scripts
neuper@37944
     2
   Author: Walther Neuper 000224
neuper@37944
     3
   (c) due to copyright terms
neuper@41899
     4
12345678901234567890123456789012345678901234567890123456789012345678901234567890
neuper@41899
     5
        10        20        30        40        50        60        70        80
neuper@37906
     6
 *)
neuper@37906
     7
neuper@37944
     8
theory Script imports Tools begin
neuper@37906
     9
neuper@37906
    10
typedecl
neuper@37906
    11
  ID	(* identifiers for thy, ruleset,... *)
neuper@37906
    12
neuper@37906
    13
typedecl
neuper@37906
    14
  arg	(* argument of subproblem           *)
neuper@37906
    15
neuper@37906
    16
consts
neuper@37906
    17
neuper@37906
    18
(*types of subproblems' arguments*)
neuper@37985
    19
  REAL        :: "real => arg"
neuper@37985
    20
  REAL_LIST   :: "(real list) => arg"
neuper@37985
    21
  REAL_SET    :: "(real set) => arg"
neuper@37985
    22
  BOOL        :: "bool => arg"
neuper@37985
    23
  BOOL_LIST   :: "(bool list) => arg"
neuper@37985
    24
  REAL_REAL   :: "(real => real) => arg"
neuper@37906
    25
neuper@37906
    26
(*tactics*)
neuper@37906
    27
  Rewrite      :: "[ID, bool, 'a] => 'a"
neuper@37906
    28
  Rewrite'_Inst:: "[(real * real) list, ID, bool, 'a] => 'a"
neuper@37906
    29
			             ("(Rewrite'_Inst (_ _ _))" 11)
neuper@37906
    30
                                     (*without last argument ^^ for @@*)
neuper@37906
    31
  Rewrite'_Set :: "[ID, bool, 'a] => 'a" ("(Rewrite'_Set (_ _))" 11)
neuper@37906
    32
  Rewrite'_Set'_Inst
neuper@37906
    33
               :: "[(real * real) list, ID, bool, 'a] => 'a"
neuper@37906
    34
		                     ("(Rewrite'_Set'_Inst (_ _ _))" 11)
neuper@37906
    35
                                     (*without last argument ^^ for @@*)
neuper@37921
    36
  Calculate    :: "[ID, 'a] => 'a" (*WN100816 PLUS, TIMES, POWER miss.in scr*)
neuper@37906
    37
  Calculate1   :: "[ID, 'a] => 'a" (*FIXXXME: unknown to script-interpreter*)
neuper@37906
    38
neuper@37906
    39
  (* WN0509 substitution now is rewriting by a list of terms (of type bool)
neuper@37906
    40
  Substitute   :: "[(real * real) list, 'a] => 'a"*)
neuper@37906
    41
  Substitute   :: "[bool list, 'a] => 'a"
neuper@37906
    42
neuper@37906
    43
  Map          :: "['a => 'b, 'a list] => 'b list"
neuper@38051
    44
  Tac          :: "ID => 'a"         (*deprecated; used in Test.ML*)
neuper@37906
    45
  Check'_elementwise ::
neuper@37906
    46
		  "['a list, 'b set] => 'a list"
neuper@37906
    47
                                     ("Check'_elementwise (_ _)" 11)
neuper@37906
    48
  Take         :: "'a => 'a"         (*for non-var args as long as no 'o'*)
neuper@37906
    49
  SubProblem   :: "[ID * ID list * ID list, arg list] => 'a"
neuper@37906
    50
neuper@37906
    51
  Or'_to'_List :: "bool => 'a list"  ("Or'_to'_List (_)" 11)
neuper@37906
    52
  (*=========== record these ^^^ in 'tacs' in Script.ML =========*)
neuper@37906
    53
neuper@37906
    54
  Assumptions  :: bool
neuper@37906
    55
  Problem      :: "[ID * ID list] => 'a"
neuper@37906
    56
neuper@37906
    57
(*special formulas for frontend 'CAS format'*)
neuper@37906
    58
  Subproblem   :: "(ID * ID list) => 'a" 
neuper@37906
    59
neuper@37906
    60
(*script-expressions (tacticals)*)
neuper@37906
    61
  Seq      :: "['a => 'a, 'a => 'a, 'a] => 'a" (infixr "@@" 10) (*@ used*)
neuper@37906
    62
  Try      :: "['a => 'a, 'a] => 'a"
neuper@37906
    63
  Repeat   :: "['a => 'a, 'a] => 'a" 
neuper@37906
    64
  Or       :: "['a => 'a, 'a => 'a, 'a] => 'a" (infixr "Or" 10)
neuper@37906
    65
  While    :: "[bool, 'a => 'a, 'a] => 'a"     ("((While (_) Do)//(_))" 9)
neuper@37906
    66
(*WN100723 because of "Error in syntax translation" below...
neuper@37906
    67
        (*'b => bool doesn't work with "contains_root _"*)
neuper@37906
    68
  Letpar   :: "['a, 'a => 'b] => 'b"
neuper@37906
    69
  (*--- defined in Isabelle/scr/HOL/HOL.thy:
neuper@37906
    70
  Let      :: "['a, 'a => 'b] => 'b"
neuper@37906
    71
  "_Let"   :: "[letbinds, 'a] => 'a"       ("(let (_)/ in (_))" 10)
neuper@37906
    72
  If       :: "[bool, 'a, 'a] => 'a"       ("(if (_)/ then (_)/ else (_))" 10)
neuper@37906
    73
  %x. P x  .. lambda is defined in Isabelles meta logic
neuper@37906
    74
  --- *)
neuper@37906
    75
*)
neuper@37906
    76
  failtac :: 'a
neuper@37906
    77
  idletac :: 'a
neuper@37906
    78
  (*... + RECORD IN 'screxpr' in Script.ML *)
neuper@37906
    79
neuper@37906
    80
(*for scripts generated automatically from rls*)
neuper@37906
    81
  Stepwise      :: "['z,     'z] => 'z" ("((Script Stepwise (_   =))// (_))" 9)
neuper@37906
    82
  Stepwise'_inst:: "['z,real,'z] => 'z" 
neuper@37906
    83
	("((Script Stepwise'_inst (_ _ =))// (_))" 9)
neuper@37906
    84
neuper@37906
    85
neuper@37906
    86
(*SHIFT -> resp.thys ----vvv---------------------------------------------*)
neuper@37906
    87
(*script-names: initial capital letter,
neuper@37906
    88
		type of last arg (=script-body) == result-type !
neuper@37906
    89
  Xxxx       :: script ids, duplicate result-type 'r in last argument:
neuper@37906
    90
             "['a, ... , \
neuper@37906
    91
	       \         'r] => 'r
neuper@37906
    92
*)
neuper@37906
    93
			    
neuper@37906
    94
(*make'_solution'_set :: "bool => bool list" 
neuper@37906
    95
			("(make'_solution'_set (_))" 11)    
neuper@37906
    96
					   
neuper@37906
    97
  max'_on'_interval
neuper@37906
    98
             :: "[ID * (ID list) * ID, bool,real,real set] => real"
neuper@37906
    99
               ("(max'_on'_interval (_)/ (_ _ _))" 9)
neuper@37906
   100
  find'_vals
neuper@37906
   101
             :: "[ID * (ID list) * ID,
neuper@37906
   102
		  real,real,real,real,bool list] => bool list"
neuper@37906
   103
               ("(find'_vals (_)/ (_ _ _ _ _))" 9)
neuper@37906
   104
neuper@37906
   105
  make'_fun  :: "[ID * (ID list) * ID, real,real,bool list] => bool"
neuper@37906
   106
               ("(make'_fun (_)/ (_ _ _))" 9)
neuper@37906
   107
neuper@37906
   108
  solve'_univar
neuper@37906
   109
             :: "[ID * (ID list) * ID, bool,real] => bool list"
neuper@37906
   110
               ("(solve'_univar (_)/ (_ _ ))" 9)
neuper@37906
   111
  solve'_univar'_err
neuper@37906
   112
             :: "[ID * (ID list) * ID, bool,real,bool] => bool list"
neuper@37906
   113
               ("(solve'_univar (_)/ (_ _ _))" 9)
neuper@37906
   114
----------*)
neuper@37906
   115
neuper@37906
   116
  Testeq     :: "[bool, bool] => bool"
neuper@37906
   117
               ("((Script Testeq (_ =))// 
neuper@37906
   118
                  (_))" 9)
neuper@37906
   119
  
neuper@37906
   120
  Testeq2    :: "[bool, bool list] => bool list"
neuper@37906
   121
               ("((Script Testeq2 (_ =))// 
neuper@37906
   122
                  (_))" 9)
neuper@37906
   123
  
neuper@37906
   124
  Testterm   :: "[real, real] => real"
neuper@37906
   125
               ("((Script Testterm (_ =))// 
neuper@37906
   126
                  (_))" 9)
neuper@37906
   127
  
neuper@37906
   128
  Testchk    :: "[bool, real, real list] => real list"
neuper@37906
   129
               ("((Script Testchk (_ _ =))// 
neuper@37906
   130
                  (_))" 9)
neuper@37906
   131
  (*... + RECORD IN 'subpbls' in Script.ML *)
neuper@37906
   132
(*SHIFT -> resp.thys ----^^^----------------------------*)
neuper@37906
   133
neuper@37906
   134
(*Makarius 10.03
neuper@37906
   135
syntax
neuper@37906
   136
neuper@37906
   137
  "_Letpar"     :: "[letbinds, 'a] => 'a"      ("(letpar (_)/ in (_))" 10)
neuper@37906
   138
neuper@37906
   139
translations
neuper@37906
   140
neuper@37906
   141
  "_Letpar (_binds b bs) e"  == "_Letpar b (_Letpar bs e)"
neuper@37906
   142
  "letpar x = a in e"        == "Letpar a (%x. e)"
neuper@37906
   143
*** Error in syntax translation rule: rhs contains extra variables
neuper@37906
   144
*** ("_Letpar" ("_bind" x a) e)  ->  (Letpar a ("_abs" x e))
neuper@38058
   145
*** At command "translations" (line 140 of "/usr/local/isabisac/src/Pure/isac/Scripts/Script").
neuper@37906
   146
*)
neuper@37906
   147
neuper@37921
   148
ML {* (*the former Script.ML*)
neuper@37921
   149
neuper@37921
   150
(*.record all theories defined for Scripts; in order to distinguish them
neuper@37921
   151
   from general IsacKnowledge defined later on.*)
neuper@37921
   152
script_thys := !theory';
neuper@37921
   153
neuper@37921
   154
(*--vvv----- SHIFT? or delete ?*)
neuper@37921
   155
val IDTyp = Type("Script.ID",[]);
neuper@37921
   156
neuper@37921
   157
neuper@38006
   158
val tacs = Unsynchronized.ref (distinct (remove op = ""
neuper@37921
   159
  ["Calculate",
neuper@37921
   160
   "Rewrite","Rewrite'_Inst","Rewrite'_Set","Rewrite'_Set'_Inst",
neuper@37921
   161
   "Substitute","Tac","Check'_elementswise",
neuper@37921
   162
   "Take","Subproblem","Or'_to'_List"]));
neuper@37921
   163
neuper@38006
   164
val screxpr = Unsynchronized.ref (distinct (remove op = ""
neuper@41969
   165
  ["Let","If","Repeat","While","Try","Or"]));
neuper@37921
   166
neuper@38006
   167
val listfuns = Unsynchronized.ref [(*_all_ functions in Isa99.List.thy *)
neuper@37921
   168
    "@","filter","concat","foldl","hd","last","set","list_all",
neuper@37921
   169
    "map","mem","nth","list_update","take","drop",	
neuper@37921
   170
    "takeWhile","dropWhile","tl","butlast",
neuper@37921
   171
    "rev","zip","upt","remdups","nodups","replicate",
neuper@37921
   172
neuper@37921
   173
    "Cons","Nil"];
neuper@37921
   174
neuper@41899
   175
val scrfuns = Unsynchronized.ref ([]: string list);
neuper@37921
   176
neuper@38006
   177
val listexpr = Unsynchronized.ref (union op = (!listfuns) (!scrfuns));
neuper@37921
   178
neuper@38006
   179
val notsimp = Unsynchronized.ref 
neuper@37921
   180
  (distinct (remove op = "" 
neuper@37921
   181
             (!tacs @ !screxpr @ (*!subpbls @*) !scrfuns @ !listfuns)));
neuper@37921
   182
neuper@38006
   183
val negotiable = Unsynchronized.ref ((!tacs (*@ !subpbls*)));
neuper@37921
   184
neuper@38007
   185
val tacpbl = Unsynchronized.ref
neuper@37921
   186
  (distinct (remove op = "" (!tacs (*@ !subpbls*))));
neuper@37921
   187
(*--^^^----- SHIFT? or delete ?*)
neuper@37906
   188
neuper@37906
   189
*}
neuper@37906
   190
neuper@37906
   191
end