src/HOL/Tools/datatype_hooks.ML
author haftmann
Tue, 18 Sep 2007 07:36:13 +0200
changeset 24622 8116eb022282
parent 24305 b1df9e31cda1
permissions -rw-r--r--
renamed constructor RatC to Rational
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     1
(*  Title:      HOL/Tools/datatype_hooks.ML
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     2
    ID:         $Id$
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     3
    Author:     Florian Haftmann, TU Muenchen
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     4
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     5
Hooks for datatype introduction.
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     6
*)
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     7
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     8
signature DATATYPE_HOOKS =
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
     9
sig
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    10
  type hook = string list -> theory -> theory
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    11
  val add: hook -> theory -> theory
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    12
  val all: hook
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    13
end;
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    14
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    15
structure DatatypeHooks : DATATYPE_HOOKS =
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    16
struct
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    17
20177
0af885e3dabf hooks now take string list as arguments (mutual datatypes); some nice combinators in datatype_codegen
haftmann
parents: 19935
diff changeset
    18
type hook = string list -> theory -> theory;
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    19
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    20
structure DatatypeHooksData = TheoryDataFun
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    21
(
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    22
  type T = (serial * hook) list;
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    23
  val empty = [];
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    24
  val copy = I;
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    25
  val extend = I;
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    26
  fun merge _ hooks : T = AList.merge (op =) (K true) hooks;
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    27
);
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    28
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    29
fun add hook =
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 21251
diff changeset
    30
  DatatypeHooksData.map (cons (serial (), hook));
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    31
21251
94e77628a47d renamed DatatypeHooks.invoke to all
haftmann
parents: 20177
diff changeset
    32
fun all dtcos thy =
24305
b1df9e31cda1 reoriented hook application order
haftmann
parents: 22846
diff changeset
    33
  fold_rev (fn (_, f) => f dtcos) (DatatypeHooksData.get thy) thy;
19599
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    34
a5c7eb37d14f added DatatypeHooks
haftmann
parents:
diff changeset
    35
end;