src/Pure/par_tactical.ML
author wenzelm
Wed, 30 Dec 2015 21:57:52 +0100
changeset 62002 f1599e98c4d0
parent 60372 b62eaac5c1af
child 67660 0cae317eda7b
permissions -rw-r--r--
isabelle update_cartouches -c -t;
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 #>
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58009
diff changeset
    38
  Thm.bicompose NONE {flatten = false, match = false, incremented = false}
58009
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
60372
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    43
fun PARALLEL_GOALS tac st =
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    44
  if not (Multithreading.enabled ()) orelse Thm.nprems_of st <= 1 then DETERM tac st
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    45
  else
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    46
    let val subgoals = map (Thm.adjust_maxidx_cterm ~1) (Drule.strip_imp_prems (Thm.cprop_of st)) in
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    47
      if exists (fn sg => Thm.maxidx_of_cterm sg >= 0) subgoals then DETERM tac st
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    48
      else
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    49
        let
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    50
          fun try_tac g =
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    51
            (case SINGLE tac g of
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    52
              NONE => raise FAILED ()
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    53
            | SOME g' => g');
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    54
          val results = Par_List.map (try_tac o Goal.init) subgoals;
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    55
        in EVERY (map retrofit (rev results)) st end
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    56
        handle FAILED () => Seq.empty
b62eaac5c1af more tight treatment of subgoals: main goal may refer to extra variables;
wenzelm
parents: 58950
diff changeset
    57
    end;
58009
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    58
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    59
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    60
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    61
val PARALLEL_ALLGOALS = PARALLEL_GOALS o ALLGOALS;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    62
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    63
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    64
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    65
structure Basic_Par_Tactical: BASIC_PAR_TACTICAL = Par_Tactical;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    66
open Basic_Par_Tactical;