ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2haskell.xsl
(Generate patch)

Comparing kgsueme/doc/doc2haskell.xsl (file contents):
Revision 1.12 by elmex, Sun Jul 27 16:23:08 2003 UTC vs.
Revision 1.13 by pcg, Tue Jul 29 03:29:51 2003 UTC

1r!DOCTYPE xsl:stylesheet> 1<!DOCTYPE xsl:stylesheet>
2<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> 2<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
3 3
4<xsl:output method="text" media-type="text/plain" encoding="utf-8"/> 4<xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
5 5
6<xsl:template match="/"><![CDATA[ 6<xsl:template match="/"><![CDATA[
… …
17module KGSProtocoll where 17module KGSProtocoll where
18import Numeric 18import Numeric
19import Data.Word 19import Data.Word
20import Control.Monad.State 20import Control.Monad.State
21 21
22type U8 = Int
23type U16 = Int
24type U32 = Word64
25type U64 = Word64
26type I8 = Int
27type I16 = Int
28type I32 = Word64 -- elmex? signed 32 bit
29type I64 = Word64 -- elmex? likewise
30
22data DecState = DecState { data :: [Word8] } 31data DecState = DecState { data :: [Word8] }
23 32
24-- type DecS a = State DecState a 33-- type DecS a = State DecState a
25type DecS a = StateT DecState IO a -- for dec_HEX 34type DecS a = StateT DecState IO a -- for dec_HEX
26
27 35
28hasData :: DecS Bool 36hasData :: DecS Bool
29hasData = do 37hasData = do
30 xs <- get 38 xs <- get
31 return $ not $ null xs 39 return $ not $ null xs
32 40
33getU8 :: Word8 41dec_U8 :: Word8
34getU8 = 42dec_U8 =
35 do (x:xs) <- get 43 do (x:xs) <- get
36 put xs 44 put xs
37 return x 45 return x
38 46
39getU16 :: DecS Word16 47dec_U16 :: DecS Word16
40getU16 = 48dec_U16 =
41 do a <- getU8 49 do a <- dec_U8
42 b <- getU8 50 b <- dec_U8
43 return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256 51 return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256
44 52
45
46dec_U8 :: DecS Word8
47dec_U8 = getU8
48
49dec_U16 :: DecS Word16
50dec_U16 = getU16
51 53
52dec_U64 :: DecS Word64 54dec_U64 :: DecS Word64
53dec_U64 = 55dec_U64 =
54 do a1 <- getU16 56 do a1 <- dec_U16
55 a2 <- getU16 57 a2 <- dec_U16
56 a3 <- getU16 58 a3 <- dec_U16
57 a4 <- getU16 59 a4 <- dec_U16
58 return $ (fI a4) `shiftL` 48 60 return $ (fI a4) `shiftL` 48
59 + (fI a3) `shiftL` 32 61 + (fI a3) `shiftL` 32
60 + (fI a2) `shiftL` 16 62 + (fI a2) `shiftL` 16
61 + (fI a1) 63 + (fI a1)
62 where fI a = fromIntegral a :: Word64 64 where fI a = fromIntegral a :: Word64
63 65
64 66
65dec_I8 :: DecS Int8 67dec_I8 :: DecS Int8
66dec_I8 = 68dec_I8 =
67 do w8 <- getU8 69 do w8 <- dec_U8
68 return $ fromIntegral w8 :: Int8 70 return $ fromIntegral w8 :: Int8
69 71
70dec_I16 :: DecS Int16 72dec_I16 :: DecS Int16
71dec_I16 = 73dec_I16 =
72 do w16 <- getU16 74 do w16 <- dec_U16
73 return $ fromIntegral w16 :: Int16 75 return $ fromIntegral w16 :: Int16
74 76
75dec_I32 :: DecS Int32 77dec_I32 :: DecS Int32
76dec_I32 = 78dec_I32 =
77 do w16_1 <- getU16 79 do w16_1 <- dec_U16
78 w16_2 <- getU16 80 w16_2 <- dec_U16
79 return $ (fI w16_2) `shiftL` 16 81 return $ (fI w16_2) `shiftL` 16
80 + (fI w16_1) 82 + (fI w16_1)
81 where fI a = fromIntegral a :: Int32 83 where fI a = fromIntegral a :: Int32
82 84
83dec_DATA :: DecS [Word8] 85dec_DATA :: DecS [Word8]
… …
86 put [] 88 put []
87 return da 89 return da
88 90
89dec_STRING :: DecS [Word16] 91dec_STRING :: DecS [Word16]
90dec_STRING = 92dec_STRING =
91 do c <- getU16 93 do c <- dec_U16
92 if c == 0 then do return [] 94 if c == 0 then do return []
93 else return (c:dec_STRING) 95 else return (c:dec_STRING)
94 96
95{- do da <- get 97{- do da <- get
96 let (str,rest) = mkstr da 98 let (str,rest) = mkstr da
… …
127 ((drop 2) . showHex x . (':':)) . (dec_data xs) 129 ((drop 2) . showHex x . (':':)) . (dec_data xs)
128 dec_data [] = (\_ -> "") 130 dec_data [] = (\_ -> "")
129 131
130############################################################################# 132#############################################################################
131 133
132putU8 :: Word8 -> DecS () 134enc_U8 :: Word8 -> DecS ()
133putU8 a = 135enc_U8 a =
134 do x <- get 136 do x <- get
135 put (a:x) 137 put (a:x)
136 return () 138 return ()
137 139
138putU16 :: Word16 -> DecS () 140enc_U16 :: Word16 -> DecS ()
139putU16 a = 141enc_U16 a =
140 do x <- get 142 do x <- get
141 let b1 = fromIntegral (a `shiftR` 8) :: Word8 143 let b1 = fromIntegral (a `shiftR` 8) :: Word8
142 b2 = fromIntegral a :: Word8 144 b2 = fromIntegral a :: Word8
143 put (b1:b2:x) 145 put (b1:b2:x)
144 146
145enc_U8 :: Word8 -> DecS ()
146enc_U8 =
147 putU8
148
149enc_U16 :: Word16 -> DecS ()
150enc_U16 =
151 putU16
152
153enc_U32 :: Word32 -> DecS () 147enc_U32 :: Word32 -> DecS ()
154enc_U32 a = 148enc_U32 a =
155 let b1 = fromIntegral (a `shiftR` 16) :: Word16 149 let b1 = fromIntegral (a `shiftR` 16) :: Word16
156 b2 = fromIntegral a :: Word16 150 b2 = fromIntegral a :: Word16
157 putU16 b2 151 enc_U16 b2
158 putU16 b1 152 enc_U16 b1
159 153
160enc_U64 :: Word64 -> DecS () 154enc_U64 :: Word64 -> DecS ()
161enc_U64 a = 155enc_U64 a =
162 let b1 = fromIntegral (a `shiftR` 48) :: Word16 156 let b1 = fromIntegral (a `shiftR` 48) :: Word16
163 b2 = fromIntegral (a `shiftR` 32) :: Word16 157 b2 = fromIntegral (a `shiftR` 32) :: Word16
164 b3 = fromIntegral (a `shiftR` 16) :: Word16 158 b3 = fromIntegral (a `shiftR` 16) :: Word16
165 b4 = fromIntegral a :: Word16 159 b4 = fromIntegral a :: Word16
166 putU16 b4 160 enc_U16 b4
167 putU16 b3 161 enc_U16 b3
168 putU16 b2 162 enc_U16 b2
169 putU16 b1 163 enc_U16 b1
170 164
171enc_I8 :: Int8 -> DecS () 165enc_I8 :: Int8 -> DecS ()
172enc_I8 a = 166enc_I8 a =
173 putU8 (fromIntegral a :: Word8) 167 enc_U8 (fromIntegral a :: Word8)
174 168
175enc_I16 :: Int16 -> DecS () 169enc_I16 :: Int16 -> DecS ()
176enc_I16 a = 170enc_I16 a =
177 let b1 = fromIntegral (a `shiftR` 8) :: Word8 171 let b1 = fromIntegral (a `shiftR` 8) :: Word8
178 b2 = fromIntegral a :: Word8 172 b2 = fromIntegral a :: Word8
179 putU8 b2 173 enc_U8 b2
180 putU8 b1 174 enc_U8 b1
181 175
182enc_I32 :: Int32 -> DecS () 176enc_I32 :: Int32 -> DecS ()
183enc_I32 a = 177enc_I32 a =
184 let 178 let
185 b1 = fromIntegral (a `shiftR` 16) :: Word16 179 b1 = fromIntegral (a `shiftR` 16) :: Word16
186 b2 = fromIntegral a :: Word16 180 b2 = fromIntegral a :: Word16
187 putU16 b2 181 enc_U16 b2
188 putU16 b1 182 enc_U16 b1
189 183
190enc_DATA :: [Word8] -> DecS () 184enc_DATA :: [Word8] -> DecS ()
191enc_DATA d = 185enc_DATA d =
192 do x <- get 186 do x <- get
193 put $ (reverse d) ++ x 187 put $ (reverse d) ++ x
194 188
195enc_STRING :: [Word16] -> DecS () 189enc_STRING :: [Word16] -> DecS ()
196enc_STRING (s:ss) = 190enc_STRING (s:ss) =
197 do putU16 s 191 do enc_U16 s
198 enc_STRING ss 192 enc_STRING ss
199 193
200{- do let mstr = reverse s 194{- do let mstr = reverse s
201 putall (u:ls) = 195 putall (u:ls) =
202 do putU8 u 196 do enc_U8 u
203 putall ls 197 putall ls
204 putall [] = return () 198 putall [] = return ()
205 putall mstr 199 putall mstr
206 putU8 0 -} 200 enc_U8 0 -}
207 201
208enc_CONSTANT :: a -> DecS () 202enc_CONSTANT :: a -> DecS ()
209enc_CONSTANT _ = return () 203enc_CONSTANT _ = return ()
210 204
211enc_password :: Password -> DecS () 205enc_password :: Password -> DecS ()
… …
240 234
241]]> 235]]>
242 236
243############################################################################# 237#############################################################################
244# messages 238# messages
239data KGS_server_msg =
240 KGS_server_msg_null
241<xsl:for-each select="descendant::message[@src='server']">
242 | KGS_server_<xsl:value-of select="@name"/> {
243<xsl:apply-templates select="member" mode="decl"/>
244 <xsl:text> }</xsl:text>
245</xsl:for-each>
246
247data KGS_client_msg =
248 KGS_server_msg_null
249<xsl:for-each select="descendant::message[@src='client']">
250 | KGS_client_<xsl:value-of select="@name"/> {
251<xsl:apply-templates select="member" mode="decl"/>
252 <xsl:text> }</xsl:text>
253</xsl:for-each>
254
245<xsl:apply-templates select="descendant::message"/> 255<xsl:apply-templates select="descendant::message"/>
246} 256}
247 257
2481; 2581;
249</xsl:template> 259</xsl:template>
250 260
251<xsl:template match="type[@type = 'S']"> 261<xsl:template match="type[@type = 'S']">
262type <xsl:value-of select="@name"/> = String
263
252-- decode UCS-2 string of length <xsl:value-of select="@length"/> 264-- decode UCS-2 string of length <xsl:value-of select="@length"/>
253-- the first 0 terminates the string, but not the field 265-- the first 0 terminates the string, but not the field
254dec_<xsl:value-of select="@name"/> :: DecS String 266dec_<xsl:value-of select="@name"/> :: DecS String
255dec_<xsl:value-of select="@name"/> = 267dec_<xsl:value-of select="@name"/> =
256 do getS <xsl:value-of select="@length"/> 268 do getS <xsl:value-of select="@length"/>
257 where 269 where
258-- getS ls 0 = reverse ls 270-- getS ls 0 = reverse ls
259 getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) 271 getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
260 getS ls n = getU8 >>=\c getS (c:[]) (n-1) 272 getS ls n = dec_U8 >>=\c getS (c:[]) (n-1)
261 273
262-- likewise, encode as UCS-2, fill space with 0 274-- likewise, encode as UCS-2, fill space with 0
263enc_<xsl:value-of select="@name"/> :: String -> DecS () 275enc_<xsl:value-of select="@name"/> :: String -> DecS ()
264enc_<xsl:value-of select="@name"/> str = 276enc_<xsl:value-of select="@name"/> str =
265 do let rlen = (length str) - <xsl:value-of select="@length"/> 277 do let rlen = (length str) - <xsl:value-of select="@length"/>
266 putS str 278 putS str
267 putN rlen 279 putN rlen
268 where 280 where
269 putN 0 = return () 281 putN 0 = return ()
270 putN n = putU8 0 n-1 282 putN n = enc_U8 0 n-1
271 putS [] = return () 283 putS [] = return ()
272 putS (c:cs) = do putU8 c 284 putS (c:cs) = do enc_U8 c
273 putS cs 285 putS cs
274</xsl:template> 286</xsl:template>
275 287
276<xsl:template match="type[@type = 'A']"> 288<xsl:template match="type[@type = 'A']">
289type <xsl:value-of select="@name"/> = String
290
277-- decode ASCII string of length <xsl:value-of select="@length"/> 291-- decode ASCII string of length <xsl:value-of select="@length"/>
278-- the first 0 terminates the string, but not the field 292-- the first 0 terminates the string, but not the field
279dec_<xsl:value-of select="@name"/> :: DecS String 293dec_<xsl:value-of select="@name"/> :: DecS String
280dec_<xsl:value-of select="@name"/> = 294dec_<xsl:value-of select="@name"/> =
281 do getS <xsl:value-of select="@length"/> 295 do getS <xsl:value-of select="@length"/>
282 where 296 where
283 getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) 297 getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
284-- getS (0:ls) n = getS (0:ls) (n-1) 298-- getS (0:ls) n = getS (0:ls) (n-1)
285 getS ls n = getU8 >>=\c getS (c:[]) (n-1) 299 getS ls n = dec_U8 >>=\c getS (c:[]) (n-1)
286 300
287-- likewise, encode as ASCII, fill space with 0 301-- likewise, encode as ASCII, fill space with 0
288enc_<xsl:value-of select="@name"/> :: String -> DecS () 302enc_<xsl:value-of select="@name"/> :: String -> DecS ()
289enc_<xsl:value-of select="@name"/> str = 303enc_<xsl:value-of select="@name"/> str =
290 do let rlen = (length str) - <xsl:value-of select="@length"/> 304 do let rlen = (length str) - <xsl:value-of select="@length"/>
291 putS str 305 putS str
292 putN rlen 306 putN rlen
293 where 307 where
294 putN 0 = return () 308 putN 0 = return ()
295 putN n = putU8 0 n-1 309 putN n = enc_U8 0 n-1
296 putS [] = return () 310 putS [] = return ()
297 putS (c:cs) = do putU8 c 311 putS (c:cs) = do enc_U8 c
298 putS cs 312 putS cs
299</xsl:template> 313</xsl:template>
300 314
301<xsl:template match="type[@multiplier]"> 315<xsl:template match="type[@multiplier]">
316type <xsl:value-of select="@name"/> = Float
317
302dec_<xsl:value-of select="@name"/> = do 318dec_<xsl:value-of select="@name"/> = do
303 n &lt;- dec<xsl:value-of select="@type"/> 319 n &lt;- dec_<xsl:value-of select="@type"/>
304 return $ n * (1 / <xsl:value-of select="@multiplier"/>) 320 return $ n * (1 / <xsl:value-of select="@multiplier"/>)
305 321
306enc_<xsl:value-of select="@name"/> n = 322enc_<xsl:value-of select="@name"/> n =
307 enc<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/> 323 enc_<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/>
324
325<xsl:text>
326</xsl:text>
308</xsl:template> 327</xsl:template>
309 328
310<xsl:template match="member[@array = 'yes']" mode="dec"> 329<xsl:template match="member[@array = 'yes']" mode="dec">
311 $r->{<xsl:value-of select="@name"/>} = (my $array = []); 330 $r->{<xsl:value-of select="@name"/>} = (my $array = []);
312 while (length $data) { 331 while (length $data) {
… …
316 } 335 }
317</xsl:template> 336</xsl:template>
318 337
319<xsl:template match="member" mode="dec"> 338<xsl:template match="member" mode="dec">
320 <xsl:if test="@guard-cond"> 339 <xsl:if test="@guard-cond">
321 -- decode next only when <xsl:value-of select="@guard-member"/> <xsl:value-of select="@guard-cond"/> -- 340 <xsl:text> if </xsl:text><xsl:value-of select="@guard-member"/><xsl:text> </xsl:text> <xsl:value-of select="@guard-cond"/> then do
322 </xsl:if> 341 </xsl:if>
323 <xsl:text> </xsl:text><xsl:value-of select="@name"/> &lt;- dec<xsl:value-of select="@type"/> -- default <xsl:value-of select="@default"/> -- 342 <xsl:text> </xsl:text><xsl:value-of select="@name"/> &lt;- dec_<xsl:value-of select="@type"/>
343<xsl:text>
344</xsl:text>
324</xsl:template> 345</xsl:template>
325 346
326<xsl:template match="member" mode="enc"> 347<xsl:template match="member" mode="enc">
327 enc<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> s 348 <xsl:text> enc_</xsl:text><xsl:value-of select="@type"/> $ <xsl:value-of select="@name"/> s
328 <xsl:text>} : (</xsl:text> 349</xsl:template>
329 <xsl:value-of select="@default"/> 350
330 <xsl:text>);</xsl:text> 351<xsl:template match="member" mode="decl">
352 <xsl:text> </xsl:text><xsl:value-of select="@name"/>: !<xsl:value-of select="@type"/>
353<xsl:text>
354</xsl:text>
331</xsl:template> 355</xsl:template>
332 356
333<xsl:template match="struct"> 357<xsl:template match="struct">
358data KGS_<xsl:value-of select="@name"/> = KGS_<xsl:value-of select="@name"/>
359 {
360<xsl:apply-templates select="member" mode="decl"/>
361 }
362
334dec_<xsl:value-of select="@name"/> = do 363dec_<xsl:value-of select="@name"/> = do
335 <xsl:apply-templates select="member" mode="dec"/> 364<xsl:apply-templates select="member" mode="dec"/>
336 <xsl:if test="@class"> 365 return KGS_<xsl:value-of select="@name"/><xsl:for-each select="member"><xsl:text> </xsl:text><xsl:value-of select="@name"/></xsl:for-each>
337 -- result has class <xsl:value-of select="@class"/> --
338 </xsl:if>
339 366
340enc_<xsl:value-of select="@name"/> s = 367enc_<xsl:value-of select="@name"/> s =
341 <xsl:apply-templates select="member" mode="enc"/> 368<xsl:apply-templates select="member" mode="enc"/>
342 369<xsl:text>
370</xsl:text>
343</xsl:template> 371</xsl:template>
344 372
345<xsl:template match="message"> 373<xsl:template match="message">
346-- <xsl:value-of select="@name"/> 374-- <xsl:value-of select="@name"/>
347dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do 375dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do
348 -- type "<xsl:value-of select="@name"/>" --
349 <xsl:apply-templates select="member" mode="dec"/> 376<xsl:apply-templates select="member" mode="dec"/>
377 return KGS_<xsl:value-of select="@name"/><xsl:for-each select="member"><xsl:text> </xsl:text><xsl:value-of select="@name"/></xsl:for-each>
350 378
351enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> = 379enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> =
352 encU16 0x<xsl:value-of select="@type"/> 380 enc_U16 0x<xsl:value-of select="@type"/>
353 <xsl:apply-templates select="member" mode="enc"/> 381<xsl:apply-templates select="member" mode="enc"/>
354 382
355</xsl:template> 383</xsl:template>
356 384
357<xsl:template match="text()"> 385<xsl:template match="text()">
358</xsl:template> 386</xsl:template>

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines