kgsueme/doc/doc2haskell.xsl

r!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 a4) `shiftL` 48
              + (fI a3) `shiftL` 32
              + (fI a2) `shiftL` 16
              + (fI a1)
     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_2) `shiftL` 16
              + (fI w16_1)
     where fI a = fromIntegral a :: Int32

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

dec_STRING :: DecS [Word16]
dec_STRING =
  do c <- getU16
     if c == 0 then do return []
     else return (c: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 (fromIntegral 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 (b1:b2:x)

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 b2
   putU16 b1

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 b4
   putU16 b3
   putU16 b2
   putU16 b1

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 b2
  putU8 b1
 
enc_I32 :: Int32 -> DecS ()
enc_I32 a =
  let 
      b1 = fromIntegral (a `shiftR` 16) :: Word16
      b2 = fromIntegral a :: Word16
  putU16 b2
  putU16 b1

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

enc_STRING :: [Word16] -> DecS ()
enc_STRING (s:ss) =
  do putU16 s
     enc_STRING ss

{-  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:ps) =
 (1055 * (enc_password ps)) + (fromEnum 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.12
Committed:	Sun Jul 27 16:23:08 2003 UTC (20 years, 10 months ago) by elmex
Content type:	application/xml
Branch:	MAIN
Changes since 1.11:	+17 -10 lines
Log Message:	Minor fixes in some things... lets talk about it later.
#	User	Rev	Content
1	elmex	1.12	r!DOCTYPE xsl:stylesheet>
2	pcg	1.1	<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	elmex	1.9	module KGSProtocoll where
18			import Numeric
19	pcg	1.2	import Data.Word
20			import Control.Monad.State
21	pcg	1.1
22	elmex	1.9	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	pcg	1.4	hasData = do
30			xs <- get
31			return $ not $ null xs
32
33	elmex	1.9	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	pcg	1.11	return $ (fI a4) `shiftL` 48
59			+ (fI a3) `shiftL` 32
60			+ (fI a2) `shiftL` 16
61			+ (fI a1)
62	elmex	1.9	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	pcg	1.11	return $ (fI w16_2) `shiftL` 16
80			+ (fI w16_1)
81	elmex	1.9	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	elmex	1.12	dec_STRING :: DecS [Word16]
90	elmex	1.9	dec_STRING =
91	elmex	1.12	do c <- getU16
92			if c == 0 then do return []
93			else return (c:dec_STRING)
94
95			{- do da <- get
96	elmex	1.9	let (str,rest) = mkstr da
97			where
98			mkstr str [] =
99			(reverse str,[])
100			mkstr str (0:rest) =
101			(reverse str, rest)
102			mkstr str (c:rest) =
103	elmex	1.12	mkstr ((toEnum (fromIntegral c :: Int)):str) rest -}
104	pcg	1.1
105	elmex	1.9	{-
106	pcg	1.1	sub dec_STRING {
107			$data =~ s/^((?:..)*?)(?:\x00\x00\|\Z)//s;
108			# use Encode...
109	elmex	1.9	join "", map chr, unpack "v*", $1; -- marc ???
110			}
111			-}
112
113			dec_CONSTANT :: DecS a
114			dec_CONSTANT x = x
115
116			type Password = Word64
117
118			dec_password :: DecS Password
119			dec_password = dec_U64
120
121			dec_HEX :: DecS ()
122			dec_HEX =
123			do da <- get
124			putStr "HEX: "
125			putStrLn $ (dec_data da) ""
126			where dec_data (x:xs) =
127			((drop 2) . showHex x . (':':)) . (dec_data xs)
128			dec_data [] = (\_ -> "")
129	pcg	1.1
130			#############################################################################
131
132	elmex	1.9	putU8 :: Word8 -> DecS ()
133			putU8 a =
134			do x <- get
135			put (a:x)
136			return ()
137
138			putU16 :: Word16 -> DecS ()
139			putU16 a =
140			do x <- get
141			let b1 = fromIntegral (a `shiftR` 8) :: Word8
142			b2 = fromIntegral a :: Word8
143	pcg	1.11	put (b1:b2:x)
144	elmex	1.9
145			enc_U8 :: Word8 -> DecS ()
146			enc_U8 =
147			putU8
148
149			enc_U16 :: Word16 -> DecS ()
150			enc_U16 =
151			putU16
152
153			enc_U32 :: Word32 -> DecS ()
154			enc_U32 a =
155			let b1 = fromIntegral (a `shiftR` 16) :: Word16
156			b2 = fromIntegral a :: Word16
157			putU16 b2
158	pcg	1.11	putU16 b1
159	elmex	1.9
160			enc_U64 :: Word64 -> DecS ()
161			enc_U64 a =
162			let b1 = fromIntegral (a `shiftR` 48) :: Word16
163			b2 = fromIntegral (a `shiftR` 32) :: Word16
164			b3 = fromIntegral (a `shiftR` 16) :: Word16
165			b4 = fromIntegral a :: Word16
166	pcg	1.11	putU16 b4
167			putU16 b3
168	elmex	1.9	putU16 b2
169	pcg	1.11	putU16 b1
170	elmex	1.9
171			enc_I8 :: Int8 -> DecS ()
172			enc_I8 a =
173			putU8 (fromIntegral a :: Word8)
174
175			enc_I16 :: Int16 -> DecS ()
176			enc_I16 a =
177			let b1 = fromIntegral (a `shiftR` 8) :: Word8
178			b2 = fromIntegral a :: Word8
179	pcg	1.11	putU8 b2
180	elmex	1.9	putU8 b1
181
182			enc_I32 :: Int32 -> DecS ()
183			enc_I32 a =
184			let
185			b1 = fromIntegral (a `shiftR` 16) :: Word16
186			b2 = fromIntegral a :: Word16
187	pcg	1.11	putU16 b2
188	elmex	1.9	putU16 b1
189
190			enc_DATA :: [Word8] -> DecS ()
191			enc_DATA d =
192			do x <- get
193			put $ (reverse d) ++ x
194
195	elmex	1.12	enc_STRING :: [Word16] -> DecS ()
196			enc_STRING (s:ss) =
197			do putU16 s
198			enc_STRING ss
199
200			{- do let mstr = reverse s
201	elmex	1.9	putall (u:ls) =
202			do putU8 u
203			putall ls
204			putall [] = return ()
205			putall mstr
206	elmex	1.12	putU8 0 -}
207	elmex	1.9
208			enc_CONSTANT :: a -> DecS ()
209			enc_CONSTANT _ = return ()
210
211			enc_password :: Password -> DecS ()
212	elmex	1.12	enc_password (p:ps) =
213			(1055 * (enc_password ps)) + (fromEnum p)
214	pcg	1.1
215	elmex	1.9	{- marc???
216	pcg	1.1	sub enc_password {
217			require Math::BigInt; # I insist on 32-bit-perl.. should use C
218			# $hash must be 64 bit
219			my $hash = new Math::BigInt;
220			$hash = $hash * 1055 + ord for split //, $_[0];
221			enc_U64 $hash;
222			}
223	elmex	1.9	-}
224	pcg	1.1
225			]]>
226
227			#############################################################################
228			# types
229			<xsl:apply-templates select="descendant::type"/>
230
231			#############################################################################
232			# structures
233			<xsl:apply-templates select="descendant::struct"/>
234
235			#############################################################################
236			# "less" primitive types<![CDATA[
237
238	pcg	1.6	dec_TREE
239			enc_TREE
240	pcg	1.3
241	pcg	1.1	]]>
242
243			#############################################################################
244			# messages
245			<xsl:apply-templates select="descendant::message"/>
246			}
247
248			1;
249			</xsl:template>
250
251			<xsl:template match="type[@type = 'S']">
252	elmex	1.10	-- decode UCS-2 string of length <xsl:value-of select="@length"/>
253			-- the first 0 terminates the string, but not the field
254			dec_<xsl:value-of select="@name"/> :: DecS String
255			dec_<xsl:value-of select="@name"/> =
256			do getS <xsl:value-of select="@length"/>
257			where
258			-- getS ls 0 = reverse ls
259			getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
260			getS ls n = getU8 >>=\c getS (c:[]) (n-1)
261
262			-- likewise, encode as UCS-2, fill space with 0
263			enc_<xsl:value-of select="@name"/> :: String -> DecS ()
264			enc_<xsl:value-of select="@name"/> str =
265			do let rlen = (length str) - <xsl:value-of select="@length"/>
266			putS str
267			putN rlen
268			where
269			putN 0 = return ()
270			putN n = putU8 0 n-1
271			putS [] = return ()
272			putS (c:cs) = do putU8 c
273			putS cs
274	pcg	1.1	</xsl:template>
275
276			<xsl:template match="type[@type = 'A']">
277	elmex	1.10	-- decode ASCII string of length <xsl:value-of select="@length"/>
278			-- the first 0 terminates the string, but not the field
279			dec_<xsl:value-of select="@name"/> :: DecS String
280			dec_<xsl:value-of select="@name"/> =
281			do getS <xsl:value-of select="@length"/>
282			where
283			getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls)
284			-- getS (0:ls) n = getS (0:ls) (n-1)
285			getS ls n = getU8 >>=\c getS (c:[]) (n-1)
286
287			-- likewise, encode as ASCII, fill space with 0
288			enc_<xsl:value-of select="@name"/> :: String -> DecS ()
289			enc_<xsl:value-of select="@name"/> str =
290			do let rlen = (length str) - <xsl:value-of select="@length"/>
291			putS str
292			putN rlen
293			where
294			putN 0 = return ()
295			putN n = putU8 0 n-1
296			putS [] = return ()
297			putS (c:cs) = do putU8 c
298			putS cs
299	pcg	1.1	</xsl:template>
300
301			<xsl:template match="type[@multiplier]">
302	pcg	1.6	dec_<xsl:value-of select="@name"/> = do
303	pcg	1.3	n <- dec<xsl:value-of select="@type"/>
304	elmex	1.10	return $ n * (1 / <xsl:value-of select="@multiplier"/>)
305	pcg	1.1
306	pcg	1.6	enc_<xsl:value-of select="@name"/> n =
307	pcg	1.5	enc<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/>
308	pcg	1.1	</xsl:template>
309
310			<xsl:template match="member[@array = 'yes']" mode="dec">
311			$r->{<xsl:value-of select="@name"/>} = (my $array = []);
312			while (length $data) {
313			push @$array, dec_<xsl:value-of select="@type"/>
314			<xsl:text> </xsl:text>
315			<xsl:value-of select="@default"/>;
316			}
317			</xsl:template>
318
319			<xsl:template match="member" mode="dec">
320			<xsl:if test="@guard-cond">
321	pcg	1.5	-- decode next only when <xsl:value-of select="@guard-member"/> <xsl:value-of select="@guard-cond"/> --
322			</xsl:if>
323	pcg	1.7	<xsl:text> </xsl:text><xsl:value-of select="@name"/> <- dec<xsl:value-of select="@type"/> -- default <xsl:value-of select="@default"/> --
324	pcg	1.1	</xsl:template>
325
326			<xsl:template match="member" mode="enc">
327	pcg	1.5	enc<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> s
328	pcg	1.1	<xsl:text>} : (</xsl:text>
329			<xsl:value-of select="@default"/>
330			<xsl:text>);</xsl:text>
331			</xsl:template>
332
333			<xsl:template match="struct">
334	pcg	1.6	dec_<xsl:value-of select="@name"/> = do
335	pcg	1.1	<xsl:apply-templates select="member" mode="dec"/>
336			<xsl:if test="@class">
337	pcg	1.5	-- result has class <xsl:value-of select="@class"/> --
338	pcg	1.1	</xsl:if>
339
340	pcg	1.6	enc_<xsl:value-of select="@name"/> s =
341	pcg	1.1	<xsl:apply-templates select="member" mode="enc"/>
342	pcg	1.5
343	pcg	1.1	</xsl:template>
344
345			<xsl:template match="message">
346	pcg	1.6	-- <xsl:value-of select="@name"/>
347			dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do
348	pcg	1.5	-- type "<xsl:value-of select="@name"/>" --
349	pcg	1.1	<xsl:apply-templates select="member" mode="dec"/>
350	pcg	1.5
351	pcg	1.6	enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> =
352	pcg	1.5	encU16 0x<xsl:value-of select="@type"/>
353	pcg	1.1	<xsl:apply-templates select="member" mode="enc"/>
354	pcg	1.5
355	pcg	1.1	</xsl:template>
356
357			<xsl:template match="text()">
358			</xsl:template>
359
360			</xsl:stylesheet>
361