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

import Data.Word
import Control.Monad.State

getU8 :: State [Word8] Int
getU8 = do
           (x:xs) <- get
           put xs
           return x

getU16 :: State [Word8] Int
getU16 = do
             a <- getU8
             b <- getU8
             return $ a + b * 256

decU64
decI8
decI16
decI32
decDATA

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

sub dec_CONSTANT {
   $_[0];
}

sub dec_password {
   dec_U64;
}

sub dec_HEX { # for debugging
   "HEX: " . unpack "H*", $data;#d#
}

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

sub enc_U8 {
   $data .= pack "C", $_[0];
}

sub enc_U16 {
   $data .= pack "v", $_[0];
}

sub enc_U32 {
   $data .= pack "V", $_[0];
}

sub enc_U64 {
   enc_U32 $_[0] & 0xffffffff;
   enc_U32 +($_[0] >> 32) & 0xffffffff;
}

sub enc_I8 {
   $data .= pack "c", $_[0];
}

sub enc_I16 {
   enc_U16 unpack "S", pack "s", $_[0];
}

sub enc_I32 {
   enc_U32 unpack "I", pack "i", $_[0];
}

sub enc_DATA {
   # a dream!
   $data .= $_[0];
}

sub enc_STRING {
   # should use encode for speed and clarity ;)
   $data .= pack "v*", map ord, split //, $_[0];
}

sub enc_CONSTANT {
   # nop
}

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;
}

sub enc_HEX {
   die "enc_HEX not defined for good";
}

]]>

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

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

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

decTREE
encTREE

]]>

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

1;
</xsl:template>

<xsl:template match="type[@type = 'S']">
dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
dec<xsl:value-of select="@name"/> = do
   -- decode UCS-2 string of length <xsl:value-of select="@length"/>
   -- the first 0 terminates the string, but not the field

enc<xsl:value-of select="@name"/> =
   -- likewise, encode as UCS-2, fill space with 0
</xsl:template>

<xsl:template match="type[@type = 'A']">
dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
dec<xsl:value-of select="@name"/> = do
   -- decode ASCII string of length <xsl:value-of select="@length"/>
   -- the first 0 terminates the string, but not the field

enc<xsl:value-of select="@name"/> =
   -- likewise, encode as ASCII, fill space with 0
</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"/> =
   <xsl:value-of select="@multiplier"/> * enc<xsl:value-of select="@type"/>
</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">
   $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
                                              <xsl:text> </xsl:text>
                                              <xsl:value-of select="@default"/>
   <xsl:if test="@guard-cond">
      if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
   <xsl:text>;</xsl:text>
</xsl:template>

<xsl:template match="member" mode="enc">
   <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
      $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
         or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
   </xsl:if><!--#d#-->
   enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
   <xsl:text>} : (</xsl:text>
   <xsl:value-of select="@default"/>
   <xsl:text>);</xsl:text>
</xsl:template>

<xsl:template match="struct">
sub dec_<xsl:value-of select="@name"/> {
   my $r = {};
   <xsl:apply-templates select="member" mode="dec"/>
   <xsl:if test="@class">
   bless $r, <xsl:value-of select="@class"/>::;
   </xsl:if>
   $r;
}

sub enc_<xsl:value-of select="@name"/> {
   <xsl:apply-templates select="member" mode="enc"/>
}
</xsl:template>

<xsl:template match="message">
# <xsl:value-of select="@name"/>
$dec_<xsl:value-of select="@src"/>{0x<xsl:value-of select="@type"/>} = sub {
   $data = $_[0];
   my $r;
   $r->{type} = "<xsl:value-of select="@name"/>";
   <xsl:apply-templates select="member" mode="dec"/>
   $r;
};
$enc_<xsl:value-of select="@src"/>{<xsl:value-of select="@name"/>} = sub {
   $data = "";
   enc_U16 0x<xsl:value-of select="@type"/>;
   <xsl:apply-templates select="member" mode="enc"/>
   $data;
};
</xsl:template>

<xsl:template match="member">
   [<xsl:value-of select="@name"/>
   <xsl:text>=> "</xsl:text>
   <xsl:value-of select="@type"/>
   <xsl:text>", "</xsl:text>
   <xsl:value-of select="@default"/>
   <xsl:text>", "</xsl:text>
   <xsl:value-of select="@guard"/>
   <xsl:text>;"],</xsl:text>
</xsl:template>

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

</xsl:stylesheet>

Revision:	1.3
Committed:	Fri Jul 25 22:25:44 2003 UTC (20 years, 10 months ago) by pcg
Content type:	application/xml
Branch:	MAIN
Changes since 1.2:	+25 -215 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.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	pcg	1.2	import Data.Word
18			import Control.Monad.State
19	pcg	1.1
20	pcg	1.2	getU8 :: State [Word8] Int
21			getU8 = do
22			(x:xs) <- get
23			put xs
24			return x
25
26			getU16 :: State [Word8] Int
27			getU16 = do
28			a <- getU8
29			b <- getU8
30			return $ a + b * 256
31
32	pcg	1.3	decU64
33			decI8
34			decI16
35			decI32
36			decDATA
37	pcg	1.1
38			sub dec_STRING {
39			$data =~ s/^((?:..)*?)(?:\x00\x00\|\Z)//s;
40			# use Encode...
41			join "", map chr, unpack "v*", $1;
42			}
43
44			sub dec_CONSTANT {
45			$_[0];
46			}
47
48			sub dec_password {
49			dec_U64;
50			}
51
52			sub dec_HEX { # for debugging
53			"HEX: " . unpack "H*", $data;#d#
54			}
55
56			#############################################################################
57
58			sub enc_U8 {
59			$data .= pack "C", $_[0];
60			}
61
62			sub enc_U16 {
63			$data .= pack "v", $_[0];
64			}
65
66			sub enc_U32 {
67			$data .= pack "V", $_[0];
68			}
69
70			sub enc_U64 {
71			enc_U32 $_[0] & 0xffffffff;
72			enc_U32 +($_[0] >> 32) & 0xffffffff;
73			}
74
75			sub enc_I8 {
76			$data .= pack "c", $_[0];
77			}
78
79			sub enc_I16 {
80			enc_U16 unpack "S", pack "s", $_[0];
81			}
82
83			sub enc_I32 {
84			enc_U32 unpack "I", pack "i", $_[0];
85			}
86
87			sub enc_DATA {
88			# a dream!
89			$data .= $_[0];
90			}
91
92			sub enc_STRING {
93			# should use encode for speed and clarity ;)
94			$data .= pack "v*", map ord, split //, $_[0];
95			}
96
97			sub enc_CONSTANT {
98			# nop
99			}
100
101			sub enc_password {
102			require Math::BigInt; # I insist on 32-bit-perl.. should use C
103			# $hash must be 64 bit
104			my $hash = new Math::BigInt;
105			$hash = $hash * 1055 + ord for split //, $_[0];
106			enc_U64 $hash;
107			}
108
109			sub enc_HEX {
110			die "enc_HEX not defined for good";
111			}
112
113			]]>
114
115			#############################################################################
116			# types
117			<xsl:apply-templates select="descendant::type"/>
118
119			#############################################################################
120			# structures
121			<xsl:apply-templates select="descendant::struct"/>
122
123			#############################################################################
124			# "less" primitive types<![CDATA[
125
126	pcg	1.3	decTREE
127			encTREE
128
129	pcg	1.1	]]>
130
131			#############################################################################
132			# messages
133			<xsl:apply-templates select="descendant::message"/>
134			}
135
136			1;
137			</xsl:template>
138
139			<xsl:template match="type[@type = 'S']">
140	pcg	1.3	dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
141			dec<xsl:value-of select="@name"/> = do
142			-- decode UCS-2 string of length <xsl:value-of select="@length"/>
143			-- the first 0 terminates the string, but not the field
144	pcg	1.1
145	pcg	1.3	enc<xsl:value-of select="@name"/> =
146			-- likewise, encode as UCS-2, fill space with 0
147	pcg	1.1	</xsl:template>
148
149			<xsl:template match="type[@type = 'A']">
150	pcg	1.3	dec<xsl:value-of select="@name"/> :: State [Word8] [Char]
151			dec<xsl:value-of select="@name"/> = do
152			-- decode ASCII string of length <xsl:value-of select="@length"/>
153			-- the first 0 terminates the string, but not the field
154	pcg	1.1
155	pcg	1.3	enc<xsl:value-of select="@name"/> =
156			-- likewise, encode as ASCII, fill space with 0
157	pcg	1.1	</xsl:template>
158
159			<xsl:template match="type[@multiplier]">
160	pcg	1.3	dec<xsl:value-of select="@name"/> = do
161			n <- dec<xsl:value-of select="@type"/>
162			return n * (1 / <xsl:value-of select="@multiplier"/>)
163	pcg	1.1
164	pcg	1.3	enc<xsl:value-of select="@name"/> =
165			<xsl:value-of select="@multiplier"/> * enc<xsl:value-of select="@type"/>
166	pcg	1.1	</xsl:template>
167
168			<xsl:template match="member[@array = 'yes']" mode="dec">
169			$r->{<xsl:value-of select="@name"/>} = (my $array = []);
170			while (length $data) {
171			push @$array, dec_<xsl:value-of select="@type"/>
172			<xsl:text> </xsl:text>
173			<xsl:value-of select="@default"/>;
174			}
175			</xsl:template>
176
177			<xsl:template match="member" mode="dec">
178			$r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/>
179			<xsl:text> </xsl:text>
180			<xsl:value-of select="@default"/>
181			<xsl:if test="@guard-cond">
182			if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if>
183			<xsl:text>;</xsl:text>
184			</xsl:template>
185
186			<xsl:template match="member" mode="enc">
187			<!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
188			$_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
189			or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
190			</xsl:if><!--#d#-->
191			enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
192			<xsl:text>} : (</xsl:text>
193			<xsl:value-of select="@default"/>
194			<xsl:text>);</xsl:text>
195			</xsl:template>
196
197			<xsl:template match="struct">
198			sub dec_<xsl:value-of select="@name"/> {
199			my $r = {};
200			<xsl:apply-templates select="member" mode="dec"/>
201			<xsl:if test="@class">
202			bless $r, <xsl:value-of select="@class"/>::;
203			</xsl:if>
204			$r;
205			}
206
207			sub enc_<xsl:value-of select="@name"/> {
208			<xsl:apply-templates select="member" mode="enc"/>
209			}
210			</xsl:template>
211
212			<xsl:template match="message">
213			# <xsl:value-of select="@name"/>
214			$dec_<xsl:value-of select="@src"/>{0x<xsl:value-of select="@type"/>} = sub {
215			$data = $_[0];
216			my $r;
217			$r->{type} = "<xsl:value-of select="@name"/>";
218			<xsl:apply-templates select="member" mode="dec"/>
219			$r;
220			};
221			$enc_<xsl:value-of select="@src"/>{<xsl:value-of select="@name"/>} = sub {
222			$data = "";
223			enc_U16 0x<xsl:value-of select="@type"/>;
224			<xsl:apply-templates select="member" mode="enc"/>
225			$data;
226			};
227			</xsl:template>
228
229			<xsl:template match="member">
230			[<xsl:value-of select="@name"/>
231			<xsl:text>=> "</xsl:text>
232			<xsl:value-of select="@type"/>
233			<xsl:text>", "</xsl:text>
234			<xsl:value-of select="@default"/>
235			<xsl:text>", "</xsl:text>
236			<xsl:value-of select="@guard"/>
237			<xsl:text>;"],</xsl:text>
238			</xsl:template>
239
240			<xsl:template match="text()">
241			</xsl:template>
242
243			</xsl:stylesheet>
244