kgsueme/doc/doc2haskell.xsl

<!DOCTYPE xsl:stylesheet>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">

<xsl:output method="text" media-type="text/plain" encoding="utf-8"/>

<xsl:template match="/"><![CDATA[
-- This is an automatically generated file. 
-- This is an automatically generated file. 
-- This is an automatically generated file. 
-- This is an automatically generated file. 
-- This is an automatically generated file. 

-- See doc/protocol.xml and doc/doc2haskell.xsl

-- primitive enc/decoders

module KGSProtocoll where
import Numeric
import Data.Word
import Control.Monad.State

data DecState = DecState { data :: [Word8] }

-- type DecS a = State DecState a
type DecS a = StateT DecState IO a -- for dec_HEX


hasData :: DecS Bool
hasData = do
           xs <- get
           return $ not $ null xs

getU8 :: Word8
getU8 =
  do (x:xs) <- get
     put xs 
     return x

getU16 :: DecS Word16
getU16 =
 do a <- getU8
    b <- getU8
    return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256


dec_U8 :: DecS Word8
dec_U8 = getU8

dec_U16 :: DecS Word16
dec_U16 = getU16

dec_U64 :: DecS Word64
dec_U64 =
  do a1 <- getU16
     a2 <- getU16
     a3 <- getU16
     a4 <- getU16
     return $   (fI a1) `shiftL` 48 -- please check endians
              + (fI a2) `shiftL` 32
              + (fI a3) `shiftL` 16
              + (fI a4)
     where fI a = fromIntegral a :: Word64


dec_I8 :: DecS Int8
dec_I8 =
  do w8 <- getU8
     return $ fromIntegral w8 :: Int8

dec_I16 :: DecS Int16
dec_I16 =
  do w16 <- getU16
     return $ fromIntegral w16 :: Int16

dec_I32 :: DecS Int32
dec_I32 =
  do w16_1 <- getU16
     w16_2 <- getU16
     return $   (fI w16_1) `shiftL` 16 -- please cgecj endians
              + (fI w16_2)
     where fI a = fromIntegral a :: Int32

dec_DATA :: DecS [Word8]
dec_DATA =
  do da <- get
     put []
     return da

dec_STRING :: DecS String
dec_STRING =
  do da <- get
     let (str,rest) = mkstr da
     where 
       mkstr str [] =
         (reverse str,[])
       mkstr str (0:rest) =
         (reverse str, rest)
       mkstr str (c:rest) =
         mkstr ((toEnum (fromIntegra c :: Int)):str) rest

{-
sub dec_STRING {
   $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s;
   # use Encode...
   join "", map chr, unpack "v*", $1; -- marc ???
} 
-}

dec_CONSTANT :: DecS a
dec_CONSTANT x = x

type Password = Word64

dec_password :: DecS Password
dec_password = dec_U64

dec_HEX :: DecS ()
dec_HEX =
  do da <- get
     putStr "HEX: "
     putStrLn $ (dec_data da) ""
     where dec_data (x:xs) = 
             ((drop 2) . showHex x . (':':)) . (dec_data xs)
           dec_data []     = (\_ -> "")

#############################################################################

putU8 :: Word8 -> DecS ()
putU8 a = 
  do x <- get
     put (a:x)
     return ()

putU16 :: Word16 -> DecS ()
putU16 a =
  do x <- get
     let b1 = fromIntegral (a `shiftR` 8) :: Word8
         b2 = fromIntegral a :: Word8
     put (b2:b1:x) -- check endians

enc_U8 :: Word8 -> DecS ()
enc_U8 =
  putU8 

enc_U16 :: Word16 -> DecS ()
enc_U16 =
  putU16

enc_U32 :: Word32 -> DecS ()
enc_U32 a =
  let b1 = fromIntegral (a `shiftR` 16) :: Word16
      b2 = fromIntegral a :: Word16
   putU16 b1 -- check the goddamn endians marc :)
   putU16 b2

enc_U64 :: Word64 -> DecS ()
enc_U64 a =
  let b1 = fromIntegral (a `shiftR` 48) :: Word16
      b2 = fromIntegral (a `shiftR` 32) :: Word16
      b3 = fromIntegral (a `shiftR` 16) :: Word16
      b4 = fromIntegral a :: Word16
   putU16 b1 -- check the goddamn endians marc :)
   putU16 b2
   putU16 b3
   putU16 b4

enc_I8 :: Int8 -> DecS ()
enc_I8 a =
  putU8 (fromIntegral a :: Word8)

enc_I16 :: Int16 -> DecS ()
enc_I16 a =
  let b1 = fromIntegral (a `shiftR` 8) :: Word8
      b2 = fromIntegral a :: Word8
  putU8 b1
  putU8 b2
 
enc_I32 :: Int32 -> DecS ()
enc_I32 a =
  let 
      b1 = fromIntegral (a `shiftR` 16) :: Word16
      b2 = fromIntegral a :: Word16
  putU16 b1
  putU16 b2

enc_DATA :: [Word8] -> DecS ()
enc_DATA d =
  do x <- get 
     put $ (reverse d) ++ x

enc_STRING :: String -> DecS ()
enc_STRING s =
  do let mstr = reverse s
         putall (u:ls) =
           do putU8 u
              putall ls
         putall [] = return ()
      putall mstr
      putU8 0

enc_CONSTANT :: a -> DecS ()
enc_CONSTANT _ = return ()

enc_password :: Password -> DecS ()
enc_password p =
  enc_U64 p

{- marc???
sub enc_password {
   require Math::BigInt; # I insist on 32-bit-perl.. should use C
   # $hash must be 64 bit
   my $hash = new Math::BigInt;
   $hash = $hash * 1055 + ord for split //, $_[0];
   enc_U64 $hash;
}
-}

]]>

#############################################################################
# types
<xsl:apply-templates select="descendant::type"/>

#############################################################################
# structures
<xsl:apply-templates select="descendant::struct"/>

#############################################################################
# "less" primitive types<![CDATA[

dec_TREE
enc_TREE

]]>

#############################################################################
# messages
<xsl:apply-templates select="descendant::message"/>
}

1;
</xsl:template>

<xsl:template match="type[@type = 'S']">
-- decode UCS-2 string of length <xsl:value-of select="@length"/>
-- the first 0 terminates the string, but not the field
dec_<xsl:value-of select="@name"/> :: DecS String
dec_<xsl:value-of select="@name"/> = 
  do getS <xsl:value-of select="@length"/>
  where 
--    getS ls 0 = reverse ls
    getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
    getS ls n = getU8 >>=\c getS (c:[]) (n-1)

-- likewise, encode as UCS-2, fill space with 0
enc_<xsl:value-of select="@name"/> :: String -> DecS ()
enc_<xsl:value-of select="@name"/> str = 
  do let rlen = (length str) - <xsl:value-of select="@length"/>
     putS str
     putN rlen
  where
    putN 0      = return ()
    putN n      = putU8 0 n-1
    putS []     = return ()
    putS (c:cs) = do putU8 c
                     putS cs
</xsl:template>

<xsl:template match="type[@type = 'A']">
-- decode ASCII string of length <xsl:value-of select="@length"/>
-- the first 0 terminates the string, but not the field
dec_<xsl:value-of select="@name"/> :: DecS String
dec_<xsl:value-of select="@name"/> = 
  do getS <xsl:value-of select="@length"/>
  where 
    getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
--    getS (0:ls) n = getS (0:ls) (n-1)
    getS ls n = getU8 >>=\c getS (c:[]) (n-1)

-- likewise, encode as ASCII, fill space with 0
enc_<xsl:value-of select="@name"/> :: String -> DecS ()
enc_<xsl:value-of select="@name"/> str = 
  do let rlen = (length str) - <xsl:value-of select="@length"/>
     putS str
     putN rlen
  where
    putN 0      = return ()
    putN n      = putU8 0 n-1
    putS []     = return ()
    putS (c:cs) = do putU8 c
                     putS cs
</xsl:template>

<xsl:template match="type[@multiplier]">
dec_<xsl:value-of select="@name"/> = do
   n &lt;- dec<xsl:value-of select="@type"/>
   return $ n * (1 / <xsl:value-of select="@multiplier"/>)

enc_<xsl:value-of select="@name"/> n =
   enc<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/>
</xsl:template>

<xsl:template match="member[@array = 'yes']" mode="dec">
   $r->{<xsl:value-of select="@name"/>} = (my $array = []);
   while (length $data) {
      push @$array, dec_<xsl:value-of select="@type"/>
                        <xsl:text> </xsl:text>
                        <xsl:value-of select="@default"/>;
   }
</xsl:template>

<xsl:template match="member" mode="dec">
   <xsl:if test="@guard-cond">
      -- decode next only when <xsl:value-of select="@guard-member"/> <xsl:value-of select="@guard-cond"/> --
   </xsl:if>
   <xsl:text>   </xsl:text><xsl:value-of select="@name"/> &lt;- dec<xsl:value-of select="@type"/> -- default <xsl:value-of select="@default"/> --
</xsl:template>

<xsl:template match="member" mode="enc">
   enc<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> s
   <xsl:text>} : (</xsl:text>
   <xsl:value-of select="@default"/>
   <xsl:text>);</xsl:text>
</xsl:template>

<xsl:template match="struct">
dec_<xsl:value-of select="@name"/> = do
   <xsl:apply-templates select="member" mode="dec"/>
   <xsl:if test="@class">
   -- result has class <xsl:value-of select="@class"/> --
   </xsl:if>

enc_<xsl:value-of select="@name"/> s =
   <xsl:apply-templates select="member" mode="enc"/>

</xsl:template>

<xsl:template match="message">
-- <xsl:value-of select="@name"/>
dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do
   -- type "<xsl:value-of select="@name"/>" --
   <xsl:apply-templates select="member" mode="dec"/>

enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> =
   encU16 0x<xsl:value-of select="@type"/>
   <xsl:apply-templates select="member" mode="enc"/>

</xsl:template>

<xsl:template match="text()">
</xsl:template>

</xsl:stylesheet>

Revision:	1.10
Committed:	Sat Jul 26 13:02:15 2003 UTC (20 years, 10 months ago) by elmex
Content type:	application/xml
Branch:	MAIN
Changes since 1.9:	+45 -20 lines
Log Message:	Worked on <xsl:template match="type[@type = 'S']"> and <xsl:template match="type[@type = 'A']">.
#	Content
1	<!DOCTYPE xsl:stylesheet>
2	<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
3
4	<xsl:output method="text" media-type="text/plain" encoding="utf-8"/>
5
6	<xsl:template match="/"><![CDATA[
7	-- This is an automatically generated file.
8	-- This is an automatically generated file.
9	-- This is an automatically generated file.
10	-- This is an automatically generated file.
11	-- This is an automatically generated file.
12
13	-- See doc/protocol.xml and doc/doc2haskell.xsl
14
15	-- primitive enc/decoders
16
17	module KGSProtocoll where
18	import Numeric
19	import Data.Word
20	import Control.Monad.State
21
22	data DecState = DecState { data :: [Word8] }
23
24	-- type DecS a = State DecState a
25	type DecS a = StateT DecState IO a -- for dec_HEX
26
27
28	hasData :: DecS Bool
29	hasData = do
30	xs <- get
31	return $ not $ null xs
32
33	getU8 :: Word8
34	getU8 =
35	do (x:xs) <- get
36	put xs
37	return x
38
39	getU16 :: DecS Word16
40	getU16 =
41	do a <- getU8
42	b <- getU8
43	return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256
44
45
46	dec_U8 :: DecS Word8
47	dec_U8 = getU8
48
49	dec_U16 :: DecS Word16
50	dec_U16 = getU16
51
52	dec_U64 :: DecS Word64
53	dec_U64 =
54	do a1 <- getU16
55	a2 <- getU16
56	a3 <- getU16
57	a4 <- getU16
58	return $ (fI a1) `shiftL` 48 -- please check endians
59	+ (fI a2) `shiftL` 32
60	+ (fI a3) `shiftL` 16
61	+ (fI a4)
62	where fI a = fromIntegral a :: Word64
63
64
65	dec_I8 :: DecS Int8
66	dec_I8 =
67	do w8 <- getU8
68	return $ fromIntegral w8 :: Int8
69
70	dec_I16 :: DecS Int16
71	dec_I16 =
72	do w16 <- getU16
73	return $ fromIntegral w16 :: Int16
74
75	dec_I32 :: DecS Int32
76	dec_I32 =
77	do w16_1 <- getU16
78	w16_2 <- getU16
79	return $ (fI w16_1) `shiftL` 16 -- please cgecj endians
80	+ (fI w16_2)
81	where fI a = fromIntegral a :: Int32
82
83	dec_DATA :: DecS [Word8]
84	dec_DATA =
85	do da <- get
86	put []
87	return da
88
89	dec_STRING :: DecS String
90	dec_STRING =
91	do da <- get
92	let (str,rest) = mkstr da
93	where
94	mkstr str [] =
95	(reverse str,[])
96	mkstr str (0:rest) =
97	(reverse str, rest)
98	mkstr str (c:rest) =
99	mkstr ((toEnum (fromIntegra c :: Int)):str) rest
100
101	{-
102	sub dec_STRING {
103	$data =~ s/^((?:..)*?)(?:\x00\x00\|\Z)//s;
104	# use Encode...
105	join "", map chr, unpack "v*", $1; -- marc ???
106	}
107	-}
108
109	dec_CONSTANT :: DecS a
110	dec_CONSTANT x = x
111
112	type Password = Word64
113
114	dec_password :: DecS Password
115	dec_password = dec_U64
116
117	dec_HEX :: DecS ()
118	dec_HEX =
119	do da <- get
120	putStr "HEX: "
121	putStrLn $ (dec_data da) ""
122	where dec_data (x:xs) =
123	((drop 2) . showHex x . (':':)) . (dec_data xs)
124	dec_data [] = (\_ -> "")
125
126	#############################################################################
127
128	putU8 :: Word8 -> DecS ()
129	putU8 a =
130	do x <- get
131	put (a:x)
132	return ()
133
134	putU16 :: Word16 -> DecS ()
135	putU16 a =
136	do x <- get
137	let b1 = fromIntegral (a `shiftR` 8) :: Word8
138	b2 = fromIntegral a :: Word8
139	put (b2:b1:x) -- check endians
140
141	enc_U8 :: Word8 -> DecS ()
142	enc_U8 =
143	putU8
144
145	enc_U16 :: Word16 -> DecS ()
146	enc_U16 =
147	putU16
148
149	enc_U32 :: Word32 -> DecS ()
150	enc_U32 a =
151	let b1 = fromIntegral (a `shiftR` 16) :: Word16
152	b2 = fromIntegral a :: Word16
153	putU16 b1 -- check the goddamn endians marc :)
154	putU16 b2
155
156	enc_U64 :: Word64 -> DecS ()
157	enc_U64 a =
158	let b1 = fromIntegral (a `shiftR` 48) :: Word16
159	b2 = fromIntegral (a `shiftR` 32) :: Word16
160	b3 = fromIntegral (a `shiftR` 16) :: Word16
161	b4 = fromIntegral a :: Word16
162	putU16 b1 -- check the goddamn endians marc :)
163	putU16 b2
164	putU16 b3
165	putU16 b4
166
167	enc_I8 :: Int8 -> DecS ()
168	enc_I8 a =
169	putU8 (fromIntegral a :: Word8)
170
171	enc_I16 :: Int16 -> DecS ()
172	enc_I16 a =
173	let b1 = fromIntegral (a `shiftR` 8) :: Word8
174	b2 = fromIntegral a :: Word8
175	putU8 b1
176	putU8 b2
177
178	enc_I32 :: Int32 -> DecS ()
179	enc_I32 a =
180	let
181	b1 = fromIntegral (a `shiftR` 16) :: Word16
182	b2 = fromIntegral a :: Word16
183	putU16 b1
184	putU16 b2
185
186	enc_DATA :: [Word8] -> DecS ()
187	enc_DATA d =
188	do x <- get
189	put $ (reverse d) ++ x
190
191	enc_STRING :: String -> DecS ()
192	enc_STRING s =
193	do let mstr = reverse s
194	putall (u:ls) =
195	do putU8 u
196	putall ls
197	putall [] = return ()
198	putall mstr
199	putU8 0
200
201	enc_CONSTANT :: a -> DecS ()
202	enc_CONSTANT _ = return ()
203
204	enc_password :: Password -> DecS ()
205	enc_password p =
206	enc_U64 p
207
208	{- marc???
209	sub enc_password {
210	require Math::BigInt; # I insist on 32-bit-perl.. should use C
211	# $hash must be 64 bit
212	my $hash = new Math::BigInt;
213	$hash = $hash * 1055 + ord for split //, $_[0];
214	enc_U64 $hash;
215	}
216	-}
217
218	]]>
219
220	#############################################################################
221	# types
222	<xsl:apply-templates select="descendant::type"/>
223
224	#############################################################################
225	# structures
226	<xsl:apply-templates select="descendant::struct"/>
227
228	#############################################################################
229	# "less" primitive types<![CDATA[
230
231	dec_TREE
232	enc_TREE
233
234	]]>
235
236	#############################################################################
237	# messages
238	<xsl:apply-templates select="descendant::message"/>
239	}
240
241	1;
242	</xsl:template>
243
244	<xsl:template match="type[@type = 'S']">
245	-- decode UCS-2 string of length <xsl:value-of select="@length"/>
246	-- the first 0 terminates the string, but not the field
247	dec_<xsl:value-of select="@name"/> :: DecS String
248	dec_<xsl:value-of select="@name"/> =
249	do getS <xsl:value-of select="@length"/>
250	where
251	-- getS ls 0 = reverse ls
252	getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
253	getS ls n = getU8 >>=\c getS (c:[]) (n-1)
254
255	-- likewise, encode as UCS-2, fill space with 0
256	enc_<xsl:value-of select="@name"/> :: String -> DecS ()
257	enc_<xsl:value-of select="@name"/> str =
258	do let rlen = (length str) - <xsl:value-of select="@length"/>
259	putS str
260	putN rlen
261	where
262	putN 0 = return ()
263	putN n = putU8 0 n-1
264	putS [] = return ()
265	putS (c:cs) = do putU8 c
266	putS cs
267	</xsl:template>
268
269	<xsl:template match="type[@type = 'A']">
270	-- decode ASCII string of length <xsl:value-of select="@length"/>
271	-- the first 0 terminates the string, but not the field
272	dec_<xsl:value-of select="@name"/> :: DecS String
273	dec_<xsl:value-of select="@name"/> =
274	do getS <xsl:value-of select="@length"/>
275	where
276	getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
277	-- getS (0:ls) n = getS (0:ls) (n-1)
278	getS ls n = getU8 >>=\c getS (c:[]) (n-1)
279
280	-- likewise, encode as ASCII, fill space with 0
281	enc_<xsl:value-of select="@name"/> :: String -> DecS ()
282	enc_<xsl:value-of select="@name"/> str =
283	do let rlen = (length str) - <xsl:value-of select="@length"/>
284	putS str
285	putN rlen
286	where
287	putN 0 = return ()
288	putN n = putU8 0 n-1
289	putS [] = return ()
290	putS (c:cs) = do putU8 c
291	putS cs
292	</xsl:template>
293
294	<xsl:template match="type[@multiplier]">
295	dec_<xsl:value-of select="@name"/> = do
296	n <- dec<xsl:value-of select="@type"/>
297	return $ n * (1 / <xsl:value-of select="@multiplier"/>)
298
299	enc_<xsl:value-of select="@name"/> n =
300	enc<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/>
301	</xsl:template>
302
303	<xsl:template match="member[@array = 'yes']" mode="dec">
304	$r->{<xsl:value-of select="@name"/>} = (my $array = []);
305	while (length $data) {
306	push @$array, dec_<xsl:value-of select="@type"/>
307	<xsl:text> </xsl:text>
308	<xsl:value-of select="@default"/>;
309	}
310	</xsl:template>
311
312	<xsl:template match="member" mode="dec">
313	<xsl:if test="@guard-cond">
314	-- decode next only when <xsl:value-of select="@guard-member"/> <xsl:value-of select="@guard-cond"/> --
315	</xsl:if>
316	<xsl:text> </xsl:text><xsl:value-of select="@name"/> <- dec<xsl:value-of select="@type"/> -- default <xsl:value-of select="@default"/> --
317	</xsl:template>
318
319	<xsl:template match="member" mode="enc">
320	enc<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> s
321	<xsl:text>} : (</xsl:text>
322	<xsl:value-of select="@default"/>
323	<xsl:text>);</xsl:text>
324	</xsl:template>
325
326	<xsl:template match="struct">
327	dec_<xsl:value-of select="@name"/> = do
328	<xsl:apply-templates select="member" mode="dec"/>
329	<xsl:if test="@class">
330	-- result has class <xsl:value-of select="@class"/> --
331	</xsl:if>
332
333	enc_<xsl:value-of select="@name"/> s =
334	<xsl:apply-templates select="member" mode="enc"/>
335
336	</xsl:template>
337
338	<xsl:template match="message">
339	-- <xsl:value-of select="@name"/>
340	dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do
341	-- type "<xsl:value-of select="@name"/>" --
342	<xsl:apply-templates select="member" mode="dec"/>
343
344	enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> =
345	encU16 0x<xsl:value-of select="@type"/>
346	<xsl:apply-templates select="member" mode="enc"/>
347
348	</xsl:template>
349
350	<xsl:template match="text()">
351	</xsl:template>
352
353	</xsl:stylesheet>
354