src/Pure/par_tactical.ML
author wenzelm
Thu, 14 Jun 2018 17:50:23 +0200
changeset 68449 6d0f1a5a16ea
parent 68130 6fb85346cb79
child 70521 9ddd66d53130
permissions -rw-r--r--
auto update;
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 =
67660
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    44
  let
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    45
    val goals =
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    46
      Drule.strip_imp_prems (Thm.cprop_of st)
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    47
      |> map (Thm.adjust_maxidx_cterm ~1);
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    48
  in
68130
6fb85346cb79 clarified future scheduling parameters, with support for parallel_limit;
wenzelm
parents: 67660
diff changeset
    49
    if Future.relevant goals andalso forall (fn g => Thm.maxidx_of_cterm g = ~1) goals then
67660
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    50
      let
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    51
        fun try_goal g =
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    52
          (case SINGLE tac (Goal.init g) of
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    53
            NONE => raise FAILED ()
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    54
          | SOME st' => st');
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    55
        val results = Par_List.map try_goal goals;
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    56
      in EVERY (map retrofit (rev results)) st
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    57
      end handle FAILED () => Seq.empty
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    58
    else DETERM tac st
0cae317eda7b misc tuning and clarification;
wenzelm
parents: 60372
diff changeset
    59
  end;
58009
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    60
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    61
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    62
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    63
val PARALLEL_ALLGOALS = PARALLEL_GOALS o ALLGOALS;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    64
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    65
end;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    66
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    67
structure Basic_Par_Tactical: BASIC_PAR_TACTICAL = Par_Tactical;
987c848d509b clarified modules;
wenzelm
parents:
diff changeset
    68
open Basic_Par_Tactical;