src/HOLCF/explicit_domains/Dnat.thy
author oheimb
Fri, 31 Jan 1997 16:51:58 +0100
changeset 2569 3a8604f408c9
parent 1479 21eb5e156d91
permissions -rw-r--r--
moved Coind.*, Dagstuhl.*, Focus_ex.* to HOLCF/ex, marked the remaining files as obsolete (new versions in HOLCF/ex)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
     1
(*  Title:      HOLCF/Dnat.thy
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
     2
    ID:         $Id$
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
     3
    Author:     Franz Regensburger
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
     4
    Copyright   1993 Technische Universitaet Muenchen
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
     5
2569
3a8604f408c9 moved Coind.*, Dagstuhl.*, Focus_ex.* to HOLCF/ex,
oheimb
parents: 1479
diff changeset
     6
NOT SUPPORTED ANY MORE. USE HOLCF/ex/Dnat.thy INSTEAD.
3a8604f408c9 moved Coind.*, Dagstuhl.*, Focus_ex.* to HOLCF/ex,
oheimb
parents: 1479
diff changeset
     7
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
     8
Theory for the domain of natural numbers  dnat = one ++ dnat
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
     9
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    10
The type is axiomatized as the least solution of the domain equation above.
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    11
The functor term that specifies the domain equation is: 
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    12
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    13
  FT = <++,K_{one},I>
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    14
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    15
For details see chapter 5 of:
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    16
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    17
[Franz Regensburger] HOLCF: Eine konservative Erweiterung von HOL um LCF,
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    18
                     Dissertation, Technische Universit"at M"unchen, 1994
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    19
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    20
*)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    21
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    22
Dnat = HOLCF +
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    23
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    24
types dnat 0
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    25
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    26
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    27
(* arrity axiom is valuated by semantical reasoning                        *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    28
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    29
arities dnat::pcpo
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    30
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    31
consts
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    32
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    33
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    34
(* essential constants                                                     *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    35
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    36
dnat_rep        :: " dnat -> (one ++ dnat)"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    37
dnat_abs        :: "(one ++ dnat) -> dnat"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    38
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    39
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    40
(* abstract constants and auxiliary constants                              *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    41
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    42
dnat_copy       :: "(dnat -> dnat) -> dnat -> dnat"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    43
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    44
dzero           :: "dnat"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    45
dsucc           :: "dnat -> dnat"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    46
dnat_when       :: "'b -> (dnat -> 'b) -> dnat -> 'b"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    47
is_dzero        :: "dnat -> tr"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    48
is_dsucc        :: "dnat -> tr"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    49
dpred           :: "dnat -> dnat"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    50
dnat_take       :: "nat => dnat -> dnat"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    51
dnat_bisim      :: "(dnat => dnat => bool) => bool"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    52
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    53
rules
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    54
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    55
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    56
(* axiomatization of recursive type dnat                                   *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    57
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    58
(* (dnat,dnat_abs) is the initial F-algebra where                          *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    59
(* F is the locally continuous functor determined by functor term FT.      *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    60
(* domain equation: dnat = one ++ dnat                                     *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    61
(* functor term:    FT = <++,K_{one},I>                                    *) 
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    62
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    63
(* dnat_abs is an isomorphism with inverse dnat_rep                        *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    64
(* identity is the least endomorphism on dnat                              *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    65
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    66
dnat_abs_iso    "dnat_rep`(dnat_abs`x) = x"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    67
dnat_rep_iso    "dnat_abs`(dnat_rep`x) = x"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    68
dnat_copy_def   "dnat_copy == (LAM f. dnat_abs oo 
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    69
                 (sswhen`sinl`(sinr oo f)) oo dnat_rep )"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    70
dnat_reach      "(fix`dnat_copy)`x=x"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    71
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    72
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    73
defs
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    74
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    75
(* properties of additional constants                                      *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    76
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    77
(* constructors                                                            *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    78
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    79
dzero_def       "dzero == dnat_abs`(sinl`one)"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    80
dsucc_def       "dsucc == (LAM n. dnat_abs`(sinr`n))"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    81
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    82
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    83
(* discriminator functional                                                *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    84
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    85
dnat_when_def   "dnat_when == (LAM f1 f2 n.sswhen`(LAM x.f1)`f2`(dnat_rep`n))"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    86
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    87
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    88
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    89
(* discriminators and selectors                                            *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    90
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    91
is_dzero_def    "is_dzero == dnat_when`TT`(LAM x.FF)"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    92
is_dsucc_def    "is_dsucc == dnat_when`FF`(LAM x.TT)"
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
    93
dpred_def       "dpred == dnat_when`UU`(LAM x.x)"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    94
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    95
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    96
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    97
(* the taker for dnats                                                   *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    98
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
    99
dnat_take_def "dnat_take == (%n.iterate n dnat_copy UU)"
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   100
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   101
(* ----------------------------------------------------------------------- *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   102
(* definition of bisimulation is determined by domain equation             *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   103
(* simplification and rewriting for abstract constants yields def below    *)
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   104
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   105
dnat_bisim_def "dnat_bisim ==
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   106
(%R.!s1 s2.
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
   107
        R s1 s2 -->
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   108
  ((s1=UU & s2=UU) |(s1=dzero & s2=dzero) |
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   109
  (? s11 s21. s11~=UU & s21~=UU & s1=dsucc`s11 &
1479
21eb5e156d91 expanded tabs
clasohm
parents: 1274
diff changeset
   110
                 s2 = dsucc`s21 & R s11 s21)))"
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   111
ea0668a1c0ba added 8bit pragmas
regensbu
parents:
diff changeset
   112
end