1 (* Title: HOL/Prod.thy |
|
2 ID: $Id$ |
|
3 Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
4 Copyright 1992 University of Cambridge |
|
5 |
|
6 Ordered Pairs and the Cartesian product type. |
|
7 The unit type. |
|
8 *) |
|
9 |
|
10 Prod = Fun + equalities + |
|
11 |
|
12 |
|
13 (** products **) |
|
14 |
|
15 (* type definition *) |
|
16 |
|
17 constdefs |
|
18 Pair_Rep :: ['a, 'b] => ['a, 'b] => bool |
|
19 "Pair_Rep == (%a b. %x y. x=a & y=b)" |
|
20 |
|
21 global |
|
22 |
|
23 typedef (Prod) |
|
24 ('a, 'b) "*" (infixr 20) |
|
25 = "{f. ? a b. f = Pair_Rep (a::'a) (b::'b)}" |
|
26 |
|
27 syntax (symbols) |
|
28 "*" :: [type, type] => type ("(_ \\<times>/ _)" [21, 20] 20) |
|
29 |
|
30 syntax (HTML output) |
|
31 "*" :: [type, type] => type ("(_ \\<times>/ _)" [21, 20] 20) |
|
32 |
|
33 |
|
34 (* abstract constants and syntax *) |
|
35 |
|
36 consts |
|
37 fst :: "'a * 'b => 'a" |
|
38 snd :: "'a * 'b => 'b" |
|
39 split :: "[['a, 'b] => 'c, 'a * 'b] => 'c" |
|
40 prod_fun :: "['a => 'b, 'c => 'd, 'a * 'c] => 'b * 'd" |
|
41 Pair :: "['a, 'b] => 'a * 'b" |
|
42 Sigma :: "['a set, 'a => 'b set] => ('a * 'b) set" |
|
43 |
|
44 |
|
45 (* patterns -- extends pre-defined type "pttrn" used in abstractions *) |
|
46 |
|
47 nonterminals |
|
48 tuple_args patterns |
|
49 |
|
50 syntax |
|
51 "_tuple" :: "'a => tuple_args => 'a * 'b" ("(1'(_,/ _'))") |
|
52 "_tuple_arg" :: "'a => tuple_args" ("_") |
|
53 "_tuple_args" :: "'a => tuple_args => tuple_args" ("_,/ _") |
|
54 "_pattern" :: [pttrn, patterns] => pttrn ("'(_,/ _')") |
|
55 "" :: pttrn => patterns ("_") |
|
56 "_patterns" :: [pttrn, patterns] => patterns ("_,/ _") |
|
57 "@Sigma" :: "[pttrn, 'a set, 'b set] => ('a * 'b) set" ("(3SIGMA _:_./ _)" 10) |
|
58 "@Times" :: "['a set, 'a => 'b set] => ('a * 'b) set" (infixr "<*>" 80) |
|
59 |
|
60 translations |
|
61 "(x, y)" == "Pair x y" |
|
62 "_tuple x (_tuple_args y z)" == "_tuple x (_tuple_arg (_tuple y z))" |
|
63 "%(x,y,zs).b" == "split(%x (y,zs).b)" |
|
64 "%(x,y).b" == "split(%x y. b)" |
|
65 "_abs (Pair x y) t" => "%(x,y).t" |
|
66 (* The last rule accommodates tuples in `case C ... (x,y) ... => ...' |
|
67 The (x,y) is parsed as `Pair x y' because it is logic, not pttrn *) |
|
68 |
|
69 "SIGMA x:A. B" => "Sigma A (%x. B)" |
|
70 "A <*> B" => "Sigma A (_K B)" |
|
71 |
|
72 syntax (symbols) |
|
73 "@Sigma" :: "[pttrn, 'a set, 'b set] => ('a * 'b) set" ("(3\\<Sigma> _\\<in>_./ _)" 10) |
|
74 "@Times" :: "['a set, 'a => 'b set] => ('a * 'b) set" ("_ \\<times> _" [81, 80] 80) |
|
75 |
|
76 |
|
77 (* definitions *) |
|
78 |
|
79 local |
|
80 |
|
81 defs |
|
82 Pair_def "Pair a b == Abs_Prod(Pair_Rep a b)" |
|
83 fst_def "fst p == @a. ? b. p = (a, b)" |
|
84 snd_def "snd p == @b. ? a. p = (a, b)" |
|
85 split_def "split == (%c p. c (fst p) (snd p))" |
|
86 prod_fun_def "prod_fun f g == split(%x y.(f(x), g(y)))" |
|
87 Sigma_def "Sigma A B == UN x:A. UN y:B(x). {(x, y)}" |
|
88 |
|
89 |
|
90 |
|
91 (** unit **) |
|
92 |
|
93 global |
|
94 |
|
95 typedef unit = "{True}" |
|
96 |
|
97 consts |
|
98 "()" :: unit ("'(')") |
|
99 |
|
100 local |
|
101 |
|
102 defs |
|
103 Unity_def "() == Abs_unit True" |
|
104 |
|
105 end |
|
106 |
|
107 ML |
|
108 |
|
109 val print_translation = [("Sigma", dependent_tr' ("@Sigma", "@Times"))]; |
|