annotate automaton-in-agda/src/agda/cfg1.agda @ 182:567754463810

reorganization
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 13 Jun 2021 18:48:57 +0900
parents agda/cfg1.agda@26407ce19d66
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 module cfg1 where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 open import Level renaming ( suc to succ ; zero to Zero )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 open import Data.Nat hiding ( _≟_ )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Data.Fin
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Product
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import Data.List
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import Data.Maybe
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 open import Relation.Binary.PropositionalEquality hiding ( [_] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 open import Relation.Nullary using (¬_; Dec; yes; no)
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12
163
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
13 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
14 -- Java → Java Byte Code
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
15 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
16 -- CFG Stack Machine (PDA)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
17 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
18
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
19
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 data Node (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 T : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 N : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 data Seq (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 _,_ : Symbol → Seq Symbol → Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 _. : Symbol → Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 Error : Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 data Body (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 _|_ : Seq Symbol → Body Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 _; : Seq Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 record CFGGrammer (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 field
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 cfg : Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 top : Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 eq? : Symbol → Symbol → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 typeof : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 infixr 80 _|_
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 infixr 90 _;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 infixr 100 _,_
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 infixr 110 _.
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 open CFGGrammer
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
47 -----------------
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 --
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 -- CGF language
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 --
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 -----------------
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
52
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 split : {Σ : Set} → (List Σ → Bool)
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 → ( List Σ → Bool) → List Σ → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 split x y [] = x [] ∧ y []
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
59
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 cfg-language0 : {Symbol : Set} → CFGGrammer Symbol → Body Symbol → List Symbol → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
61
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 {-# TERMINATING #-}
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 cfg-language1 : {Symbol : Set} → CFGGrammer Symbol → Seq Symbol → List Symbol → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 cfg-language1 cg Error x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 cfg-language1 cg (S , seq) x with typeof cg S
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 cfg-language1 cg (_ , seq) (x' ∷ t) | T x = eq? cg x x' ∧ cfg-language1 cg seq t
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 cfg-language1 cg (_ , seq) [] | T x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
68 cfg-language1 cg (_ , seq) x | N nonTerminal = split (cfg-language0 cg (cfg cg nonTerminal) )(cfg-language1 cg seq ) x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 cfg-language1 cg (S .) x with typeof cg S
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 cfg-language1 cg (_ .) (x' ∷ []) | T x = eq? cg x x'
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 cfg-language1 cg (_ .) _ | T x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 cfg-language1 cg (_ .) x | N nonTerminal = cfg-language0 cg (cfg cg nonTerminal) x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
73
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 cfg-language0 cg _ [] = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 cfg-language0 cg (rule | b) x =
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
76 cfg-language1 cg rule x ∨ cfg-language0 cg b x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 cfg-language0 cg (rule ;) x = cfg-language1 cg rule x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
78
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 cfg-language : {Symbol : Set} → CFGGrammer Symbol → List Symbol → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80 cfg-language cg = cfg-language0 cg (cfg cg (top cg ))
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
81
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
82
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 data IFToken : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 EA : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85 EB : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 EC : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 IF : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 THEN : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 ELSE : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 SA : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 SB : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 SC : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
93 expr : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 statement : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
95
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 token-eq? : IFToken → IFToken → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
97 token-eq? EA EA = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
98 token-eq? EB EB = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 token-eq? EC EC = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 token-eq? IF IF = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 token-eq? THEN THEN = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 token-eq? ELSE ELSE = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 token-eq? SA SA = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 token-eq? SB SB = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 token-eq? SC SC = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 token-eq? expr expr = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 token-eq? statement statement = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 token-eq? _ _ = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 typeof-IFG : IFToken → Node IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 typeof-IFG expr = N expr
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 typeof-IFG statement = N statement
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 typeof-IFG x = T x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 IFGrammer : CFGGrammer IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 IFGrammer = record {
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 cfg = cfg'
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 ; top = statement
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 ; eq? = token-eq?
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 ; typeof = typeof-IFG
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 } where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 cfg' : IFToken → Body IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 cfg' expr = EA . | EB . | EC . ;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 cfg' statement =
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 SA . | SB . | SC .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 | IF , expr , THEN , statement .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 | IF , expr , THEN , statement , ELSE , statement .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 cfg' x = Error ;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 cfgtest1 = cfg-language IFGrammer ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 cfgtest2 = cfg-language1 IFGrammer ( SA .) ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 cfgtest3 = cfg-language1 IFGrammer ( SA . ) ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
136
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
137 cfgtest4 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
138
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
139 cfgtest5 = cfg-language1 IFGrammer ( IF , expr , THEN , statement . ) (IF ∷ EA ∷ THEN ∷ SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 cfgtest6 = cfg-language1 IFGrammer ( statement .)(IF ∷ EA ∷ SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 cfgtest7 = cfg-language1 IFGrammer ( IF , expr , THEN , statement , ELSE , statement . )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 (IF ∷ EA ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
143 cfgtest8 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 cfgtest9 = cfg-language IFGrammer (IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
145
138
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
146 data E1Token : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
147 e1 : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
148 e[ : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
149 e] : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
150 expr : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
151 term : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
152
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
153 E1-token-eq? : E1Token → E1Token → Bool
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
154 E1-token-eq? e1 e1 = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
155 E1-token-eq? e[ e] = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
156 E1-token-eq? e] e] = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
157 E1-token-eq? expr expr = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
158 E1-token-eq? term term = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
159 E1-token-eq? _ _ = false
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
160
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
161 typeof-E1 : E1Token → Node E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
162 typeof-E1 expr = N expr
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
163 typeof-E1 term = N term
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
164 typeof-E1 x = T x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
165
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
166 E1Grammer : CFGGrammer E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
167 E1Grammer = record {
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
168 cfg = cfgE
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
169 ; top = expr
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
170 ; eq? = E1-token-eq?
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
171 ; typeof = typeof-E1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
172 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
173 cfgE : E1Token → Body E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
174 cfgE expr = term .
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
175
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
176 cfgE term = e1 .
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
177 | e[ , expr , e] .
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
178
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
179 cfgE x = Error ;
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
180
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
181 ecfgtest1 = cfg-language E1Grammer ( e1 ∷ [] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
182 ecfgtest2 = cfg-language E1Grammer ( e[ ∷ e1 ∷ e] ∷ [] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
183 ecfgtest3 = cfg-language E1Grammer ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
184