src/CCL/Term.thy
author wenzelm
Tue, 06 Jun 2006 20:42:25 +0200
changeset 19796 d86e7b1fc472
parent 17781 32bb237158a5
child 20140 98acc6d0fab6
permissions -rw-r--r--
quoted "if";
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
     1
(*  Title:      CCL/Term.thy
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
1474
3f7d67927fe2 expanded tabs
clasohm
parents: 1149
diff changeset
     3
    Author:     Martin Coen
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
    Copyright   1993  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
     7
header {* Definitions of usual program constructs in CCL *}
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
     8
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
     9
theory Term
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    10
imports CCL
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    11
begin
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    12
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    13
consts
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    14
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    15
  one        :: "i"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
19796
d86e7b1fc472 quoted "if";
wenzelm
parents: 17781
diff changeset
    17
  "if"       :: "[i,i,i]=>i"           ("(3if _/ then _/ else _)" [0,0,60] 60)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    19
  inl        :: "i=>i"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    20
  inr        :: "i=>i"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    21
  when       :: "[i,i=>i,i=>i]=>i"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    23
  split      :: "[i,[i,i]=>i]=>i"
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    24
  fst        :: "i=>i"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    25
  snd        :: "i=>i"
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    26
  thd        :: "i=>i"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    28
  zero       :: "i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    29
  succ       :: "i=>i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    30
  ncase      :: "[i,i,i=>i]=>i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    31
  nrec       :: "[i,i,[i,i]=>i]=>i"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    32
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    33
  nil        :: "i"                        ("([])")
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    34
  "$"        :: "[i,i]=>i"                 (infixr 80)
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    35
  lcase      :: "[i,i,[i,i]=>i]=>i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    36
  lrec       :: "[i,i,[i,i,i]=>i]=>i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    37
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    38
  "let"      :: "[i,i=>i]=>i"
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    39
  letrec     :: "[[i,i=>i]=>i,(i=>i)=>i]=>i"
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    40
  letrec2    :: "[[i,i,i=>i=>i]=>i,(i=>i=>i)=>i]=>i"
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    41
  letrec3    :: "[[i,i,i,i=>i=>i=>i]=>i,(i=>i=>i=>i)=>i]=>i"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    42
14765
bafb24c150c1 proper use of 'syntax';
wenzelm
parents: 3837
diff changeset
    43
syntax
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    44
  "@let"     :: "[idt,i,i]=>i"             ("(3let _ be _/ in _)"
1474
3f7d67927fe2 expanded tabs
clasohm
parents: 1149
diff changeset
    45
                        [0,0,60] 60)
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    46
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    47
  "@letrec"  :: "[idt,idt,i,i]=>i"         ("(3letrec _ _ be _/ in _)"
1474
3f7d67927fe2 expanded tabs
clasohm
parents: 1149
diff changeset
    48
                        [0,0,0,60] 60)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    49
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    50
  "@letrec2" :: "[idt,idt,idt,i,i]=>i"     ("(3letrec _ _ _ be _/ in _)"
1474
3f7d67927fe2 expanded tabs
clasohm
parents: 1149
diff changeset
    51
                        [0,0,0,0,60] 60)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    52
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    53
  "@letrec3" :: "[idt,idt,idt,idt,i,i]=>i" ("(3letrec _ _ _ _ be _/ in _)"
1474
3f7d67927fe2 expanded tabs
clasohm
parents: 1149
diff changeset
    54
                        [0,0,0,0,0,60] 60)
998
91d09e262799 Gave tighter priorities to if, napply and the let-forms to
lcp
parents: 610
diff changeset
    55
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    56
ML {*
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    57
(** Quantifier translations: variable binding **)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    58
17781
32bb237158a5 print_translation: does not handle _idtdummy;
wenzelm
parents: 17456
diff changeset
    59
(* FIXME does not handle "_idtdummy" *)
2709
241fffc25284 added comment;
wenzelm
parents: 1474
diff changeset
    60
(* FIXME should use Syntax.mark_bound(T), Syntax.variant_abs' *)
241fffc25284 added comment;
wenzelm
parents: 1474
diff changeset
    61
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    62
fun let_tr [Free(id,T),a,b] = Const("let",dummyT) $ a $ absfree(id,T,b);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    63
fun let_tr' [a,Abs(id,T,b)] =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    64
     let val (id',b') = variant_abs(id,T,b)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    65
     in Const("@let",dummyT) $ Free(id',T) $ a $ b' end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    66
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    67
fun letrec_tr [Free(f,S),Free(x,T),a,b] =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    68
      Const("letrec",dummyT) $ absfree(x,T,absfree(f,S,a)) $ absfree(f,S,b);
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    69
fun letrec2_tr [Free(f,S),Free(x,T),Free(y,U),a,b] =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    70
      Const("letrec2",dummyT) $ absfree(x,T,absfree(y,U,absfree(f,S,a))) $ absfree(f,S,b);
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    71
fun letrec3_tr [Free(f,S),Free(x,T),Free(y,U),Free(z,V),a,b] =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    72
      Const("letrec3",dummyT) $ absfree(x,T,absfree(y,U,absfree(z,U,absfree(f,S,a)))) $ absfree(f,S,b);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    73
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    74
fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    75
     let val (f',b')  = variant_abs(ff,SS,b)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    76
         val (_,a'') = variant_abs(f,S,a)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    77
         val (x',a')  = variant_abs(x,T,a'')
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    78
     in Const("@letrec",dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    79
fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    80
     let val (f',b') = variant_abs(ff,SS,b)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    81
         val ( _,a1) = variant_abs(f,S,a)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    82
         val (y',a2) = variant_abs(y,U,a1)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    83
         val (x',a') = variant_abs(x,T,a2)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    84
     in Const("@letrec2",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b'
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    85
      end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    86
fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    87
     let val (f',b') = variant_abs(ff,SS,b)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    88
         val ( _,a1) = variant_abs(f,S,a)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    89
         val (z',a2) = variant_abs(z,V,a1)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    90
         val (y',a3) = variant_abs(y,U,a2)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    91
         val (x',a') = variant_abs(x,T,a3)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    92
     in Const("@letrec3",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b'
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    93
      end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    94
17456
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    95
*}
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    96
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    97
parse_translation {*
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    98
  [("@let",       let_tr),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
    99
   ("@letrec",    letrec_tr),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   100
   ("@letrec2",   letrec2_tr),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   101
   ("@letrec3",   letrec3_tr)] *}
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   102
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   103
print_translation {*
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   104
  [("let",       let_tr'),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   105
   ("letrec",    letrec_tr'),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   106
   ("letrec2",   letrec2_tr'),
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   107
   ("letrec3",   letrec3_tr')] *}
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   108
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   109
consts
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   110
  napply     :: "[i=>i,i,i]=>i"            ("(_ ^ _ ` _)" [56,56,56] 56)
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   111
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   112
axioms
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   113
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   114
  one_def:                    "one == true"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   115
  if_def:     "if b then t else u  == case(b,t,u,% x y. bot,%v. bot)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   116
  inl_def:                 "inl(a) == <true,a>"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   117
  inr_def:                 "inr(b) == <false,b>"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   118
  when_def:           "when(t,f,g) == split(t,%b x. if b then f(x) else g(x))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   119
  split_def:           "split(t,f) == case(t,bot,bot,f,%u. bot)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   120
  fst_def:                 "fst(t) == split(t,%x y. x)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   121
  snd_def:                 "snd(t) == split(t,%x y. y)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   122
  thd_def:                 "thd(t) == split(t,%x p. split(p,%y z. z))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   123
  zero_def:                  "zero == inl(one)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   124
  succ_def:               "succ(n) == inr(n)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   125
  ncase_def:         "ncase(n,b,c) == when(n,%x. b,%y. c(y))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   126
  nrec_def:          " nrec(n,b,c) == letrec g x be ncase(x,b,%y. c(y,g(y))) in g(n)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   127
  nil_def:                     "[] == inl(one)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   128
  cons_def:                   "h$t == inr(<h,t>)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   129
  lcase_def:         "lcase(l,b,c) == when(l,%x. b,%y. split(y,c))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   130
  lrec_def:           "lrec(l,b,c) == letrec g x be lcase(x,b,%h t. c(h,t,g(t))) in g(l)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   131
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   132
  let_def:  "let x be t in f(x) == case(t,f(true),f(false),%x y. f(<x,y>),%u. f(lam x. u(x)))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   133
  letrec_def:
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   134
  "letrec g x be h(x,g) in b(g) == b(%x. fix(%f. lam x. h(x,%y. f`y))`x)"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   135
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   136
  letrec2_def:  "letrec g x y be h(x,y,g) in f(g)==
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   137
               letrec g' p be split(p,%x y. h(x,y,%u v. g'(<u,v>)))
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   138
                          in f(%x y. g'(<x,y>))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   139
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   140
  letrec3_def:  "letrec g x y z be h(x,y,z,g) in f(g) ==
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   141
             letrec g' p be split(p,%x xs. split(xs,%y z. h(x,y,z,%u v w. g'(<u,<v,w>>))))
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   142
                          in f(%x y z. g'(<x,<y,z>>))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   143
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   144
  napply_def: "f ^n` a == nrec(n,a,%x g. f(g))"
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   145
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   146
ML {* use_legacy_bindings (the_context ()) *}
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   147
bcf7544875b2 converted to Isar theory format;
wenzelm
parents: 14765
diff changeset
   148
end