src/Pure/Isar/instance.ML
author haftmann
Fri, 02 Jan 2009 08:13:12 +0100
changeset 29333 496b94152b55
parent 27113 ac87245d8cab
permissions -rw-r--r--
improved boostrap order: theory_target.ML before expression.ML
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24592
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     1
(*  Title:      Pure/Isar/instance.ML
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     2
    ID:         $Id$
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     3
    Author:     Florian Haftmann, TU Muenchen
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     4
27113
ac87245d8cab dropped instance with attached definitions
haftmann
parents: 26516
diff changeset
     5
Wrapper for instantiation command.
24592
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     6
*)
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     7
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     8
signature INSTANCE =
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
     9
sig
25536
01753a944433 improved
haftmann
parents: 25514
diff changeset
    10
  val instantiation_cmd: xstring list * sort * xstring -> theory -> local_theory
24592
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    11
end;
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    12
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    13
structure Instance : INSTANCE =
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    14
struct
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    15
25536
01753a944433 improved
haftmann
parents: 25514
diff changeset
    16
fun read_multi_arity thy (raw_tycos, raw_sorts, raw_sort) =
01753a944433 improved
haftmann
parents: 25514
diff changeset
    17
  let
01753a944433 improved
haftmann
parents: 25514
diff changeset
    18
    val all_arities = map (fn raw_tyco => Sign.read_arity thy
01753a944433 improved
haftmann
parents: 25514
diff changeset
    19
      (raw_tyco, raw_sorts, raw_sort)) raw_tycos;
01753a944433 improved
haftmann
parents: 25514
diff changeset
    20
    val tycos = map #1 all_arities;
01753a944433 improved
haftmann
parents: 25514
diff changeset
    21
    val (_, sorts, sort) = hd all_arities;
25864
11f531354852 explicit type variables for instantiation
haftmann
parents: 25829
diff changeset
    22
    val vs = Name.names Name.context Name.aT sorts;
11f531354852 explicit type variables for instantiation
haftmann
parents: 25829
diff changeset
    23
  in (tycos, vs, sort) end;
25536
01753a944433 improved
haftmann
parents: 25514
diff changeset
    24
25462
dad0291cb76a rudimentary instantiation target
haftmann
parents: 25381
diff changeset
    25
fun instantiation_cmd raw_arities thy =
25536
01753a944433 improved
haftmann
parents: 25514
diff changeset
    26
  TheoryTarget.instantiation (read_multi_arity thy raw_arities) thy;
25462
dad0291cb76a rudimentary instantiation target
haftmann
parents: 25381
diff changeset
    27
24592
dfea1edbf711 added rudimentary instantiation stub
haftmann
parents:
diff changeset
    28
end;