src/HOL/Lex/RegExp2NA.thy
author nipkow
Mon, 17 Aug 1998 11:00:57 +0200
changeset 5323 028e00595280
child 7224 e41e64476f9b
permissions -rw-r--r--
Direct translation RegExp -> NA!
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5323
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/Lex/RegExp2NA.thy
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     2
    ID:         $Id$
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     4
    Copyright   1998 TUM
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     5
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     6
Conversion of regular expressions *directly*
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     7
into nondeterministic automata *without* epsilon transitions
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     8
*)
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
     9
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    10
RegExp2NA = NA + RegExp +
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    11
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    12
types 'a bitsNA = ('a,bool list)na
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    13
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    14
syntax "##" :: 'a => 'a list set => 'a list set (infixr 65)
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    15
translations "x ## S" == "op # x `` S"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    16
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    17
constdefs
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    18
 atom  :: 'a => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    19
"atom a == ([True],
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    20
            %b s. if s=[True] & b=a then {[False]} else {},
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    21
            %s. s=[False])"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    22
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    23
 union :: 'a bitsNA => 'a bitsNA => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    24
"union == %(ql,dl,fl)(qr,dr,fr).
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    25
   ([],
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    26
    %a s. case s of
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    27
            [] => (True ## dl a ql) Un (False ## dr a qr)
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    28
          | left#s => if left then True ## dl a s
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    29
                              else False ## dr a s,
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    30
    %s. case s of [] => (fl ql | fr qr)
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    31
                | left#s => if left then fl s else fr s)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    32
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    33
 conc :: 'a bitsNA => 'a bitsNA => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    34
"conc == %(ql,dl,fl)(qr,dr,fr).
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    35
   (True#ql,
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    36
    %a s. case s of
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    37
            [] => {}
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    38
          | left#s => if left then (True ## dl a s) Un
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    39
                                   (if fl s then False ## dr a qr else {})
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    40
                              else False ## dr a s,
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    41
    %s. case s of [] => False | left#s => left & fl s & fr qr | ~left & fr s)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    42
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    43
 epsilon :: 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    44
"epsilon == ([],%a s. {}, %s. s=[])"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    45
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    46
 plus :: 'a bitsNA => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    47
"plus == %(q,d,f). (q, %a s. d a s Un (if f s then d a q else {}), f)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    48
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    49
 star :: 'a bitsNA => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    50
"star A == union epsilon (plus A)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    51
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    52
consts rexp2na :: 'a rexp => 'a bitsNA
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    53
primrec
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    54
"rexp2na Empty      = ([], %a s. {}, %s. False)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    55
"rexp2na(Atom a)    = atom a"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    56
"rexp2na(Union r s) = union (rexp2na r) (rexp2na s)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    57
"rexp2na(Conc r s)  = conc  (rexp2na r) (rexp2na s)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    58
"rexp2na(Star r)    = star  (rexp2na r)"
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    59
028e00595280 Direct translation RegExp -> NA!
nipkow
parents:
diff changeset
    60
end