src/HOL/Tools/Nitpick/nitpick.ML
author blanchet
Tue, 01 Jun 2010 12:20:08 +0200
changeset 37260 dde817e6dfb1
parent 37257 eddca6e94b78
child 37273 4a7fe945412d
permissions -rw-r--r--
added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
33982
1ae222745c4a fixed paths in Nitpick's ML file headers
blanchet
parents: 33955
diff changeset
     1
(*  Title:      HOL/Tools/Nitpick/nitpick.ML
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     2
    Author:     Jasmin Blanchette, TU Muenchen
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
     3
    Copyright   2008, 2009, 2010
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     4
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     5
Finite model generation for HOL formulas using Kodkod.
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     6
*)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     7
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     8
signature NITPICK =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
     9
sig
33705
947184dc75c9 removed a few global names in Nitpick (styp, nat_less, pairf)
blanchet
parents: 33580
diff changeset
    10
  type styp = Nitpick_Util.styp
35711
548d3f16404b added term postprocessor to Nitpick, to provide custom syntax for typedefs
blanchet
parents: 35696
diff changeset
    11
  type term_postprocessor = Nitpick_Model.term_postprocessor
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    12
  type params =
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    13
    {cards_assigns: (typ option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    14
     maxes_assigns: (styp option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    15
     iters_assigns: (styp option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    16
     bitss: int list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    17
     bisim_depths: int list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    18
     boxes: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    19
     finitizes: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    20
     monos: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    21
     stds: (typ option * bool) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    22
     wfs: (styp option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    23
     sat_solver: string,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    24
     blocking: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    25
     falsify: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    26
     debug: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    27
     verbose: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    28
     overlord: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    29
     user_axioms: bool option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    30
     assms: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    31
     merge_type_vars: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    32
     binary_ints: bool option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    33
     destroy_constrs: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    34
     specialize: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    35
     star_linear_preds: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    36
     fast_descrs: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    37
     peephole_optim: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    38
     timeout: Time.time option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    39
     tac_timeout: Time.time option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    40
     max_threads: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    41
     show_datatypes: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    42
     show_consts: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    43
     evals: term list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    44
     formats: (term option * int list) list,
37260
dde817e6dfb1 added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
blanchet
parents: 37257
diff changeset
    45
     atomss: (typ option * string list) list,
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    46
     max_potential: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    47
     max_genuine: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    48
     check_potential: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    49
     check_genuine: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    50
     batch_size: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    51
     expect: string}
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    52
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    53
  val register_frac_type : string -> (string * string) list -> theory -> theory
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    54
  val unregister_frac_type : string -> theory -> theory
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    55
  val register_codatatype : typ -> string -> styp list -> theory -> theory
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    56
  val unregister_codatatype : typ -> theory -> theory
35711
548d3f16404b added term postprocessor to Nitpick, to provide custom syntax for typedefs
blanchet
parents: 35696
diff changeset
    57
  val register_term_postprocessor :
548d3f16404b added term postprocessor to Nitpick, to provide custom syntax for typedefs
blanchet
parents: 35696
diff changeset
    58
    typ -> term_postprocessor -> theory -> theory
548d3f16404b added term postprocessor to Nitpick, to provide custom syntax for typedefs
blanchet
parents: 35696
diff changeset
    59
  val unregister_term_postprocessor : typ -> theory -> theory
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    60
  val pick_nits_in_term :
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
    61
    Proof.state -> params -> bool -> int -> int -> int -> (term * term) list
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
    62
    -> term list -> term -> string * Proof.state
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    63
  val pick_nits_in_subgoal :
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
    64
    Proof.state -> params -> bool -> int -> int -> string * Proof.state
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    65
end;
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    66
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    67
structure Nitpick : NITPICK =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    68
struct
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    69
33232
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    70
open Nitpick_Util
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    71
open Nitpick_HOL
35070
96136eb6218f split "nitpick_hol.ML" into two files to make it more manageable;
blanchet
parents: 34998
diff changeset
    72
open Nitpick_Preproc
33232
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    73
open Nitpick_Mono
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    74
open Nitpick_Scope
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    75
open Nitpick_Peephole
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    76
open Nitpick_Rep
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    77
open Nitpick_Nut
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    78
open Nitpick_Kodkod
f93390060bbe internal renaming in Nitpick and fixed Kodkodi invokation on Linux;
blanchet
parents: 33192
diff changeset
    79
open Nitpick_Model
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
    80
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
    81
structure KK = Kodkod
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
    82
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    83
type params =
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    84
  {cards_assigns: (typ option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    85
   maxes_assigns: (styp option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    86
   iters_assigns: (styp option * int list) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    87
   bitss: int list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    88
   bisim_depths: int list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    89
   boxes: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    90
   finitizes: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    91
   monos: (typ option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    92
   stds: (typ option * bool) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    93
   wfs: (styp option * bool option) list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    94
   sat_solver: string,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    95
   blocking: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    96
   falsify: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    97
   debug: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    98
   verbose: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
    99
   overlord: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   100
   user_axioms: bool option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   101
   assms: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   102
   merge_type_vars: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   103
   binary_ints: bool option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   104
   destroy_constrs: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   105
   specialize: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   106
   star_linear_preds: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   107
   fast_descrs: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   108
   peephole_optim: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   109
   timeout: Time.time option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   110
   tac_timeout: Time.time option,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   111
   max_threads: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   112
   show_datatypes: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   113
   show_consts: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   114
   evals: term list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   115
   formats: (term option * int list) list,
37260
dde817e6dfb1 added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
blanchet
parents: 37257
diff changeset
   116
   atomss: (typ option * string list) list,
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   117
   max_potential: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   118
   max_genuine: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   119
   check_potential: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   120
   check_genuine: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   121
   batch_size: int,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   122
   expect: string}
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   123
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   124
type problem_extension =
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   125
  {free_names: nut list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   126
   sel_names: nut list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   127
   nonsel_names: nut list,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   128
   rel_table: nut NameTable.table,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   129
   unsound: bool,
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   130
   scope: scope}
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   131
 
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   132
type rich_problem = KK.problem * problem_extension
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   133
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   134
fun pretties_for_formulas _ _ [] = []
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   135
  | pretties_for_formulas ctxt s ts =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   136
    [Pretty.str (s ^ plural_s_for_list ts ^ ":"),
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   137
     Pretty.indent indent_size (Pretty.chunks
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   138
         (map2 (fn j => fn t =>
34121
5e831d805118 get rid of polymorphic equality in Nitpick's code + a few minor cleanups
blanchet
parents: 34039
diff changeset
   139
                   Pretty.block [t |> shorten_names_in_term
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   140
                                   |> Syntax.pretty_term ctxt,
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   141
                                 Pretty.str (if j = 1 then "." else ";")])
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   142
               (length ts downto 1) ts))]
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   143
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   144
fun install_java_message () =
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   145
  "Nitpick requires a Java 1.5 virtual machine called \"java\"."
33568
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   146
fun install_kodkodi_message () =
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   147
  "Nitpick requires the external Java program Kodkodi. To install it, download \
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   148
  \the package from Isabelle's web page and add the \"kodkodi-x.y.z\" \
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   149
  \directory's full path to \"" ^
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   150
  Path.implode (Path.expand (Path.appends
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   151
      (Path.variable "ISABELLE_HOME_USER" ::
36266
28188e3650ee clarify error message
blanchet
parents: 36128
diff changeset
   152
       map Path.basic ["etc", "components"]))) ^ "\" on a line of its own."
33568
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   153
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   154
val max_unsound_delay_ms = 200
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   155
val max_unsound_delay_percent = 2
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   156
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   157
fun unsound_delay_for_timeout NONE = max_unsound_delay_ms
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   158
  | unsound_delay_for_timeout (SOME timeout) =
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   159
    Int.max (0, Int.min (max_unsound_delay_ms,
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   160
                         Time.toMilliseconds timeout
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   161
                         * max_unsound_delay_percent div 100))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   162
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   163
fun passed_deadline NONE = false
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   164
  | passed_deadline (SOME time) = Time.compare (Time.now (), time) <> LESS
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   165
34123
c4988215a691 distinguish better between "complete" (vs. incomplete) types and "concrete" (vs. abstract) types in Nitpick;
blanchet
parents: 34121
diff changeset
   166
fun none_true assigns = forall (not_equal (SOME true) o snd) assigns
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   167
34038
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   168
val syntactic_sorts =
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   169
  @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,eq}"} @
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   170
  @{sort number}
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   171
fun has_tfree_syntactic_sort (TFree (_, S as _ :: _)) =
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   172
    subset (op =) (S, syntactic_sorts)
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   173
  | has_tfree_syntactic_sort _ = false
a2736debeabd make Nitpick output the message "Hint: Maybe you forgot a type constraint?" only for syntactic classes
blanchet
parents: 33982
diff changeset
   174
val has_syntactic_sorts = exists_type (exists_subtype has_tfree_syntactic_sort)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   175
33568
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   176
fun plazy f = Pretty.blk (0, pstrs (f ()))
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   177
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   178
fun pick_them_nits_in_term deadline state (params : params) auto i n step
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   179
                           subst orig_assm_ts orig_t =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   180
  let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   181
    val timer = Timer.startRealTimer ()
34935
cb011ba38950 removed the Nitpick code that loaded the "Nitpick" theory explicitly if it's not already loaded, because this didn't work properly and is of doubtful value
blanchet
parents: 34126
diff changeset
   182
    val thy = Proof.theory_of state
cb011ba38950 removed the Nitpick code that loaded the "Nitpick" theory explicitly if it's not already loaded, because this didn't work properly and is of doubtful value
blanchet
parents: 34126
diff changeset
   183
    val ctxt = Proof.context_of state
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   184
(* FIXME: reintroduce code before new release:
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   185
34039
1fba360b5443 made Nitpick work also for people who import "Plain" instead of "Main"
blanchet
parents: 34038
diff changeset
   186
    val nitpick_thy = ThyInfo.get_theory "Nitpick"
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   187
    val _ = Theory.subthy (nitpick_thy, thy) orelse
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   188
            error "You must import the theory \"Nitpick\" to use Nitpick"
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   189
*)
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   190
    val {cards_assigns, maxes_assigns, iters_assigns, bitss, bisim_depths,
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   191
         boxes, finitizes, monos, stds, wfs, sat_solver, falsify, debug,
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   192
         verbose, overlord, user_axioms, assms, merge_type_vars, binary_ints,
36389
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   193
         destroy_constrs, specialize, star_linear_preds, fast_descrs,
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   194
         peephole_optim, tac_timeout, max_threads, show_datatypes, show_consts,
37260
dde817e6dfb1 added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
blanchet
parents: 37257
diff changeset
   195
         evals, formats, atomss, max_potential, max_genuine, check_potential,
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   196
         check_genuine, batch_size, ...} = params
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   197
    val state_ref = Unsynchronized.ref state
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   198
    val pprint =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   199
      if auto then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   200
        Unsynchronized.change state_ref o Proof.goal_message o K
33561
ab01b72715ef introduced Auto Nitpick in addition to Auto Quickcheck;
blanchet
parents: 33558
diff changeset
   201
        o Pretty.chunks o cons (Pretty.str "") o single
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   202
        o Pretty.mark Markup.hilite
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   203
      else
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   204
        (fn s => (priority s; if debug then tracing s else ()))
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   205
        o Pretty.string_of
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   206
    fun pprint_m f = () |> not auto ? pprint o f
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   207
    fun pprint_v f = () |> verbose ? pprint o f
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   208
    fun pprint_d f = () |> debug ? pprint o f
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   209
    val print = pprint o curry Pretty.blk 0 o pstrs
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   210
    val print_g = pprint o Pretty.str
33568
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   211
    val print_m = pprint_m o K o plazy
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   212
    val print_v = pprint_v o K o plazy
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   213
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   214
    fun check_deadline () =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   215
      if debug andalso passed_deadline deadline then raise TimeLimit.TimeOut
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   216
      else ()
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   217
    fun do_interrupted () =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   218
      if passed_deadline deadline then raise TimeLimit.TimeOut
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   219
      else raise Interrupt
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   220
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   221
    val orig_assm_ts = if assms orelse auto then orig_assm_ts else []
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   222
    val _ =
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   223
      if step = 0 then
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   224
        print_m (fn () => "Nitpicking formula...")
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   225
      else
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   226
        pprint_m (fn () => Pretty.chunks (
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   227
            pretties_for_formulas ctxt ("Nitpicking " ^
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   228
                (if i <> 1 orelse n <> 1 then
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   229
                   "subgoal " ^ string_of_int i ^ " of " ^ string_of_int n
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   230
                 else
35181
92d857a4e5e0 synchronize Nitpick's wellfoundedness formulas caching
blanchet
parents: 35177
diff changeset
   231
                   "goal")) [Logic.list_implies (orig_assm_ts, orig_t)]))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   232
    val neg_t = if falsify then Logic.mk_implies (orig_t, @{prop False})
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   233
                else orig_t
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   234
    val assms_t = Logic.mk_conjunction_list (neg_t :: orig_assm_ts)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   235
    val (assms_t, evals) =
33705
947184dc75c9 removed a few global names in Nitpick (styp, nat_less, pairf)
blanchet
parents: 33580
diff changeset
   236
      assms_t :: evals |> merge_type_vars ? merge_type_vars_in_terms
947184dc75c9 removed a few global names in Nitpick (styp, nat_less, pairf)
blanchet
parents: 33580
diff changeset
   237
                       |> pairf hd tl
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   238
    val original_max_potential = max_potential
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   239
    val original_max_genuine = max_genuine
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   240
    val max_bisim_depth = fold Integer.max bisim_depths ~1
35220
2bcdae5f4fdb added support for nonstandard "nat"s to Nitpick and fixed bugs in binary "nat"s and "int"s
blanchet
parents: 35190
diff changeset
   241
    val case_names = case_const_names thy stds
37256
0dca1ec52999 thread along context instead of theory for typedef lookup
blanchet
parents: 37213
diff changeset
   242
    val (defs, built_in_nondefs, user_nondefs) = all_axioms_of ctxt subst
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   243
    val def_table = const_def_table ctxt subst defs
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   244
    val nondef_table = const_nondef_table (built_in_nondefs @ user_nondefs)
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   245
    val simp_table = Unsynchronized.ref (const_simp_table ctxt subst)
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   246
    val psimp_table = const_psimp_table ctxt subst
35807
e4d1b5cbd429 added support for "specification" and "ax_specification" constructs to Nitpick
blanchet
parents: 35711
diff changeset
   247
    val choice_spec_table = const_choice_spec_table ctxt subst
e4d1b5cbd429 added support for "specification" and "ax_specification" constructs to Nitpick
blanchet
parents: 35711
diff changeset
   248
    val user_nondefs =
e4d1b5cbd429 added support for "specification" and "ax_specification" constructs to Nitpick
blanchet
parents: 35711
diff changeset
   249
      user_nondefs |> filter_out (is_choice_spec_axiom thy choice_spec_table)
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   250
    val intro_table = inductive_intro_table ctxt subst def_table
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   251
    val ground_thm_table = ground_theorem_table thy
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   252
    val ersatz_table = ersatz_table thy
35070
96136eb6218f split "nitpick_hol.ML" into two files to make it more manageable;
blanchet
parents: 34998
diff changeset
   253
    val (hol_ctxt as {wf_cache, ...}) =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   254
      {thy = thy, ctxt = ctxt, max_bisim_depth = max_bisim_depth, boxes = boxes,
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   255
       stds = stds, wfs = wfs, user_axioms = user_axioms, debug = debug,
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   256
       binary_ints = binary_ints, destroy_constrs = destroy_constrs,
36389
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   257
       specialize = specialize, star_linear_preds = star_linear_preds,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   258
       fast_descrs = fast_descrs, tac_timeout = tac_timeout, evals = evals,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   259
       case_names = case_names, def_table = def_table,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   260
       nondef_table = nondef_table, user_nondefs = user_nondefs,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   261
       simp_table = simp_table, psimp_table = psimp_table,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   262
       choice_spec_table = choice_spec_table, intro_table = intro_table,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   263
       ground_thm_table = ground_thm_table, ersatz_table = ersatz_table,
8228b3a4a2ba remove "skolemize" option from Nitpick, since Skolemization is always useful
blanchet
parents: 36388
diff changeset
   264
       skolems = Unsynchronized.ref [], special_funs = Unsynchronized.ref [],
33580
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   265
       unrolled_preds = Unsynchronized.ref [], wf_cache = Unsynchronized.ref [],
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   266
       constr_cache = Unsynchronized.ref []}
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   267
    val frees = Term.add_frees assms_t []
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   268
    val _ = null (Term.add_tvars assms_t []) orelse
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   269
            raise NOT_SUPPORTED "schematic type variables"
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   270
    val (nondef_ts, def_ts, got_all_mono_user_axioms, no_poly_user_axioms,
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   271
         binarize) = preprocess_term hol_ctxt finitizes monos assms_t
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   272
    val got_all_user_axioms =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   273
      got_all_mono_user_axioms andalso no_poly_user_axioms
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   274
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   275
    fun print_wf (x, (gfp, wf)) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   276
      pprint (Pretty.blk (0,
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   277
          pstrs ("The " ^ (if gfp then "co" else "") ^ "inductive predicate \"")
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   278
          @ Syntax.pretty_term ctxt (Const x) ::
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   279
          pstrs (if wf then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   280
                   "\" was proved well-founded. Nitpick can compute it \
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   281
                   \efficiently."
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   282
                 else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   283
                   "\" could not be proved well-founded. Nitpick might need to \
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   284
                   \unroll it.")))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   285
    val _ = if verbose then List.app print_wf (!wf_cache) else ()
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   286
    val _ =
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   287
      pprint_d (fn () => Pretty.chunks
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   288
          (pretties_for_formulas ctxt "Preprocessed formula" [hd nondef_ts] @
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   289
           pretties_for_formulas ctxt "Relevant definitional axiom" def_ts @
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   290
           pretties_for_formulas ctxt "Relevant nondefinitional axiom"
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   291
                                 (tl nondef_ts)))
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   292
    val _ = List.app (ignore o Term.type_of) (nondef_ts @ def_ts)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   293
            handle TYPE (_, Ts, ts) =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   294
                   raise TYPE ("Nitpick.pick_them_nits_in_term", Ts, ts)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   295
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   296
    val nondef_us = map (nut_from_term hol_ctxt Eq) nondef_ts
35070
96136eb6218f split "nitpick_hol.ML" into two files to make it more manageable;
blanchet
parents: 34998
diff changeset
   297
    val def_us = map (nut_from_term hol_ctxt DefEq) def_ts
33558
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   298
    val (free_names, const_names) =
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   299
      fold add_free_and_const_names (nondef_us @ def_us) ([], [])
33558
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   300
    val (sel_names, nonsel_names) =
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   301
      List.partition (is_sel o nickname_of) const_names
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   302
    val sound_finitizes =
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   303
      none_true (filter_out (fn (SOME (Type (@{type_name fun}, _)), _) => true
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   304
                          | _ => false) finitizes)
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   305
    val standard = forall snd stds
33558
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   306
(*
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   307
    val _ = List.app (print_g o string_for_nut ctxt) (nondef_us @ def_us)
33558
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   308
*)
a2db56854b83 optimized Nitpick's encoding and rendering of datatypes whose constructors don't appear in the problem
blanchet
parents: 33556
diff changeset
   309
34121
5e831d805118 get rid of polymorphic equality in Nitpick's code + a few minor cleanups
blanchet
parents: 34039
diff changeset
   310
    val unique_scope = forall (curry (op =) 1 o length o snd) cards_assigns
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   311
    fun monotonicity_message Ts extra =
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   312
      let val ss = map (quote o string_for_type ctxt) Ts in
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   313
        "The type" ^ plural_s_for_list ss ^ " " ^
36380
1e8fcaccb3e8 stop referring to Sledgehammer_Util stuff all over Nitpick code; instead, redeclare any needed function in Nitpick_Util as synonym for the Sledgehammer_Util function of the same name
blanchet
parents: 36266
diff changeset
   314
        space_implode " " (serial_commas "and" ss) ^ " " ^
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   315
        (if none_true monos then
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   316
           "passed the monotonicity test"
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   317
         else
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   318
           (if length ss = 1 then "is" else "are") ^ " considered monotonic") ^
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   319
        ". " ^ extra
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   320
      end
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   321
    fun is_type_fundamentally_monotonic T =
37256
0dca1ec52999 thread along context instead of theory for typedef lookup
blanchet
parents: 37213
diff changeset
   322
      (is_datatype ctxt stds T andalso not (is_quot_type thy T) andalso
0dca1ec52999 thread along context instead of theory for typedef lookup
blanchet
parents: 37213
diff changeset
   323
       (not (is_pure_typedef ctxt T) orelse is_univ_typedef ctxt T)) orelse
35075
888802be2019 handle Nitpick's nonstandard model enumeration in a cleaner way;
blanchet
parents: 35070
diff changeset
   324
      is_number_type thy T orelse is_bit_type T
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   325
    fun is_type_actually_monotonic T =
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   326
      formulas_monotonic hol_ctxt binarize T (nondef_ts, def_ts)
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   327
    fun is_type_kind_of_monotonic T =
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   328
      case triple_lookup (type_match thy) monos T of
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   329
        SOME (SOME false) => false
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   330
      | _ => is_type_actually_monotonic T
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   331
    fun is_type_monotonic T =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   332
      unique_scope orelse
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   333
      case triple_lookup (type_match thy) monos T of
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   334
        SOME (SOME b) => b
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   335
      | _ => is_type_fundamentally_monotonic T orelse
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   336
             is_type_actually_monotonic T
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   337
    fun is_shallow_datatype_finitizable (T as Type (@{type_name fin_fun}, _)) =
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   338
        is_type_kind_of_monotonic T
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   339
      | is_shallow_datatype_finitizable (T as Type (@{type_name fun_box}, _)) =
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   340
        is_type_kind_of_monotonic T
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   341
      | is_shallow_datatype_finitizable T =
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   342
        case triple_lookup (type_match thy) finitizes T of
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   343
          SOME (SOME b) => b
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   344
        | _ => is_type_kind_of_monotonic T
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   345
    fun is_datatype_deep T =
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   346
      not standard orelse T = nat_T orelse is_word_type T orelse
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   347
      exists (curry (op =) T o domain_type o type_of) sel_names
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   348
    val all_Ts = ground_types_in_terms hol_ctxt binarize (nondef_ts @ def_ts)
35408
b48ab741683b modernized structure Term_Ord;
wenzelm
parents: 35386
diff changeset
   349
                 |> sort Term_Ord.typ_ord
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   350
    val _ = if verbose andalso binary_ints = SOME true andalso
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   351
               exists (member (op =) [nat_T, int_T]) all_Ts then
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   352
              print_v (K "The option \"binary_ints\" will be ignored because \
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   353
                         \of the presence of rationals, reals, \"Suc\", \
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   354
                         \\"gcd\", or \"lcm\" in the problem or because of the \
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   355
                         \\"non_std\" option.")
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   356
            else
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   357
              ()
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   358
    val (mono_Ts, nonmono_Ts) = List.partition is_type_monotonic all_Ts
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   359
    val _ =
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   360
      if verbose andalso not unique_scope then
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   361
        case filter_out is_type_fundamentally_monotonic mono_Ts of
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   362
          [] => ()
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   363
        | interesting_mono_Ts =>
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   364
          print_v (K (monotonicity_message interesting_mono_Ts
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   365
                         "Nitpick might be able to skip some scopes."))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   366
      else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   367
        ()
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   368
    val (deep_dataTs, shallow_dataTs) =
37256
0dca1ec52999 thread along context instead of theory for typedef lookup
blanchet
parents: 37213
diff changeset
   369
      all_Ts |> filter (is_datatype ctxt stds)
0dca1ec52999 thread along context instead of theory for typedef lookup
blanchet
parents: 37213
diff changeset
   370
             |> List.partition is_datatype_deep
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   371
    val finitizable_dataTs =
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   372
      shallow_dataTs |> filter_out (is_finite_type hol_ctxt)
35665
ff2bf50505ab added "finitize" option to Nitpick + remove dependency on "Coinductive_List"
blanchet
parents: 35408
diff changeset
   373
                     |> filter is_shallow_datatype_finitizable
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   374
    val _ =
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   375
      if verbose andalso not (null finitizable_dataTs) then
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   376
        print_v (K (monotonicity_message finitizable_dataTs
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   377
                        "Nitpick can use a more precise finite encoding."))
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   378
      else
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   379
        ()
35183
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   380
    (* This detection code is an ugly hack. Fortunately, it is used only to
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   381
       provide a hint to the user. *)
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   382
    fun is_struct_induct_step (name, (Rule_Cases.Case {fixes, assumes, ...}, _)) =
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   383
      not (null fixes) andalso
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   384
      exists (String.isSuffix ".hyps" o fst) assumes andalso
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   385
      exists (exists (curry (op =) name o shortest_name o fst)
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   386
              o datatype_constrs hol_ctxt) deep_dataTs
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   387
    val likely_in_struct_induct_step =
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   388
      exists is_struct_induct_step (ProofContext.cases_of ctxt)
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   389
    val _ = if standard andalso likely_in_struct_induct_step then
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   390
              pprint_m (fn () => Pretty.blk (0,
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   391
                  pstrs "Hint: To check that the induction hypothesis is \
35177
168041f24f80 various cosmetic changes to Nitpick
blanchet
parents: 35075
diff changeset
   392
                        \general enough, try this command: " @
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   393
                  [Pretty.mark Markup.sendback (Pretty.blk (0,
35183
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   394
                       pstrs ("nitpick [non_std, show_all]")))] @ pstrs "."))
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   395
            else
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   396
              ()
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   397
(*
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   398
    val _ = print_g "Monotonic types:"
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   399
    val _ = List.app (print_g o string_for_type ctxt) mono_Ts
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   400
    val _ = print_g "Nonmonotonic types:"
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   401
    val _ = List.app (print_g o string_for_type ctxt) nonmono_Ts
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   402
*)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   403
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   404
    val incremental = Int.max (max_potential, max_genuine) >= 2
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   405
    val actual_sat_solver =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   406
      if sat_solver <> "smart" then
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   407
        if incremental andalso
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   408
           not (member (op =) (Kodkod_SAT.configured_sat_solvers true)
35333
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   409
                       sat_solver) then
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   410
          (print_m (K ("An incremental SAT solver is required: \"SAT4J\" will \
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   411
                       \be used instead of " ^ quote sat_solver ^ "."));
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   412
           "SAT4J")
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   413
        else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   414
          sat_solver
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   415
      else
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   416
        Kodkod_SAT.smart_sat_solver_name incremental
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   417
    val _ =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   418
      if sat_solver = "smart" then
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   419
        print_v (fn () =>
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   420
            "Using SAT solver " ^ quote actual_sat_solver ^ ". The following" ^
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   421
            (if incremental then " incremental " else " ") ^
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   422
            "solvers are configured: " ^
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   423
            commas_quote (Kodkod_SAT.configured_sat_solvers incremental) ^ ".")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   424
      else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   425
        ()
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   426
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   427
    val too_big_scopes = Unsynchronized.ref []
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   428
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   429
    fun problem_for_scope unsound
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   430
            (scope as {card_assigns, bits, bisim_depth, datatypes, ofs, ...}) =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   431
      let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   432
        val _ = not (exists (fn other => scope_less_eq other scope)
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   433
                            (!too_big_scopes)) orelse
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   434
                raise TOO_LARGE ("Nitpick.pick_them_nits_in_term.\
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   435
                                 \problem_for_scope", "too large scope")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   436
(*
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   437
        val _ = print_g "Offsets:"
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   438
        val _ = List.app (fn (T, j0) =>
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   439
                             print_g (string_for_type ctxt T ^ " = " ^
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   440
                                    string_of_int j0))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   441
                         (Typtab.dest ofs)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   442
*)
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   443
        val all_exact = forall (is_exact_type datatypes true) all_Ts
34123
c4988215a691 distinguish better between "complete" (vs. incomplete) types and "concrete" (vs. abstract) types in Nitpick;
blanchet
parents: 34121
diff changeset
   444
        val repify_consts = choose_reps_for_consts scope all_exact
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   445
        val main_j0 = offset_of_type ofs bool_T
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   446
        val (nat_card, nat_j0) = spec_of_type scope nat_T
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   447
        val (int_card, int_j0) = spec_of_type scope int_T
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   448
        val _ = (nat_j0 = main_j0 andalso int_j0 = main_j0) orelse
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   449
                raise BAD ("Nitpick.pick_them_nits_in_term.problem_for_scope",
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   450
                           "bad offsets")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   451
        val kk = kodkod_constrs peephole_optim nat_card int_card main_j0
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   452
        val (free_names, rep_table) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   453
          choose_reps_for_free_vars scope free_names NameTable.empty
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   454
        val (sel_names, rep_table) = choose_reps_for_all_sels scope rep_table
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   455
        val (nonsel_names, rep_table) = repify_consts nonsel_names rep_table
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   456
        val min_highest_arity =
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   457
          NameTable.fold (Integer.max o arity_of_rep o snd) rep_table 1
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   458
        val min_univ_card =
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   459
          NameTable.fold (Integer.max o min_univ_card_of_rep o snd) rep_table
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   460
                         (univ_card nat_card int_card main_j0 [] KK.True)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   461
        val _ = check_arity min_univ_card min_highest_arity
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   462
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   463
        val def_us = map (choose_reps_in_nut scope unsound rep_table true)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   464
                         def_us
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   465
        val nondef_us = map (choose_reps_in_nut scope unsound rep_table false)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   466
                            nondef_us
33745
daf236998f82 comment out debugging code in Nitpick
blanchet
parents: 33744
diff changeset
   467
(*
36128
a3d8d5329438 make Nitpick output everything to tracing in debug mode;
blanchet
parents: 36126
diff changeset
   468
        val _ = List.app (print_g o string_for_nut ctxt)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   469
                         (free_names @ sel_names @ nonsel_names @
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   470
                          nondef_us @ def_us)
33745
daf236998f82 comment out debugging code in Nitpick
blanchet
parents: 33744
diff changeset
   471
*)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   472
        val (free_rels, pool, rel_table) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   473
          rename_free_vars free_names initial_pool NameTable.empty
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   474
        val (sel_rels, pool, rel_table) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   475
          rename_free_vars sel_names pool rel_table
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   476
        val (other_rels, pool, rel_table) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   477
          rename_free_vars nonsel_names pool rel_table
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   478
        val nondef_us = map (rename_vars_in_nut pool rel_table) nondef_us
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   479
        val def_us = map (rename_vars_in_nut pool rel_table) def_us
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   480
        val nondef_fs = map (kodkod_formula_from_nut ofs kk) nondef_us
35280
54ab4921f826 fixed a few bugs in Nitpick and removed unreferenced variables
blanchet
parents: 35220
diff changeset
   481
        val def_fs = map (kodkod_formula_from_nut ofs kk) def_us
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   482
        val formula = fold (fold s_and) [def_fs, nondef_fs] KK.True
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   483
        val comment = (if unsound then "unsound" else "sound") ^ "\n" ^
37146
f652333bbf8e renamed structure PrintMode to Print_Mode, keeping the old name as legacy alias for some time;
wenzelm
parents: 36913
diff changeset
   484
                      Print_Mode.setmp [] multiline_string_for_scope scope
34998
5e492a862b34 four changes to Nitpick:
blanchet
parents: 34982
diff changeset
   485
        val kodkod_sat_solver =
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   486
          Kodkod_SAT.sat_solver_spec actual_sat_solver |> snd
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   487
        val bit_width = if bits = 0 then 16 else bits + 1
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   488
        val delay =
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   489
          if unsound then
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   490
            Option.map (fn time => Time.- (time, Time.now ())) deadline
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   491
            |> unsound_delay_for_timeout
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   492
          else
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   493
            0
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   494
        val settings = [("solver", commas_quote kodkod_sat_solver),
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   495
                        ("skolem_depth", "-1"),
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   496
                        ("bit_width", string_of_int bit_width),
36386
2132f15b366f Fruhjahrsputz: remove three mostly useless Nitpick options
blanchet
parents: 36385
diff changeset
   497
                        ("symmetry_breaking", "20"),
2132f15b366f Fruhjahrsputz: remove three mostly useless Nitpick options
blanchet
parents: 36385
diff changeset
   498
                        ("sharing", "3"),
2132f15b366f Fruhjahrsputz: remove three mostly useless Nitpick options
blanchet
parents: 36385
diff changeset
   499
                        ("flatten", "false"),
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   500
                        ("delay", signed_string_of_int delay)]
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   501
        val plain_rels = free_rels @ other_rels
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   502
        val plain_bounds = map (bound_for_plain_rel ctxt debug) plain_rels
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   503
        val plain_axioms = map (declarative_axiom_for_plain_rel kk) plain_rels
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   504
        val sel_bounds = map (bound_for_sel_rel ctxt debug datatypes) sel_rels
35190
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   505
        val dtype_axioms =
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   506
          declarative_axioms_for_datatypes hol_ctxt binarize bits ofs kk
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   507
                                           rel_table datatypes
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   508
        val declarative_axioms = plain_axioms @ dtype_axioms
35220
2bcdae5f4fdb added support for nonstandard "nat"s to Nitpick and fixed bugs in binary "nat"s and "int"s
blanchet
parents: 35190
diff changeset
   509
        val univ_card = Int.max (univ_card nat_card int_card main_j0
2bcdae5f4fdb added support for nonstandard "nat"s to Nitpick and fixed bugs in binary "nat"s and "int"s
blanchet
parents: 35190
diff changeset
   510
                                     (plain_bounds @ sel_bounds) formula,
2bcdae5f4fdb added support for nonstandard "nat"s to Nitpick and fixed bugs in binary "nat"s and "int"s
blanchet
parents: 35190
diff changeset
   511
                                 main_j0 |> bits > 0 ? Integer.add (bits + 1))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   512
        val built_in_bounds = bounds_for_built_in_rels_in_formula debug
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   513
                                  univ_card nat_card int_card main_j0 formula
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   514
        val bounds = built_in_bounds @ plain_bounds @ sel_bounds
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   515
                     |> not debug ? merge_bounds
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   516
        val highest_arity =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   517
          fold Integer.max (map (fst o fst) (maps fst bounds)) 0
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   518
        val formula = fold_rev s_and declarative_axioms formula
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   519
        val _ = if bits = 0 then () else check_bits bits formula
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   520
        val _ = if formula = KK.False then ()
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   521
                else check_arity univ_card highest_arity
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   522
      in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   523
        SOME ({comment = comment, settings = settings, univ_card = univ_card,
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   524
               tuple_assigns = [], bounds = bounds,
35280
54ab4921f826 fixed a few bugs in Nitpick and removed unreferenced variables
blanchet
parents: 35220
diff changeset
   525
               int_bounds = if bits = 0 then sequential_int_bounds univ_card
54ab4921f826 fixed a few bugs in Nitpick and removed unreferenced variables
blanchet
parents: 35220
diff changeset
   526
                            else pow_of_two_int_bounds bits main_j0,
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   527
               expr_assigns = [], formula = formula},
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   528
              {free_names = free_names, sel_names = sel_names,
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   529
               nonsel_names = nonsel_names, rel_table = rel_table,
35386
45a4e19d3ebd more work on the new monotonicity stuff in Nitpick
blanchet
parents: 35385
diff changeset
   530
               unsound = unsound, scope = scope})
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   531
      end
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   532
      handle TOO_LARGE (loc, msg) =>
34936
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   533
             if loc = "Nitpick_Kodkod.check_arity" andalso
c4f04bee79f3 some work on Nitpick's support for quotient types;
blanchet
parents: 34935
diff changeset
   534
                not (Typtab.is_empty ofs) then
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   535
               problem_for_scope unsound
35190
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   536
                   {hol_ctxt = hol_ctxt, binarize = binarize,
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   537
                    card_assigns = card_assigns, bits = bits,
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   538
                    bisim_depth = bisim_depth, datatypes = datatypes,
ce653cc27a94 make sure that Nitpick uses binary notation consistently if "binary_ints" is enabled
blanchet
parents: 35185
diff changeset
   539
                    ofs = Typtab.empty}
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   540
             else if loc = "Nitpick.pick_them_nits_in_term.\
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   541
                           \problem_for_scope" then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   542
               NONE
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   543
             else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   544
               (Unsynchronized.change too_big_scopes (cons scope);
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   545
                print_v (fn () => ("Limit reached: " ^ msg ^
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   546
                                   ". Skipping " ^ (if unsound then "potential"
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   547
                                                    else "genuine") ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   548
                                   " component of scope."));
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   549
                NONE)
35280
54ab4921f826 fixed a few bugs in Nitpick and removed unreferenced variables
blanchet
parents: 35220
diff changeset
   550
           | TOO_SMALL (_, msg) =>
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   551
             (print_v (fn () => ("Limit reached: " ^ msg ^
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   552
                                 ". Skipping " ^ (if unsound then "potential"
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   553
                                                  else "genuine") ^
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   554
                                 " component of scope."));
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   555
              NONE)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   556
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   557
    val das_wort_model =
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   558
      (if falsify then "counterexample" else "model")
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   559
      |> not standard ? prefix "nonstandard "
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   560
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   561
    val scopes = Unsynchronized.ref []
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   562
    val generated_scopes = Unsynchronized.ref []
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   563
    val generated_problems = Unsynchronized.ref ([] : rich_problem list)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   564
    val checked_problems = Unsynchronized.ref (SOME [])
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   565
    val met_potential = Unsynchronized.ref 0
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   566
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   567
    fun update_checked_problems problems =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   568
      List.app (Unsynchronized.change checked_problems o Option.map o cons
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   569
                o nth problems)
35333
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   570
    fun show_kodkod_warning "" = ()
35334
b83b9f2a4b92 show Kodkod warning message even in non-verbose mode
blanchet
parents: 35333
diff changeset
   571
      | show_kodkod_warning s = print_m (fn () => "Kodkod warning: " ^ s ^ ".")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   572
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   573
    fun print_and_check_model genuine bounds
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   574
            ({free_names, sel_names, nonsel_names, rel_table, scope, ...}
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   575
             : problem_extension) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   576
      let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   577
        val (reconstructed_model, codatatypes_ok) =
36390
eee4ee6a5cbe remove "show_skolems" option and change style of record declarations
blanchet
parents: 36389
diff changeset
   578
          reconstruct_hol_model {show_datatypes = show_datatypes,
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   579
                                 show_consts = show_consts}
37260
dde817e6dfb1 added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
blanchet
parents: 37257
diff changeset
   580
              scope formats atomss frees free_names sel_names nonsel_names
dde817e6dfb1 added "atoms" option to Nitpick (request from Karlsruhe) + wrap Refute. functions to "nitpick_util.ML"
blanchet
parents: 37257
diff changeset
   581
              rel_table bounds
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   582
        val genuine_means_genuine =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   583
          got_all_user_axioms andalso none_true wfs andalso
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   584
          sound_finitizes andalso codatatypes_ok
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   585
      in
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   586
        (pprint (Pretty.chunks
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   587
             [Pretty.blk (0,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   588
                  (pstrs ("Nitpick found a" ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   589
                          (if not genuine then " potential "
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   590
                           else if genuine_means_genuine then " "
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   591
                           else " quasi genuine ") ^ das_wort_model) @
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   592
                   (case pretties_for_scope scope verbose of
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   593
                      [] => []
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   594
                    | pretties => pstrs " for " @ pretties) @
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   595
                   [Pretty.str ":\n"])),
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   596
              Pretty.indent indent_size reconstructed_model]);
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   597
         if genuine then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   598
           (if check_genuine andalso standard then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   599
              case prove_hol_model scope tac_timeout free_names sel_names
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   600
                                   rel_table bounds assms_t of
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   601
                SOME true =>
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   602
                print ("Confirmation by \"auto\": The above " ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   603
                       das_wort_model ^ " is really genuine.")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   604
              | SOME false =>
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   605
                if genuine_means_genuine then
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   606
                  error ("A supposedly genuine " ^ das_wort_model ^ " was \
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   607
                         \shown to be spurious by \"auto\".\nThis should never \
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   608
                         \happen.\nPlease send a bug report to blanchet\
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   609
                         \te@in.tum.de.")
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   610
                 else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   611
                   print ("Refutation by \"auto\": The above " ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   612
                          das_wort_model ^ " is spurious.")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   613
               | NONE => print "No confirmation by \"auto\"."
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   614
            else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   615
              ();
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   616
            if not standard andalso likely_in_struct_induct_step then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   617
              print "The existence of a nonstandard model suggests that the \
36126
00d550b6cfd4 cosmetics
blanchet
parents: 35968
diff changeset
   618
                    \induction hypothesis is not general enough or may even be \
00d550b6cfd4 cosmetics
blanchet
parents: 35968
diff changeset
   619
                    \wrong. See the Nitpick manual's \"Inductive Properties\" \
00d550b6cfd4 cosmetics
blanchet
parents: 35968
diff changeset
   620
                    \section for details (\"isabelle doc nitpick\")."
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   621
            else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   622
              ();
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   623
            if has_syntactic_sorts orig_t then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   624
              print "Hint: Maybe you forgot a type constraint?"
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   625
            else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   626
              ();
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   627
            if not genuine_means_genuine then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   628
              if no_poly_user_axioms then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   629
                let
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   630
                  val options =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   631
                    [] |> not got_all_mono_user_axioms
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   632
                          ? cons ("user_axioms", "\"true\"")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   633
                       |> not (none_true wfs)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   634
                          ? cons ("wf", "\"smart\" or \"false\"")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   635
                       |> not sound_finitizes
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   636
                          ? cons ("finitize", "\"smart\" or \"false\"")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   637
                       |> not codatatypes_ok
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   638
                          ? cons ("bisim_depth", "a nonnegative value")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   639
                  val ss =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   640
                    map (fn (name, value) => quote name ^ " set to " ^ value)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   641
                        options
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   642
                in
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   643
                  print ("Try again with " ^
36380
1e8fcaccb3e8 stop referring to Sledgehammer_Util stuff all over Nitpick code; instead, redeclare any needed function in Nitpick_Util as synonym for the Sledgehammer_Util function of the same name
blanchet
parents: 36266
diff changeset
   644
                         space_implode " " (serial_commas "and" ss) ^
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   645
                         " to confirm that the " ^ das_wort_model ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   646
                         " is genuine.")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   647
                end
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   648
              else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   649
                print ("Nitpick is unable to guarantee the authenticity of \
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   650
                       \the " ^ das_wort_model ^ " in the presence of \
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   651
                       \polymorphic axioms.")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   652
            else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   653
              ();
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   654
            NONE)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   655
         else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   656
           if not genuine then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   657
             (Unsynchronized.inc met_potential;
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   658
              if check_potential then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   659
                let
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   660
                  val status = prove_hol_model scope tac_timeout free_names
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   661
                                              sel_names rel_table bounds assms_t
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   662
                in
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   663
                  (case status of
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   664
                     SOME true => print ("Confirmation by \"auto\": The \
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   665
                                         \above " ^ das_wort_model ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   666
                                         " is genuine.")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   667
                   | SOME false => print ("Refutation by \"auto\": The above " ^
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   668
                                          das_wort_model ^ " is spurious.")
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   669
                   | NONE => print "No confirmation by \"auto\".");
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   670
                  status
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   671
                end
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   672
              else
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   673
                NONE)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   674
           else
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   675
             NONE)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   676
        |> pair genuine_means_genuine
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   677
      end
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   678
    fun solve_any_problem (found_really_genuine, max_potential, max_genuine,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   679
                           donno) first_time problems =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   680
      let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   681
        val max_potential = Int.max (0, max_potential)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   682
        val max_genuine = Int.max (0, max_genuine)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   683
        fun print_and_check genuine (j, bounds) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   684
          print_and_check_model genuine bounds (snd (nth problems j))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   685
        val max_solutions = max_potential + max_genuine
36384
76d5fd5a45fb cosmetics
blanchet
parents: 36380
diff changeset
   686
                            |> not incremental ? Integer.min 1
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   687
      in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   688
        if max_solutions <= 0 then
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   689
          (found_really_genuine, 0, 0, donno)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   690
        else
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   691
          case KK.solve_any_problem overlord deadline max_threads max_solutions
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   692
                                    (map fst problems) of
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   693
            KK.JavaNotInstalled =>
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   694
            (print_m install_java_message;
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   695
             (found_really_genuine, max_potential, max_genuine, donno + 1))
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   696
          | KK.KodkodiNotInstalled =>
33568
532b915afa14 don't run Nitpick at all if Kodkodi is not installed (as indicated by the $KODKODI variable)
blanchet
parents: 33566
diff changeset
   697
            (print_m install_kodkodi_message;
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   698
             (found_really_genuine, max_potential, max_genuine, donno + 1))
35333
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   699
          | KK.Normal ([], unsat_js, s) =>
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   700
            (update_checked_problems problems unsat_js; show_kodkod_warning s;
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   701
             (found_really_genuine, max_potential, max_genuine, donno))
35333
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   702
          | KK.Normal (sat_ps, unsat_js, s) =>
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   703
            let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   704
              val (lib_ps, con_ps) =
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   705
                List.partition (#unsound o snd o nth problems o fst) sat_ps
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   706
            in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   707
              update_checked_problems problems (unsat_js @ map fst lib_ps);
35333
f61de25f71f9 distinguish between Kodkodi warnings and errors in Nitpick;
blanchet
parents: 35280
diff changeset
   708
              show_kodkod_warning s;
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   709
              if null con_ps then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   710
                let
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   711
                  val genuine_codes =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   712
                    lib_ps |> take max_potential
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   713
                           |> map (print_and_check false)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   714
                           |> filter (curry (op =) (SOME true) o snd)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   715
                  val found_really_genuine =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   716
                    found_really_genuine orelse exists fst genuine_codes
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   717
                  val num_genuine = length genuine_codes
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   718
                  val max_genuine = max_genuine - num_genuine
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   719
                  val max_potential = max_potential
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   720
                                      - (length lib_ps - num_genuine)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   721
                in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   722
                  if max_genuine <= 0 then
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   723
                    (found_really_genuine, 0, 0, donno)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   724
                  else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   725
                    let
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   726
                      (* "co_js" is the list of sound problems whose unsound
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   727
                         pendants couldn't be satisfied and hence that most
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   728
                         probably can't be satisfied themselves. *)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   729
                      val co_js =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   730
                        map (fn j => j - 1) unsat_js
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   731
                        |> filter (fn j =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   732
                                      j >= 0 andalso
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   733
                                      scopes_equivalent
35814
234eaa508359 added one-entry cache around Kodkod invocation
blanchet
parents: 35807
diff changeset
   734
                                          (#scope (snd (nth problems j)),
234eaa508359 added one-entry cache around Kodkod invocation
blanchet
parents: 35807
diff changeset
   735
                                           #scope (snd (nth problems (j + 1)))))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   736
                      val bye_js = sort_distinct int_ord (map fst sat_ps @
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   737
                                                          unsat_js @ co_js)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   738
                      val problems =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   739
                        problems |> filter_out_indices bye_js
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   740
                                 |> max_potential <= 0
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   741
                                    ? filter_out (#unsound o snd)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   742
                    in
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   743
                      solve_any_problem (found_really_genuine, max_potential,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   744
                                         max_genuine, donno) false problems
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   745
                    end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   746
                end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   747
              else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   748
                let
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   749
                  val genuine_codes =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   750
                    con_ps |> take max_genuine
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   751
                           |> map (print_and_check true)
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   752
                  val max_genuine = max_genuine - length genuine_codes
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   753
                  val found_really_genuine =
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   754
                    found_really_genuine orelse exists fst genuine_codes
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   755
                in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   756
                  if max_genuine <= 0 orelse not first_time then
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   757
                    (found_really_genuine, 0, max_genuine, donno)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   758
                  else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   759
                    let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   760
                      val bye_js = sort_distinct int_ord
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   761
                                                 (map fst sat_ps @ unsat_js)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   762
                      val problems =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   763
                        problems |> filter_out_indices bye_js
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   764
                                 |> filter_out (#unsound o snd)
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   765
                    in
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   766
                      solve_any_problem (found_really_genuine, 0, max_genuine,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   767
                                         donno) false problems
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   768
                    end
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   769
                end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   770
            end
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   771
          | KK.TimedOut unsat_js =>
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   772
            (update_checked_problems problems unsat_js; raise TimeLimit.TimeOut)
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   773
          | KK.Interrupted NONE => (checked_problems := NONE; do_interrupted ())
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   774
          | KK.Interrupted (SOME unsat_js) =>
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   775
            (update_checked_problems problems unsat_js; do_interrupted ())
34126
8a2c5d7aff51 polished Nitpick's binary integer support etc.;
blanchet
parents: 34124
diff changeset
   776
          | KK.Error (s, unsat_js) =>
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   777
            (update_checked_problems problems unsat_js;
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   778
             print_v (K ("Kodkod error: " ^ s ^ "."));
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   779
             (found_really_genuine, max_potential, max_genuine, donno + 1))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   780
      end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   781
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   782
    fun run_batch j n scopes (found_really_genuine, max_potential, max_genuine,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   783
                              donno) =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   784
      let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   785
        val _ =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   786
          if null scopes then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   787
            print_m (K "The scope specification is inconsistent.")
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   788
          else if verbose then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   789
            pprint (Pretty.chunks
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   790
                [Pretty.blk (0,
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   791
                     pstrs ((if n > 1 then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   792
                               "Batch " ^ string_of_int (j + 1) ^ " of " ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   793
                               signed_string_of_int n ^ ": "
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   794
                             else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   795
                               "") ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   796
                            "Trying " ^ string_of_int (length scopes) ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   797
                            " scope" ^ plural_s_for_list scopes ^ ":")),
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   798
                 Pretty.indent indent_size
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   799
                     (Pretty.chunks (map2
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   800
                          (fn j => fn scope =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   801
                              Pretty.block (
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   802
                                  (case pretties_for_scope scope true of
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   803
                                     [] => [Pretty.str "Empty"]
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   804
                                   | pretties => pretties) @
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   805
                                  [Pretty.str (if j = 1 then "." else ";")]))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   806
                          (length scopes downto 1) scopes))])
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   807
          else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   808
            ()
35280
54ab4921f826 fixed a few bugs in Nitpick and removed unreferenced variables
blanchet
parents: 35220
diff changeset
   809
        fun add_problem_for_scope (scope, unsound) (problems, donno) =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   810
          (check_deadline ();
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   811
           case problem_for_scope unsound scope of
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   812
             SOME problem =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   813
             (problems
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   814
              |> (null problems orelse
35814
234eaa508359 added one-entry cache around Kodkod invocation
blanchet
parents: 35807
diff changeset
   815
                  not (KK.problems_equivalent (fst problem, fst (hd problems))))
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   816
                  ? cons problem, donno)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   817
           | NONE => (problems, donno + 1))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   818
        val (problems, donno) =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   819
          fold add_problem_for_scope
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   820
               (map_product pair scopes
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   821
                    ((if max_genuine > 0 then [false] else []) @
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   822
                     (if max_potential > 0 then [true] else [])))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   823
               ([], donno)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   824
        val _ = Unsynchronized.change generated_problems (append problems)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   825
        val _ = Unsynchronized.change generated_scopes (append scopes)
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   826
        val _ =
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   827
          if j + 1 = n then
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   828
            let
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   829
              val (unsound_problems, sound_problems) =
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   830
                List.partition (#unsound o snd) (!generated_problems)
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   831
            in
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   832
              if not (null sound_problems) andalso
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   833
                 forall (KK.is_problem_trivially_false o fst)
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   834
                        sound_problems then
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   835
                print_m (fn () =>
35220
2bcdae5f4fdb added support for nonstandard "nat"s to Nitpick and fixed bugs in binary "nat"s and "int"s
blanchet
parents: 35190
diff changeset
   836
                    "Warning: The conjecture either trivially holds for the \
35384
88dbcfe75c45 cosmetics
blanchet
parents: 35335
diff changeset
   837
                    \given scopes or lies outside Nitpick's supported \
88dbcfe75c45 cosmetics
blanchet
parents: 35335
diff changeset
   838
                    \fragment." ^
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   839
                    (if exists (not o KK.is_problem_trivially_false o fst)
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   840
                               unsound_problems then
36913
0010f08e288e improve precision of set constructs in Nitpick
blanchet
parents: 36406
diff changeset
   841
                       " Only potential " ^ das_wort_model ^ "s may be found."
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   842
                     else
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   843
                       ""))
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   844
              else
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   845
                ()
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   846
            end
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   847
          else
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   848
            ()
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   849
      in
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   850
        solve_any_problem (found_really_genuine, max_potential, max_genuine,
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   851
                           donno) true (rev problems)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   852
      end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   853
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   854
    fun scope_count (problems : rich_problem list) scope =
35814
234eaa508359 added one-entry cache around Kodkod invocation
blanchet
parents: 35807
diff changeset
   855
      length (filter (curry scopes_equivalent scope o #scope o snd) problems)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   856
    fun excipit did_so_and_so =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   857
      let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   858
        val do_filter =
35185
9b8f351cced6 added yet another hint to Nitpick's output, this time warning about problems for which nothing was effectively tested
blanchet
parents: 35183
diff changeset
   859
          if !met_potential = max_potential then filter_out (#unsound o snd)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   860
          else I
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   861
        val total = length (!scopes)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   862
        val unsat =
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   863
          fold (fn scope =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   864
                   case scope_count (do_filter (!generated_problems)) scope of
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   865
                     0 => I
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   866
                   | n =>
33556
cba22e2999d5 renamed Nitpick option "coalesce_type_vars" to "merge_type_vars" (shorter) and cleaned up old hacks that are no longer necessary
blanchet
parents: 33233
diff changeset
   867
                     scope_count (do_filter (these (!checked_problems)))
cba22e2999d5 renamed Nitpick option "coalesce_type_vars" to "merge_type_vars" (shorter) and cleaned up old hacks that are no longer necessary
blanchet
parents: 33233
diff changeset
   868
                                 scope = n
cba22e2999d5 renamed Nitpick option "coalesce_type_vars" to "merge_type_vars" (shorter) and cleaned up old hacks that are no longer necessary
blanchet
parents: 33233
diff changeset
   869
                     ? Integer.add 1) (!generated_scopes) 0
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   870
      in
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   871
        "Nitpick " ^ did_so_and_so ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   872
        (if is_some (!checked_problems) andalso total > 0 then
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   873
           " " ^ string_of_int (Int.min (total - 1, unsat)) ^ " of " ^
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   874
           string_of_int total ^ " scope" ^ plural_s total
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   875
         else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   876
           "") ^ "."
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   877
      end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   878
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   879
    fun run_batches _ _ []
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   880
                    (found_really_genuine, max_potential, max_genuine, donno) =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   881
        if donno > 0 andalso max_genuine > 0 then
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   882
          (print_m (fn () => excipit "checked"); "unknown")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   883
        else if max_genuine = original_max_genuine then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   884
          if max_potential = original_max_potential then
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   885
            (print_m (fn () =>
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   886
                 "Nitpick found no " ^ das_wort_model ^ "." ^
35183
8580ba651489 reintroduce structural induction hint in Nitpick
blanchet
parents: 35181
diff changeset
   887
                 (if not standard andalso likely_in_struct_induct_step then
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   888
                    " This suggests that the induction hypothesis might be \
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   889
                    \general enough to prove this subgoal."
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   890
                  else
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   891
                    "")); "none")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   892
          else
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   893
            (print_m (fn () =>
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   894
                 "Nitpick could not find a" ^
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   895
                 (if max_genuine = 1 then " better " ^ das_wort_model ^ "."
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   896
                  else "ny better " ^ das_wort_model ^ "s.")); "potential")
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   897
        else if found_really_genuine then
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   898
          "genuine"
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   899
        else
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   900
          "quasi_genuine"
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   901
      | run_batches j n (batch :: batches) z =
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   902
        let val (z as (_, _, max_genuine, _)) = run_batch j n batch z in
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   903
          run_batches (j + 1) n (if max_genuine > 0 then batches else []) z
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   904
        end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   905
33580
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   906
    val (skipped, the_scopes) =
36386
2132f15b366f Fruhjahrsputz: remove three mostly useless Nitpick options
blanchet
parents: 36385
diff changeset
   907
      all_scopes hol_ctxt binarize cards_assigns maxes_assigns iters_assigns
2132f15b366f Fruhjahrsputz: remove three mostly useless Nitpick options
blanchet
parents: 36385
diff changeset
   908
                 bitss bisim_depths mono_Ts nonmono_Ts deep_dataTs
35385
29f81babefd7 improved precision of infinite "shallow" datatypes in Nitpick;
blanchet
parents: 35384
diff changeset
   909
                 finitizable_dataTs
33580
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   910
    val _ = if skipped > 0 then
34124
c4628a1dcf75 added support for binary nat/int representation to Nitpick
blanchet
parents: 34123
diff changeset
   911
              print_m (fn () => "Too many scopes. Skipping " ^
33580
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   912
                                string_of_int skipped ^ " scope" ^
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   913
                                plural_s skipped ^
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   914
                                ". (Consider using \"mono\" or \
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   915
                                \\"merge_type_vars\" to prevent this.)")
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   916
            else
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   917
              ()
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   918
    val _ = scopes := the_scopes
45c33e97cb86 added datatype constructor cache in Nitpick (to speed up the scope enumeration) and never test more than 4096 scopes
blanchet
parents: 33568
diff changeset
   919
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   920
    val batches = batch_list batch_size (!scopes)
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   921
    val outcome_code =
35671
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   922
      (run_batches 0 (length batches) batches
ed2c3830d881 improved Nitpick's precision for "card" and "setsum" + fix incorrect outcome code w.r.t. "bisim_depth = -1"
blanchet
parents: 35665
diff changeset
   923
                   (false, max_potential, max_genuine, 0)
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   924
       handle Exn.Interrupt => do_interrupted ())
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   925
      handle TimeLimit.TimeOut =>
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   926
             (print_m (fn () => excipit "ran out of time after checking");
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   927
              if !met_potential > 0 then "potential" else "unknown")
35696
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   928
           | Exn.Interrupt =>
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   929
             if auto orelse debug then raise Interrupt
17ae461d6133 show nice error message in Nitpick when "java" is not available
blanchet
parents: 35671
diff changeset
   930
             else error (excipit "was interrupted after checking")
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   931
    val _ = print_v (fn () => "Total time: " ^
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   932
                              signed_string_of_int (Time.toMilliseconds
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   933
                                    (Timer.checkRealTimer timer)) ^ " ms.")
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   934
  in (outcome_code, !state_ref) end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   935
  handle Exn.Interrupt =>
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   936
         if auto orelse #debug params then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   937
           raise Interrupt
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   938
         else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   939
           if passed_deadline deadline then
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   940
             (priority "Nitpick ran out of time."; ("unknown", state))
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   941
           else
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   942
             error "Nitpick was interrupted."
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   943
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   944
fun pick_nits_in_term state (params as {debug, timeout, expect, ...}) auto i n
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   945
                      step subst orig_assm_ts orig_t =
37213
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   946
  let
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   947
    val warning_m = if auto then K () else warning
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   948
    val unknown_outcome = ("unknown", state)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   949
  in
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   950
    if getenv "KODKODI" = "" then
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   951
      (warning_m (Pretty.string_of (plazy install_kodkodi_message));
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   952
       unknown_outcome)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   953
    else
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   954
      let
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   955
        val deadline = Option.map (curry Time.+ (Time.now ())) timeout
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   956
        val outcome as (outcome_code, _) =
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   957
          time_limit (if debug then NONE else timeout)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   958
              (pick_them_nits_in_term deadline state params auto i n step subst
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   959
                                      orig_assm_ts) orig_t
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   960
          handle TOO_LARGE (_, details) =>
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   961
                 (warning ("Limit reached: " ^ details ^ "."); unknown_outcome)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   962
               | TOO_SMALL (_, details) =>
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   963
                 (warning ("Limit reached: " ^ details ^ "."); unknown_outcome)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   964
               | Kodkod.SYNTAX (_, details) =>
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   965
                 (warning ("Ill-formed Kodkodi output: " ^ details ^ ".");
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   966
                  unknown_outcome)
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   967
      in
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   968
        if expect = "" orelse outcome_code = expect then outcome
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   969
        else error ("Unexpected outcome: " ^ quote outcome_code ^ ".")
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   970
      end
efcad7594872 fix handling of "split" w.r.t. new definition + fix exception handling w.r.t. "expect" option
blanchet
parents: 37146
diff changeset
   971
  end
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   972
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   973
fun is_fixed_equation fixes
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   974
                      (Const (@{const_name "=="}, _) $ Free (s, _) $ Const _) =
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   975
    member (op =) fixes s
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   976
  | is_fixed_equation _ _ = false
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   977
fun extract_fixed_frees ctxt (assms, t) =
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   978
  let
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   979
    val fixes = Variable.fixes_of ctxt |> map snd
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   980
    val (subst, other_assms) =
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   981
      List.partition (is_fixed_equation fixes) assms
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   982
      |>> map Logic.dest_equals
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   983
  in (subst, other_assms, subst_atomic subst t) end
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   984
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   985
fun pick_nits_in_subgoal state params auto i step =
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   986
  let
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   987
    val ctxt = Proof.context_of state
33292
affe60b3d864 renamed raw Proof.get_goal to Proof.raw_goal;
wenzelm
parents: 33233
diff changeset
   988
    val t = state |> Proof.raw_goal |> #goal |> prop_of
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   989
  in
34982
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   990
    case Logic.count_prems t of
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   991
      0 => (priority "No subgoal!"; ("none", state))
7b8c366e34a2 added support for nonstandard models to Nitpick (based on an idea by Koen Claessen) and did other fixes to Nitpick
blanchet
parents: 34938
diff changeset
   992
    | n =>
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   993
      let
36406
0a2d5138b77c fixes 2a5c6e7b55cb;
blanchet
parents: 36397
diff changeset
   994
        val t = Logic.goal_params t i |> fst
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   995
        val assms = map term_of (Assumption.all_assms_of ctxt)
35335
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   996
        val (subst, assms, t) = extract_fixed_frees ctxt (assms, t)
f715cfde056a support local definitions in Nitpick
blanchet
parents: 35334
diff changeset
   997
      in pick_nits_in_term state params auto i n step subst assms t end
33192
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   998
  end
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
   999
08a39a957ed7 added Nitpick's theory and ML files to Isabelle/HOL;
blanchet
parents:
diff changeset
  1000
end;