src/Pure/par_tactical.ML
author wenzelm
Tue, 19 Aug 2014 18:11:04 +0200
changeset 58009 987c848d509b
child 58950 d07464875dd4
permissions -rw-r--r--
clarified modules;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
58009
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/par_tactical.ML
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     3
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     4
Parallel tacticals.
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     5
*)
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     6
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     7
signature BASIC_PAR_TACTICAL =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     8
sig
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
     9
  val PARALLEL_CHOICE: tactic list -> tactic
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    10
  val PARALLEL_GOALS: tactic -> tactic
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    11
  val PARALLEL_ALLGOALS: (int -> tactic) -> tactic
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    12
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    13
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    14
signature PAR_TACTICAL =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    15
sig
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    16
  include BASIC_PAR_TACTICAL
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    17
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    18
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    19
structure Par_Tactical: PAR_TACTICAL =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    20
struct
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    21
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    22
(* parallel choice of single results *)
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    23
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    24
fun PARALLEL_CHOICE tacs st =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    25
  (case Par_List.get_some (fn tac => SINGLE tac st) tacs of
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    26
    NONE => Seq.empty
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    27
  | SOME st' => Seq.single st');
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    28
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    29
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    30
(* parallel refinement of non-schematic goal by single results *)
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    31
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    32
local
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    33
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    34
exception FAILED of unit;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    35
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    36
fun retrofit st' =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    37
  rotate_prems ~1 #>
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    38
  Thm.bicompose {flatten = false, match = false, incremented = false}
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    39
      (false, Goal.conclude st', Thm.nprems_of st') 1;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    40
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    41
in
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    42
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    43
fun PARALLEL_GOALS tac =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    44
  Thm.adjust_maxidx_thm ~1 #>
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    45
  (fn st =>
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    46
    if not (Multithreading.enabled ()) orelse Thm.maxidx_of st >= 0 orelse Thm.nprems_of st <= 1
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    47
    then DETERM tac st
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    48
    else
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    49
      let
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    50
        fun try_tac g =
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    51
          (case SINGLE tac g of
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    52
            NONE => raise FAILED ()
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    53
          | SOME g' => g');
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    54
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    55
        val goals = Drule.strip_imp_prems (Thm.cprop_of st);
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    56
        val results = Par_List.map (try_tac o Goal.init) goals;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    57
      in EVERY (map retrofit (rev results)) st end
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    58
      handle FAILED () => Seq.empty);
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    59
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    60
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    61
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    62
val PARALLEL_ALLGOALS = PARALLEL_GOALS o ALLGOALS;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    63
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    64
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    65
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    66
structure Basic_Par_Tactical: BASIC_PAR_TACTICAL = Par_Tactical;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    67
open Basic_Par_Tactical;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    68