annotate automaton-in-agda/src/cfg1.agda @ 405:af8f630b7e60

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 24 Sep 2023 18:02:04 +0900
parents 91781b7c65a8
children b85402051cdb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
1 {-# OPTIONS --cubical-compatible #-}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
2
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 module cfg1 where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Level renaming ( suc to succ ; zero to Zero )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Nat hiding ( _≟_ )
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
7 -- open import Data.Fin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
8 -- open import Data.Product
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Data.List
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 open import Data.Maybe
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
11 -- open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ )
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 open import Relation.Binary.PropositionalEquality hiding ( [_] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 open import Relation.Nullary using (¬_; Dec; yes; no)
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
14 open import logic
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15
163
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
16 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
17 -- Java → Java Byte Code
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 -- CFG Stack Machine (PDA)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
20 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
21
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 138
diff changeset
22
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 data Node (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 T : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 N : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 data Seq (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 _,_ : Symbol → Seq Symbol → Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 _. : Symbol → Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 Error : Seq Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 data Body (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 _|_ : Seq Symbol → Body Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 _; : Seq Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 record CFGGrammer (Symbol : Set) : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 field
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 cfg : Symbol → Body Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 top : Symbol
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
40 eqP : Symbol → Symbol → Bool
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 typeof : Symbol → Node Symbol
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 infixr 80 _|_
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 infixr 90 _;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 infixr 100 _,_
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 infixr 110 _.
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 open CFGGrammer
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49
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 -- CGF language
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 --
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 -----------------
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 split : {Σ : Set} → (List Σ → Bool)
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 → ( List Σ → Bool) → List Σ → Bool
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
58 split x y [] = x [] /\ y []
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
59 split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t
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
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 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
64
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 {-# TERMINATING #-}
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 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
67 cfg-language1 cg Error x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
68 cfg-language1 cg (S , seq) x with typeof cg S
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
69 cfg-language1 cg (_ , seq) (x' ∷ t) | T x = eqP cg x x' /\ cfg-language1 cg seq t
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 cfg-language1 cg (_ , seq) [] | T x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 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
72 cfg-language1 cg (S .) x with typeof cg S
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
73 cfg-language1 cg (_ .) (x' ∷ []) | T x = eqP cg x x'
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 cfg-language1 cg (_ .) _ | T x = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 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
76
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 cfg-language0 cg _ [] = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 cfg-language0 cg (rule | b) x =
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
79 cfg-language1 cg rule x \/ cfg-language0 cg b x
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80 cfg-language0 cg (rule ;) x = cfg-language1 cg rule x
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 cfg-language : {Symbol : Set} → CFGGrammer Symbol → List Symbol → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 cfg-language cg = cfg-language0 cg (cfg cg (top cg ))
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
84
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 data IFToken : Set where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 EA : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 EB : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 EC : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 IF : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 THEN : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 ELSE : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
93 SA : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 SB : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
95 SC : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 expr : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
97 statement : IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
98
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 token-eq? : IFToken → IFToken → Bool
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 token-eq? EA EA = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 token-eq? EB EB = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 token-eq? EC EC = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 token-eq? IF IF = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 token-eq? THEN THEN = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 token-eq? ELSE ELSE = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 token-eq? SA SA = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 token-eq? SB SB = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 token-eq? SC SC = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 token-eq? expr expr = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 token-eq? statement statement = true
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 token-eq? _ _ = false
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 typeof-IFG : IFToken → Node IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 typeof-IFG expr = N expr
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 typeof-IFG statement = N statement
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 typeof-IFG x = T x
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 IFGrammer : CFGGrammer IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 IFGrammer = record {
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 cfg = cfg'
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 ; top = statement
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
122 ; eqP = token-eq?
46
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 ; typeof = typeof-IFG
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 } where
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 cfg' : IFToken → Body IFToken
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 cfg' expr = EA . | EB . | EC . ;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 cfg' statement =
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 SA . | SB . | SC .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 | IF , expr , THEN , statement .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 | IF , expr , THEN , statement , ELSE , statement .
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 cfg' x = Error ;
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 cfgtest1 = cfg-language IFGrammer ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
135
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 cfgtest2 = cfg-language1 IFGrammer ( SA .) ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
137
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
138 cfgtest3 = cfg-language1 IFGrammer ( SA . ) ( SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
139
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 cfgtest4 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
141
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 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
143 cfgtest6 = cfg-language1 IFGrammer ( statement .)(IF ∷ EA ∷ SA ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 cfgtest7 = cfg-language1 IFGrammer ( IF , expr , THEN , statement , ELSE , statement . )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
145 (IF ∷ EA ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
146 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
147 cfgtest9 = cfg-language IFGrammer (IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] )
964e4bd0272a add coinduction
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
148
138
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
149 data E1Token : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
150 e1 : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
151 e[ : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
152 e] : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
153 expr : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
154 term : E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
155
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
156 E1-token-eq? : E1Token → E1Token → Bool
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
157 E1-token-eq? e1 e1 = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
158 E1-token-eq? e[ e] = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
159 E1-token-eq? e] e] = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
160 E1-token-eq? expr expr = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
161 E1-token-eq? term term = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
162 E1-token-eq? _ _ = false
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
163
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
164 typeof-E1 : E1Token → Node E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
165 typeof-E1 expr = N expr
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
166 typeof-E1 term = N term
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
167 typeof-E1 x = T x
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
168
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
169 E1Grammer : CFGGrammer E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
170 E1Grammer = record {
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
171 cfg = cfgE
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
172 ; top = expr
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
173 ; eqP = E1-token-eq?
138
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
174 ; typeof = typeof-E1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
175 } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
176 cfgE : E1Token → Body E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
177 cfgE expr = term .
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 term = e1 .
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
180 | e[ , expr , e] .
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
181
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
182 cfgE x = Error ;
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
183
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
184 ecfgtest1 = cfg-language E1Grammer ( e1 ∷ [] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
185 ecfgtest2 = cfg-language E1Grammer ( e[ ∷ e1 ∷ e] ∷ [] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
186 ecfgtest3 = cfg-language E1Grammer ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] )
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
187 ecfgtest4 = cfg-language E1Grammer ( e[ ∷ e1 ∷ [] )
138
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 46
diff changeset
188
274
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
189 open import Function
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
190
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
191 left : {t : Set } → List E1Token → ( fail next : List E1Token → t ) → t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
192 left ( e[ ∷ t ) fail next = next t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
193 left t fail next = fail t
274
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
194
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
195 right : {t : Set } → List E1Token → ( fail next : List E1Token → t ) → t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
196 right ( e] ∷ t ) fail next = next t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
197 right t fail next = fail t
274
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
198
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
199
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
200 {-# TERMINATING #-}
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
201 expr1 : {t : Set } → List E1Token → ( fail next : List E1Token → t ) → t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
202 expr1 ( e1 ∷ t ) fail next = next t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
203 expr1 ( expr ∷ t ) fail next = next t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
204 expr1 ( term ∷ t ) fail next = next t
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
205 expr1 x fail next = left x fail $ λ x → expr1 x fail $ λ x → right x fail $ next
277
42563cc6afdf non-regular
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 276
diff changeset
206 -- expr1 x fail next = left x fail ( λ x → expr1 x fail ( λ x → right x fail ( next )))
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
207
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
208 cfgtest01 = expr1 ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] ) (λ x → ⟪ false , x ⟫ ) (λ x → ⟪ true , x ⟫ )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
209 cfgtest02 = expr1 ( e[ ∷ e[ ∷ e1 ∷ e] ∷ [] ) (λ x → ⟪ false , x ⟫ ) (λ x → ⟪ true , x ⟫ )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
210 cfgtest03 = expr1 ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ e] ∷ [] ) (λ x → ⟪ false , x ⟫ ) (λ x → ⟪ true , x ⟫ )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
211
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
212 open import pushdown
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
213
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
214 data CG1 : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
215 ce : CG1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
216 c1 : CG1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
217
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
218 pd : CG1 → E1Token → CG1 → CG1 ∧ PushDown CG1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
219 pd c1 e[ s = ⟪ c1 , push c1 ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
220 pd c1 e] c1 = ⟪ c1 , pop ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
221 pd c1 e1 c1 = ⟪ c1 , none ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
222 pd s expr s1 = ⟪ c1 , none ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
223 pd s term s1 = ⟪ c1 , none ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
224 pd s _ s1 = ⟪ ce , none ⟫
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
225
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
226 pok : CG1 → Bool
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
227 pok c1 = true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
228 pok s = false
274
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 183
diff changeset
229
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
230 pnc : PushDownAutomaton CG1 E1Token CG1
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
231 pnc = record {
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
232 pδ = pd
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
233 ; pempty = ce
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
234 ; pok = pok
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
235 }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
236
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
237 pda-ce-test1 = PushDownAutomaton.paccept pnc c1 ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] ) []
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
238 pda-ce-test2 = PushDownAutomaton.paccept pnc c1 ( e[ ∷ e[ ∷ e1 ∷ e] ∷ [] ) []
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
239 pda-ce-test3 = PushDownAutomaton.paccept pnc c1 ( e[ ∷ e1 ∷ e] ∷ e1 ∷ [] ) []
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
240
276
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
241 record PNC (accept : Bool ) : Set where
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
242 field
276
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
243 orig-x : List E1Token
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
244 pnc-q : CG1
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
245 pnc-st : List CG1
276
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
246 pnc-p : CG1 → List CG1 → Bool
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
247 success : accept ≡ true → pnc-p pnc-q pnc-st ≡ true → PushDownAutomaton.paccept pnc c1 orig-x [] ≡ true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
248 failure : accept ≡ false → pnc-p pnc-q pnc-st ≡ false → PushDownAutomaton.paccept pnc c1 orig-x [] ≡ false
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
249
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
250 open import Data.Unit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
251
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
252 {-# TERMINATING #-}
276
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
253 expr1P : {n : Level } {t : Set n } → (x : List E1Token ) → PNC true
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
254 → ( fail : List E1Token → PNC false → t ) → ( next : List E1Token → PNC true → t ) → t
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
255 expr1P x _ _ _ = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
256
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
257 expr1P-test : (x : List E1Token ) → ⊤
276
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
258 expr1P-test x = expr1P x record { orig-x = x ; pnc-q = c1 ; pnc-st = []
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
259 ; pnc-p = λ q st → PushDownAutomaton.paccept pnc q x st ; success = λ _ p → p ; failure = λ _ p → p }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 275
diff changeset
260 (λ x p → {!!} ) (λ x p → {!!} )
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
261
318
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
262 ----
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
263 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
264 -- CFG to PDA
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
265 --
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
266
318
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
267 cfg→pda-state : {Symbol : Set} → CFGGrammer Symbol → Set
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
268 cfg→pda-state cfg = {!!}
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 274
diff changeset
269
318
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
270 cfg→pda-start : {Symbol : Set} → (cfg : CFGGrammer Symbol) → cfg→pda-state cfg
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
271 cfg→pda-start cfg = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
272
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
273 cfg→pda : {Symbol : Set} → (cfg : CFGGrammer Symbol) → PDA (cfg→pda-state cfg) Symbol (cfg→pda-state cfg)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
274 cfg→pda cfg = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
275
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
276 cfg->pda : {Symbol : Set} → (input : List Symbol)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
277 → (cfg : CFGGrammer Symbol)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
278 → PDA.paccept (cfg→pda cfg ) (cfg→pda-start cfg) input [] ≡ cfg-language cfg input
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
279 cfg->pda = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
280
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
281 ----
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
282 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
283 -- PDA to CFG
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
284 --
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
285 open import pushdown
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
286
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
287 pda→cfg : {Symbol : Set} { Q : Set} → (pda : PDA Q Symbol Q) → CFGGrammer Symbol
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
288 pda→cfg pda = record {
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
289 cfg = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
290 ; top = {!!}
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
291 ; eqP = {!!}
318
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
292 ; typeof = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
293 }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
294
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
295 pda->cfg : {Symbol : Set} { Q : Set} → (start : Q) → (input : List Symbol)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
296 → (pda : PDA Q Symbol Q)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
297 → PDA.paccept pda start input [] ≡ cfg-language (pda→cfg pda) input
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
298 pda->cfg = {!!}
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
299
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
300 record CDGGrammer (Symbol : Set) : Set where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
301 field
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
302 cdg : Seq Symbol → Body Symbol
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
303 top : Symbol
405
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 318
diff changeset
304 eqP : Symbol → Symbol → Bool
318
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
305 typeof : Symbol → Node Symbol
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 277
diff changeset
306