xslt/core.xslt

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <xsl:stylesheet version="3.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:fn="http://www.w3.org/2005/02/xpath-functions" xmlns:core="CORE" exclude-result-prefixes="core fn xsl">
   3     <xsl:function name="core:ns">
   4         <xsl:sequence>
   5             <malval kind="function" name="+" />
   6             <malval kind="function" name="-" />
   7             <malval kind="function" name="*" />
   8             <malval kind="function" name="/" />
   9             <malval kind="function" name="prn"/>
  10             <malval kind="function" name="pr-str"/>
  11             <malval kind="function" name="str"/>
  12             <malval kind="function" name="println"/>
  13             <malval kind="function" name="list"/>
  14             <malval kind="function" name="list?"/>
  15             <malval kind="function" name="empty?"/>
  16             <malval kind="function" name="count"/>
  17             <malval kind="function" name="="/>
  18             <malval kind="function" name="&lt;"/>
  19             <malval kind="function" name="&lt;="/>
  20             <malval kind="function" name="&gt;"/>
  21             <malval kind="function" name="&gt;="/>
  22             <malval kind="function" name="read-string"/>
  23             <malval kind="function" name="slurp"/>
  24             <malval kind="function" name="env??"/> <!-- defined in the step files -->
  25             <malval kind="function" name="eval"/> <!-- defined in the step files -->
  26             <malval kind="function" name="atom"/> <!-- defined in the step files -->
  27             <malval kind="function" name="atom?"/>
  28             <malval kind="function" name="deref"/> <!-- defined in the step files -->
  29             <malval kind="function" name="swap!"/> <!-- defined in the step files -->
  30             <malval kind="function" name="reset!"/> <!-- defined in the step files -->
  31         </xsl:sequence>
  32     </xsl:function>
  33
  34     <xsl:template name="core-apply">
  35       <xsl:param name="func" />
  36       <xsl:param name="args" />
  37       <xsl:choose>
  38         <xsl:when test="$func/malval/@kind = 'function'">
  39           <xsl:choose>
  40             <xsl:when test="$func/malval/@name = '+'">
  41               <xsl:variable name="result" select="number($args/value/malval/lvalue/malval[1]/@value) + number($args/value/malval/lvalue/malval[2]/@value)"></xsl:variable>
  42               <xsl:sequence select="core:makeMALType($result, 'number')"/>
  43             </xsl:when>
  44             <xsl:when test="$func/malval/@name = '-'">
  45               <xsl:variable name="result" select="number($args/value/malval/lvalue/malval[1]/@value) - number($args/value/malval/lvalue/malval[2]/@value)"></xsl:variable>
  46               <xsl:sequence select="core:makeMALType($result, 'number')"/>
  47             </xsl:when>
  48             <xsl:when test="$func/malval/@name = '*'">
  49               <xsl:variable name="result" select="number($args/value/malval/lvalue/malval[1]/@value) * number($args/value/malval/lvalue/malval[2]/@value)"></xsl:variable>
  50               <xsl:sequence select="core:makeMALType($result, 'number')"/>
  51             </xsl:when>
  52             <xsl:when test="$func/malval/@name = '/'">
  53               <xsl:variable name="result" select="number($args/value/malval/lvalue/malval[1]/@value) div number($args/value/malval/lvalue/malval[2]/@value)"></xsl:variable>
  54               <xsl:sequence select="core:makeMALType($result, 'number')"/>
  55             </xsl:when>
  56             <xsl:when test="$func/malval/@name = 'prn'">
  57                 <xsl:variable name="args" select="$args/value/malval/lvalue/malval" />
  58                 <xsl:variable name="sargs">
  59                   <xsl:for-each select="$args">
  60                     <xsl:variable name="arg">
  61                       <value>
  62                           <xsl:sequence select="."/>
  63                       </value>
  64                     </xsl:variable>
  65                     <str>
  66                         <xsl:for-each select="$arg">
  67                             <xsl:call-template name="malprinter-pr_str"><xsl:with-param name="readably" select="true()"/></xsl:call-template>
  68                         </xsl:for-each>
  69                     </str>
  70                   </xsl:for-each>
  71                 </xsl:variable>
  72                 <xsl:message>
  73                     <xsl:sequence select="string-join($sargs/str, ' ')"/>
  74                 </xsl:message>
  75                 <xsl:sequence select="core:makeMALType((), 'nil')"/>
  76             </xsl:when>
  77             <xsl:when test="$func/malval/@name = 'pr-str'">
  78                 <xsl:variable name="args" select="$args/value/malval/lvalue/malval" />
  79                 <xsl:variable name="sargs">
  80                   <xsl:for-each select="$args">
  81                     <xsl:variable name="arg">
  82                       <value>
  83                           <xsl:sequence select="."/>
  84                       </value>
  85                     </xsl:variable>
  86                     <str>
  87                         <xsl:for-each select="$arg">
  88                             <xsl:call-template name="malprinter-pr_str"><xsl:with-param name="readably" select="true()"/></xsl:call-template>
  89                         </xsl:for-each>
  90                     </str>
  91                   </xsl:for-each>
  92                 </xsl:variable>
  93                 <xsl:sequence select="core:makeMALType(string-join($sargs/str, ' '), 'string')"/>
  94             </xsl:when>
  95             <xsl:when test="$func/malval/@name = 'str'">
  96                 <xsl:variable name="args" select="$args/value/malval/lvalue/malval" />
  97                 <xsl:variable name="sargs">
  98                   <xsl:for-each select="$args">
  99                     <xsl:variable name="arg">
 100                       <value>
 101                           <xsl:sequence select="."/>
 102                       </value>
 103                     </xsl:variable>
 104                     <str>
 105                         <xsl:for-each select="$arg">
 106                             <xsl:call-template name="malprinter-pr_str"><xsl:with-param name="readably" select="false()"/></xsl:call-template>
 107                         </xsl:for-each>
 108                     </str>
 109                   </xsl:for-each>
 110                 </xsl:variable>
 111                 <xsl:sequence select="core:makeMALType(string-join($sargs/str, ''), 'string')"/>
 112             </xsl:when>
 113             <xsl:when test="$func/malval/@name = 'println'">
 114                 <xsl:variable name="args" select="$args/value/malval/lvalue/malval" />
 115                 <xsl:variable name="sargs">
 116                   <xsl:for-each select="$args">
 117                     <xsl:variable name="arg">
 118                       <value>
 119                           <xsl:sequence select="."/>
 120                       </value>
 121                     </xsl:variable>
 122                     <str>
 123                         <xsl:for-each select="$arg">
 124                             <xsl:call-template name="malprinter-pr_str"><xsl:with-param name="readably" select="false()"/></xsl:call-template>
 125                         </xsl:for-each>
 126                     </str>
 127                   </xsl:for-each>
 128                 </xsl:variable>
 129                 <xsl:message>
 130                     <xsl:sequence select="string-join($sargs/str, ' ')"/>
 131                 </xsl:message>
 132                 <xsl:sequence select="core:makeMALType((), 'nil')"/>
 133             </xsl:when>
 134             <xsl:when test="$func/malval/@name = 'list'">
 135                 <xsl:sequence select="$args"/>
 136             </xsl:when>
 137             <xsl:when test="$func/malval/@name = 'list?'">
 138                 <xsl:sequence select="core:makeMALType((), if ($args/value/malval/lvalue/malval[1]/@kind = 'list') then 'true' else 'false')"/>
 139             </xsl:when>
 140             <xsl:when test="$func/malval/@name = 'empty?'">
 141                 <xsl:sequence select="core:makeMALType((), if (count($args/value/malval/lvalue/malval[1]/lvalue/malval) = 0) then 'true' else 'false')"/>
 142             </xsl:when>
 143             <xsl:when test="$func/malval/@name = 'count'">
 144                 <xsl:sequence select="core:makeMALType(count($args/value/malval/lvalue/malval[1]/lvalue/malval), 'number')"/>
 145             </xsl:when>
 146             <xsl:when test="$func/malval/@name = '='">
 147                 <xsl:sequence select="core:makeMALType((), if (core:equal($args/value/malval/lvalue/malval[1], $args/value/malval/lvalue/malval[2])) then 'true' else 'false')"/>
 148             </xsl:when>
 149             <xsl:when test="$func/malval/@name = '&lt;'">
 150                 <xsl:sequence select="core:makeMALType((), if (number($args/value/malval/lvalue/malval[1]/@value) lt number($args/value/malval/lvalue/malval[2]/@value)) then 'true' else 'false')"/>
 151             </xsl:when>
 152             <xsl:when test="$func/malval/@name = '&lt;='">
 153                 <xsl:sequence select="core:makeMALType((), if (number($args/value/malval/lvalue/malval[1]/@value) le number($args/value/malval/lvalue/malval[2]/@value)) then 'true' else 'false')"/>
 154             </xsl:when>
 155             <xsl:when test="$func/malval/@name = '&gt;'">
 156                 <xsl:sequence select="core:makeMALType((), if (number($args/value/malval/lvalue/malval[1]/@value) gt number($args/value/malval/lvalue/malval[2]/@value)) then 'true' else 'false')"/>
 157             </xsl:when>
 158             <xsl:when test="$func/malval/@name = '&gt;='">
 159                 <xsl:sequence select="core:makeMALType((), if (number($args/value/malval/lvalue/malval[1]/@value) ge number($args/value/malval/lvalue/malval[2]/@value)) then 'true' else 'false')"/>
 160             </xsl:when>
 161             <xsl:when test="$func/malval/@name = 'read-string'">
 162               <xsl:variable name="read-string-context">
 163                 <str>
 164                   <xsl:value-of select="$args/value/malval/lvalue/malval[1]/@value"></xsl:value-of>
 165                 </str>
 166               </xsl:variable>
 167               <xsl:for-each select="$read-string-context">
 168                 <xsl:call-template name="malreader-read_str"></xsl:call-template>
 169               </xsl:for-each>
 170             </xsl:when>
 171             <xsl:when test="$func/malval/@name = 'slurp'">
 172                 <xsl:sequence select="core:makeMALType(unparsed-text($args/value/malval/lvalue/malval[1]/@value), 'string')"/>
 173             </xsl:when>
 174             <xsl:when test="$func/malval/@name = 'atom?'">
 175                 <xsl:sequence select="core:makeMALType((), if ($args/value/malval/lvalue/malval[1]/@kind = 'atom') then 'true' else 'false')"/>
 176             </xsl:when>
 177             <xsl:otherwise>
 178               <xsl:message terminate="yes">Invalid function <xsl:sequence select="$func"/> </xsl:message>
 179             </xsl:otherwise>
 180           </xsl:choose>
 181         </xsl:when>
 182         <xsl:otherwise></xsl:otherwise>
 183       </xsl:choose>
 184     </xsl:template>
 185
 186     <xsl:function name="core:makeMALType">
 187       <xsl:param name="value" />
 188       <xsl:param name="kind" />
 189       <value>
 190         <malval kind="{$kind}" value="{$value}"/>
 191       </value>
 192     </xsl:function>
 193
 194     <xsl:function name="core:all-equal">
 195         <xsl:param name="seq"/>
 196         <xsl:param name="left"/>
 197         <xsl:param name="right"/>
 198         <xsl:choose>
 199             <xsl:when test="empty($seq)">
 200               <xsl:sequence select="true()"/>
 201             </xsl:when>
 202             <xsl:otherwise>
 203               <xsl:choose>
 204                   <xsl:when test="core:list-equal($left, $right, head($seq))">
 205                     <xsl:sequence select="core:all-equal(tail($seq), $right, $left)"/>
 206                   </xsl:when>
 207                   <xsl:otherwise>
 208                     <xsl:sequence select="false()"/>
 209                   </xsl:otherwise>
 210               </xsl:choose>
 211             </xsl:otherwise>
 212         </xsl:choose>
 213     </xsl:function>
 214
 215     <xsl:function name="core:equal">
 216         <xsl:param name="left"/>
 217         <xsl:param name="right"/>
 218         <xsl:choose>
 219             <!-- equal kinds -->
 220             <xsl:when test="$left/@kind = $right/@kind">
 221               <xsl:choose>
 222                 <!-- sequence? -->
 223                 <xsl:when test="$left/@kind = 'list' or $left/@kind = 'vector' or $left/@kind = 'hash'">
 224                   <xsl:choose>
 225                     <!-- same counts -->
 226                     <xsl:when test="count($left/lvalue/malval) = count($right/lvalue/malval)">
 227                       <xsl:sequence select="core:all-equal(1 to count($left/lvalue/malval), $left, $right)"/>
 228                     </xsl:when>
 229                     <!-- different counts -->
 230                     <xsl:otherwise>
 231                         <xsl:sequence select="false()"/>
 232                     </xsl:otherwise>
 233                   </xsl:choose>
 234                 </xsl:when>
 235                 <!-- simple 'value' type -->
 236                 <xsl:otherwise>
 237                     <xsl:sequence select="string($left/@value) = string($right/@value)"/>
 238                 </xsl:otherwise>
 239               </xsl:choose>
 240             </xsl:when>
 241             <!-- different types -->
 242             <xsl:otherwise>
 243                 <xsl:choose>
 244                   <xsl:when test="($left/@kind = 'list' and $right/@kind = 'vector') or ($left/@kind = 'vector' and $right/@kind = 'list')">
 245                     <xsl:choose>
 246                       <!-- same counts -->
 247                       <xsl:when test="count($left/lvalue/malval) = count($right/lvalue/malval)">
 248                         <xsl:sequence select="core:all-equal(1 to count($left/lvalue/malval), $left, $right)"/>
 249                       </xsl:when>
 250                       <!-- different counts -->
 251                       <xsl:otherwise>
 252                           <xsl:sequence select="false()"/>
 253                       </xsl:otherwise>
 254                     </xsl:choose>
 255                   </xsl:when>
 256                   <xsl:otherwise>
 257                     <xsl:sequence select="false()"/>
 258                   </xsl:otherwise>
 259                 </xsl:choose>
 260             </xsl:otherwise>
 261         </xsl:choose>
 262     </xsl:function>
 263
 264     <xsl:function name="core:list-equal">
 265         <xsl:param name="l"/>
 266         <xsl:param name="r"/>
 267         <xsl:param name="v"/>
 268
 269         <xsl:sequence select="core:equal($l/lvalue/malval[$v], $r/lvalue/malval[$v])"/>
 270     </xsl:function>
 271 </xsl:stylesheet>