Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 217 lines (166 sloc) 6.271 kB
74fdab9 @leepike New examples...
authored
1 -- | Examples of parsing various languages. We'll assume input tokens come from
2 -- an external variable. Assume the input doesn't given tokens outside the
3 -- alphabet, and the result is always delayed by one w.r.t. the input stream.
4
f9f8a28 @leepike More examples.
authored
5 -- Copilot can compute at least NP-Complete problems.
f035b68 @leepike Updates to Languages example.
authored
6
74fdab9 @leepike New examples...
authored
7 {-# LANGUAGE RebindableSyntax #-}
8
0ebad84 @leepike Updated examples.
authored
9 module Languages (languages) where
74fdab9 @leepike New examples...
authored
10
11 import Language.Copilot
12 import qualified Prelude as P
f035b68 @leepike Updates to Languages example.
authored
13 import qualified Data.List as L
74fdab9 @leepike New examples...
authored
14
15 ---------------------------------------------------------------------------------
16 -- Regular expressions
17
18 {-
19 We'll build a Copilot program to accept the regular language over the alphabet
20 {0,1} that contains an even number of 0s.
21 -}
22
23 reAccept :: Spec
24 reAccept = do
25 observer "accept" accept
26 observer "string" string
27 where
28 accept :: Stream Bool
29 accept = [True] ++ if string == 0
30 then if accept then false
31 else true
32 else accept
33
34 -- Input tokens.
35 string :: Stream Word8
36 string = [0] ++ if string == 0 then 1 else 0
37
38 -- interpret 10 reAccept
39
40 ---------------------------------------------------------------------------------
41
42 ---------------------------------------------------------------------------------
43 -- Context-free Grammars
44
45 {-
46 This Copilot program recognizes <0^n 1^n>, for n >= 0.
47 -}
48
49 cfAccept :: Int -> Spec
50 cfAccept n = do
51 observer "accept" accept
52 observer "string" string
53 where
54 accept :: Stream Bool
55 accept = if zerosSeen == 0
56 then true
57 else false
58
59 zerosSeen :: Stream Word64
60 zerosSeen = [0] ++ if string == 0
61 then zerosSeen + 1
62 else zerosSeen - 1
63
64 -- Input tokens.
65 string :: Stream Word8
f035b68 @leepike Updates to Languages example.
authored
66 string = L.replicate n 0 P.++ L.replicate n 1 ++ 0 -- don't care about part of
67 -- stream after ++
74fdab9 @leepike New examples...
authored
68
69 -- interpret 40 (cfAccept 10)
70 ---------------------------------------------------------------------------------
71
72 ---------------------------------------------------------------------------------
f035b68 @leepike Updates to Languages example.
authored
73 -- Context-sensitive grammars
74fdab9 @leepike New examples...
authored
74
75 {-
76 This Copilot program recognizes <0^n 1^n 2^n>, for n >= 0.
77 -}
78
79 csAccept :: Int -> Spec
80 csAccept n = do
81 observer "accept" accept
82 observer "string" string
83 where
84 accept :: Stream Bool
85 accept = if zerosSeen == 0 && onesSeen == 0
86 then true
87 else false
88
89 zerosSeen :: Stream Word64
90 zerosSeen = [0] ++ if string == 0
91 then zerosSeen + 1
92 else if string == 1
93 then zerosSeen - 1
94 else zerosSeen
95
96 onesSeen :: Stream Word64
97 onesSeen = [0] ++ if string == 1
98 then onesSeen + 1
99 else if string == 0
100 then onesSeen
101 else onesSeen - 1
102
103 -- Input tokens.
104 string :: Stream Word8
f035b68 @leepike Updates to Languages example.
authored
105 string = L.replicate n 0 P.++ L.replicate n 1 P.++ L.replicate n 2
74fdab9 @leepike New examples...
authored
106 ++ 0 -- don't care about part of
107 -- stream after ++
108
109 -- interpret 40 (csAccept 5)
110 ---------------------------------------------------------------------------------
f035b68 @leepike Updates to Languages example.
authored
111
112 ---------------------------------------------------------------------------------
113 -- Context-sensitive grammars
114
115 {-
e308694 @leepike Modified languages example.
authored
116 This Copilot program recognizes the "copy language" <xx | x \in {0,1}*>.
117
118 Note: the "trick" is to encode the history of streams in a bitvector. Thus, we
119 can only recognize arbitrarily long words if we have arbitrarily long
120 bitvectors. There is nothing in Copilot preventing this, but the largest base
121 type is currently a Word64.
122
123 Without this encoding, we couldn't build a recognizers, because we can't
124 generate new streams on the fly or look back arbitrarily far in the history of a
125 stream; both are fixed at compile time.
126
f035b68 @leepike Updates to Languages example.
authored
127 -}
128
e308694 @leepike Modified languages example.
authored
129
130 copyAccept :: Spec
131 copyAccept = do
132 observer "accept" accept
133 observer "hist" hist
134 observer "string" string
135 observer "cnt" cnt
136 where
137
138 accept :: Stream Bool
139 accept = if cnt `mod` 2 == 1 then false else bottom == top
140 where
141 halfCnt = cnt `div` 2
142 zeroBot = (complement $ (2^halfCnt) - 1) .&. hist
143 top = zeroBot .>>. halfCnt
144 bottom = hist - zeroBot
145
146 hist :: Stream Word64
147 hist = [0] ++ ((2^cnt) * cast string) + hist
148
149 cnt :: Stream Word64
150 cnt = [0] ++ cnt + 1
151
152 -- Input tokens.
153 string :: Stream Word8
154 string = let x = [1,0,0,1,0,1] in
155 x P.++ x
156 ++ 0 -- don't care about part of
157 -- stream after ++
158
0ebad84 @leepike Updated examples.
authored
159 ---------------------------------------------------------------------------------
160
161 languages :: IO ()
162 languages = do
163 interpret 20 reAccept
164 interpret 20 (cfAccept 10)
165 interpret 20 (csAccept 10)
166 interpret 20 copyAccept
e308694 @leepike Modified languages example.
authored
167
f035b68 @leepike Updates to Languages example.
authored
168 ---------------------------------------------------------------------------------
169 -- -- Recognize the language of arbitrarily long sequence of prime numbers.
170
171 -- -- Sieve of Eratosthenes
172 -- primes :: Word64 -> [Word64]
173 -- primes n = primes' 2 nums
174
175 -- where
176 -- nums = [2..n]
177
178 -- f :: Word64 -> [Word64] -> [Word64]
179 -- f x = L.filter (\a -> P.not (P.rem a x P.== 0 P.&& a P.> x))
180
181 -- primes' :: Word64 -> [Word64] -> [Word64]
182 -- primes' x ls = let ls' = f x ls in
183 -- -- Can't use rebinded if-the-else syntax
184 -- case ls' P.== ls of
185 -- True -> ls
186 -- False -> primes' (x P.+ 1) ls'
187
188 -- primesInf :: [Word64]
189 -- primesInf = foldr primes' [2] [3..]
190
191 -- where
192
193 -- -- returns divisors that evenly divide x
194 -- f :: Word64 -> [Word64] -> Bool
195 -- f x ls = ls `seq` (L.or $ map (\a -> P.rem x a P.== 0) ls)
196 -- -- L.filter (\a -> P.rem x a P.== 0)
197
198 -- primes' :: Word64 -> [Word64] -> [Word64]
199 -- primes' next prms = case prms `seq` f next prms of
200 -- True -> prms `seq` (next:prms)
201 -- False -> prms
202
203
204
205 -- primesAccept :: Word64 -> Spec
206 -- primesAccept n = do
207 -- observer "primes" primesStrm
208 -- observer "accept" accept
209
210 -- where
211 -- -- Assume we are implementing a Sieve of Eratosthenes
212 -- accept :: Stream Word64
213 -- accept =
214
215 -- primesStrm :: Stream Word64
216 -- primesStrm = primes n ++ 0 -- don't care about rest of values after ++
Something went wrong with that request. Please try again.