author | nipkow |
Wed, 18 Aug 2004 11:09:40 +0200 | |
changeset 15140 | 322485b816ac |
parent 14981 | e73f8140af78 |
child 16417 | 9bc16273c2d4 |
permissions | -rw-r--r-- |
9353 | 1 |
(* Title: HOL/ex/Tuple.thy |
2 |
ID: $Id$ |
|
3 |
Author: Markus Wenzel, TU Muenchen |
|
4 |
||
5 |
Properly nested products (see also theory Prod). |
|
6 |
||
7 |
Unquestionably, this should be used as the standard representation of |
|
8 |
tuples in HOL, but it breaks many existing theories! |
|
9 |
*) |
|
10 |
||
10357 | 11 |
header {* Properly nested products *} |
12 |
||
9353 | 13 |
theory Tuple = HOL: |
14 |
||
15 |
||
10357 | 16 |
subsection {* Abstract syntax *} |
9353 | 17 |
|
18 |
typedecl unit |
|
19 |
typedecl ('a, 'b) prod |
|
20 |
||
21 |
consts |
|
22 |
Pair :: "'a => 'b => ('a, 'b) prod" |
|
23 |
fst :: "('a, 'b) prod => 'a" |
|
24 |
snd :: "('a, 'b) prod => 'b" |
|
25 |
split :: "('a => 'b => 'c) => ('a, 'b) prod => 'c" |
|
11606 | 26 |
Unity :: unit ("'(')") |
9353 | 27 |
|
28 |
||
10357 | 29 |
subsection {* Concrete syntax *} |
9353 | 30 |
|
10357 | 31 |
subsubsection {* Tuple types *} |
9353 | 32 |
|
33 |
nonterminals |
|
34 |
tuple_type_args |
|
35 |
syntax |
|
36 |
"_tuple_type_arg" :: "type => tuple_type_args" ("_" [21] 21) |
|
37 |
"_tuple_type_args" :: "type => tuple_type_args => tuple_type_args" ("_ */ _" [21, 20] 20) |
|
38 |
"_tuple_type" :: "type => tuple_type_args => type" ("(_ */ _)" [21, 20] 20) |
|
39 |
||
12114
a8e860c86252
eliminated old "symbols" syntax, use "xsymbols" instead;
wenzelm
parents:
11606
diff
changeset
|
40 |
syntax (xsymbols) |
9503 | 41 |
"_tuple_type_args" :: "type => tuple_type_args => tuple_type_args" ("_ \<times>/ _" [21, 20] 20) |
42 |
"_tuple_type" :: "type => tuple_type_args => type" ("(_ \<times>/ _)" [21, 20] 20) |
|
9353 | 43 |
|
44 |
syntax (HTML output) |
|
9503 | 45 |
"_tuple_type_args" :: "type => tuple_type_args => tuple_type_args" ("_ \<times>/ _" [21, 20] 20) |
46 |
"_tuple_type" :: "type => tuple_type_args => type" ("(_ \<times>/ _)" [21, 20] 20) |
|
9353 | 47 |
|
48 |
translations |
|
49 |
(type) "'a * 'b" == (type) "('a, ('b, unit) prod) prod" |
|
50 |
(type) "('a, ('b, 'cs) _tuple_type_args) _tuple_type" == |
|
51 |
(type) "('a, ('b, 'cs) _tuple_type) prod" |
|
52 |
||
53 |
||
10357 | 54 |
subsubsection {* Tuples *} |
9353 | 55 |
|
56 |
nonterminals |
|
57 |
tuple_args |
|
58 |
syntax |
|
59 |
"_tuple" :: "'a => tuple_args => 'b" ("(1'(_,/ _'))") |
|
60 |
"_tuple_arg" :: "'a => tuple_args" ("_") |
|
61 |
"_tuple_args" :: "'a => tuple_args => tuple_args" ("_,/ _") |
|
62 |
translations |
|
63 |
"(x, y)" == "Pair x (Pair y ())" |
|
64 |
"_tuple x (_tuple_args y zs)" == "Pair x (_tuple y zs)" |
|
65 |
||
66 |
||
10357 | 67 |
subsubsection {* Tuple patterns *} |
9353 | 68 |
|
10357 | 69 |
nonterminals tuple_pat_args |
70 |
-- {* extends pre-defined type "pttrn" syntax used in abstractions *} |
|
9353 | 71 |
syntax |
72 |
"_tuple_pat_arg" :: "pttrn => tuple_pat_args" ("_") |
|
73 |
"_tuple_pat_args" :: "pttrn => tuple_pat_args => tuple_pat_args" ("_,/ _") |
|
74 |
"_tuple_pat" :: "pttrn => tuple_pat_args => pttrn" ("'(_,/ _')") |
|
75 |
||
76 |
translations |
|
77 |
"%(x,y). b" => "split (%x. split (%y. (_K b) :: unit => _))" |
|
78 |
"%(x,y). b" <= "split (%x. split (%y. _K b))" |
|
79 |
"_abs (_tuple_pat x (_tuple_pat_args y zs)) b" == "split (%x. (_abs (_tuple_pat y zs) b))" |
|
80 |
||
81 |
(* FIXME test *) |
|
82 |
(*the following rules accommodate tuples in `case C ... (x,y,...) ... => ...' where |
|
83 |
(x,y,...) is parsed as `Pair x (Pair y ...)' because it is logic, not pttrn*) |
|
84 |
"_abs (Pair x (Pair y ())) b" => "%(x,y). b" |
|
85 |
"_abs (Pair x (_abs (_tuple_pat y zs) b))" => "_abs (_tuple_pat x (_tuple_pat_args y zs)) b" |
|
86 |
||
87 |
(* FIXME improve handling of nested patterns *) |
|
88 |
typed_print_translation {* |
|
89 |
let |
|
90 |
fun split_tr' _ T1 |
|
91 |
(Abs (x, xT, Const ("split", T2) $ Abs (y, yT, Abs (_, Type ("unit", []), b))) :: ts) = |
|
92 |
if Term.loose_bvar1 (b, 0) then raise Match |
|
93 |
else Term.list_comb |
|
94 |
(Const ("split", T1) $ Abs (x, xT, Const ("split", T2) $ |
|
95 |
Abs (y, yT, Syntax.const "_K" $ Term.incr_boundvars ~1 b)), ts) |
|
96 |
| split_tr' _ _ _ = raise Match; |
|
97 |
in [("split", split_tr')] end |
|
98 |
*} |
|
99 |
||
100 |
end |