From ae98699094db6bed9d610999fa6a992b9dd19aed Mon Sep 17 00:00:00 2001
From: Mike Gerwitz <mtg@gnu.org>
Date: Sat, 26 Mar 2016 14:34:22 -0400
Subject: [PATCH] Record slot naming

* src/record.xsl (n:name-slots, n:slot-names): added
* test/record.xspec: slot naming tests added
---
 src/record.xsl    | 116 ++++++++++++++++++++++++++++++++++++++++++++--
 test/record.xspec | 102 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 213 insertions(+), 5 deletions(-)

diff --git a/src/record.xsl b/src/record.xsl
index 09e7a2f..0a994d1 100644
--- a/src/record.xsl
+++ b/src/record.xsl
@@ -25,7 +25,8 @@
             xmlns:xs="http://www.w3.org/2001/XMLSchema"
             xmlns:n="http://mikegerwitz.com/hoxsl/node"
             xmlns:R="http://mikegerwitz.com/hoxsl/record"
-            xmlns:_R="http://mikegerwitz.com/hoxsl/record/_priv">
+            xmlns:_R="http://mikegerwitz.com/hoxsl/record/_priv"
+            xmlns:_Rs="http://mikegerwitz.com/hoxsl/record/_priv/slots">
 
 <import href="node.xsl" />
 
@@ -79,6 +80,7 @@
   @menu
   * Design Considerations: Record Design Considerations.
   * Header: Record Header.
+  * Slot Naming: Record Slot Naming.
   * Polymorphism: Record Polymorphism.
   @end menu
 
@@ -162,6 +164,10 @@
   The implementation will involve adding additional items into the sequence
     in order to provide the needed context.
 
+  Note: records are implemented without the use of Hoxsl's higher-order
+  functions; those functions are backed by records, so we'd have a bit of a
+  chicken-and-egg problem.
+
 
   @node Record Header
   @section Record Header
@@ -229,6 +235,13 @@
           select="resolve-uri(
                     'http://mikegerwitz.com/hoxsl/record/_priv' )" />
 
+<!--
+  The namespace for all slot name-index mappings.
+-->
+<variable name="_Rs:ns" as="xs:anyURI"
+          select="resolve-uri(
+                    'http://www.lovullo.com/hoxsl/record/_priv/slots' )" />
+
 <!--
   QName of the record header element.
 -->
@@ -283,8 +296,11 @@
   <sequence select="n:element( $R:qname,
                                ( n:attr( QName( $_R:ns, 'slots' ),
                                          $slot-count ) ),
-                               ( $Supertype/node(),
-                                 n:element( $qname ) ) )" />
+                               ( n:element( QName( $_R:ns, '_R:slot-names' ) ),
+                                 n:element( QName( $_R:ns, '_R:types' ),
+                                            (),
+                                            ( $Supertype/_R:types/node(),
+                                              n:element( $qname ) ) ) ) )" />
 </function>
 
 <!--
@@ -323,6 +339,98 @@
 </function>
 
 
+<!--
+  @node Record Slot Naming
+  @section Slot Naming
+
+  As discussed in @ref{Record Header},
+    slots are identified by their indexes.
+  Naming is an optional (and recommended) convenience to provide
+    human-readable, intuitive names for slots, irrespective of their
+    index/ordering.
+
+  A @dfn{slot name} is a QName that maps to a slot.
+
+  A word of caution:
+    the asymptotic complexity of a slot name index lookup is dependent on
+    how your XSLT engine handles dynamic attribute querying.
+    Unless you're creating records with many dozens of named slots,
+    you probably don't have to worry about access times.
+-->
+
+<!--
+  Create a new record header assigning QNames @var{qnames} for each slot,
+    in order.
+
+  This function is guaranteed to succeed,
+    so callers are responsible for implementing integrity checks:
+  If the length@tie{}@math{N} of @var{names} is greater than the
+    number@tie{}@math{M} of slots in @var{Record}, then only the first
+    @math{N} slot names will be used.
+  If @math{N<M},
+    then slots with an index greater than@tie{}@math{N} will be left
+    unnamed.
+
+  This will not remove any existing slot names!
+  If a name conflicts with an existing slot name,
+    it will be overwritten.
+  If a slot is already assigned a name,
+    then both names will be valid slot identifiers.
+-->
+<function name="R:name-slots" as="element( R:Record )">
+  <param name="Record" as="element( R:Record )" />
+  <param name="qnames" as="xs:QName*" />
+
+  <variable name="usable-count" as="xs:integer"
+            select="min( ( count( $qnames ),
+                           R:slot-count( $Record) ) )" />
+
+  <variable name="attrs" as="attribute()*"
+            select="for $i in 1 to $usable-count
+                      return n:attr( $qnames[ $i ], $i )" />
+
+  <variable name="rchildren" as="node()"
+            select="$Record/node() except $Record/_R:slot-names" />
+
+  <sequence select="n:element( node-name( $Record ),
+                               $Record/@*,
+                               ( n:add-attributes( $Record/_R:slot-names,
+                                                   $attrs ),
+                                 $rchildren ) )" />
+</function>
+
+
+<!--
+  Since slot names are QNames,
+    private slots (like private fields in classical object-oriented
+    programming) can be created by using a namespace that is not likely to
+    be used by anything else.
+  Of course, nothing will prevent the inspection of the record to determine
+    what those namespaces are.
+
+  Slot names can be discovered (a form of @dfn{reflection}) using
+    @ref{R:slot-names#2}.
+  To enforce namespace restrictions,
+    only slot names under the provided namespace will be returned.
+-->
+
+<!--
+  Retrieve all slot names of @var{Record} and their associated slots under
+    the namespace @var{ns}.
+
+  Slots will be returned as attributes,
+    providing a qname-slot pair.
+  It is possible for multiple slot names to map to the same slot.
+-->
+<function name="R:slot-names" as="attribute()*">
+  <param name="Record" as="element( R:Record )" />
+  <param name="ns"     as="xs:anyURI" />
+
+  <sequence select="$Record/_R:slot-names/@*[
+                      namespace-uri() = $ns ]" />
+</function>
+
+
 <!--
   @node Record Polymorphism
   @section Record Polymorphism
@@ -408,7 +516,7 @@
 
   <sequence select="$type = $R:qname
                     or exists(
-                         $Record/element()[
+                         $Record/_R:types/element()[
                            node-name( . ) = $type ] )" />
 </function>
 
diff --git a/test/record.xspec b/test/record.xspec
index 64c460d..b3885da 100644
--- a/test/record.xspec
+++ b/test/record.xspec
@@ -2,7 +2,7 @@
 <!--
   Tests records
 
-  Copyright (C) 2015 Mike Gerwitz
+  Copyright (C) 2015, 2016 Mike Gerwitz
 
     This file is part of hoxsl.
 
@@ -23,6 +23,7 @@
 <description xmlns="http://www.jenitennison.com/xslt/xspec"
              xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
              xmlns:x="http://www.jenitennison.com/xslt/xspec"
+             xmlns:n="http://mikegerwitz.com/hoxsl/node"
              xmlns:R="http://mikegerwitz.com/hoxsl/record"
              xmlns:foo="http://mikegerwitz.com/_junk"
              stylesheet="../src/record.xsl">
@@ -37,6 +38,18 @@
             select="QName( 'http://mikegerwitz.com/_junk',
                            'foo:test-qname-3' )" />
 
+  <variable name="slot-ns" as="xs:anyURI"
+            select="resolve-uri( 'http://mikegerwitz.com/_junk/slot' )" />
+
+  <variable name="sa" as="xs:QName"
+            select="QName( $slot-ns, 'a' )" />
+  <variable name="sb" as="xs:QName"
+            select="QName( $slot-ns, 'b' )" />
+  <variable name="sc" as="xs:QName"
+            select="QName( $slot-ns, 'c' )" />
+  <variable name="sd" as="xs:QName"
+            select="QName( $slot-ns, 'd' )" />
+
   <scenario label="R:make-record-header">
     <scenario label="with no supertype">
       <call function="R:make-record-header">
@@ -162,6 +175,93 @@
   </scenario>
 
 
+  <scenario label="R:name-slots">
+    <scenario label="not having been invoked on a record">
+      <call function="R:make-record-header">
+        <param name="qname" select="$test-qname" />
+        <param name="slots" select="3" />
+      </call>
+
+      <expect label="produces no named slots"
+              test="empty( R:slot-names( $x:result, $slot-ns ) )" />
+    </scenario>
+
+
+    <scenario label="with no names">
+      <call function="R:name-slots">
+        <param name="Record"
+               select="R:make-record-header( $test-qname, 3 )" />
+        <param name="names" select="()" />
+      </call>
+
+      <expect label="retains slot count"
+              test="R:slot-count( $x:result ) = 3" />
+
+      <expect label="produces no named slots"
+              test="empty( R:slot-names( $x:result, $slot-ns ) )" />
+    </scenario>
+
+
+    <scenario label="with names less than slot count">
+      <call function="R:name-slots">
+        <param name="Record"
+               select="R:make-record-header( $test-qname, 3 )" />
+        <param name="names" select="( $sa, $sb )" />
+      </call>
+
+      <expect label="retains slot count"
+              test="R:slot-count( $x:result ) = 3" />
+
+      <expect label="produces given named slots"
+              test="deep-equal( R:slot-names( $x:result, $slot-ns ),
+                                ( n:attr( $sa, 1 ),
+                                  n:attr( $sb, 2 ) ) )" />
+    </scenario>
+
+
+    <scenario label="with names greater than slot count N">
+      <call function="R:name-slots">
+        <param name="Record"
+               select="R:make-record-header( $test-qname, 3 )" />
+        <param name="names" select="( $sa, $sb, $sc, $sd )" />
+      </call>
+
+      <expect label="retains slot count"
+              test="R:slot-count( $x:result ) = 3" />
+
+      <expect label="produces only first N slot names"
+              test="deep-equal( R:slot-names( $x:result, $slot-ns ),
+                                ( n:attr( $sa, 1 ),
+                                  n:attr( $sb, 2 ),
+                                  n:attr( $sc, 3 ) ) )" />
+    </scenario>
+
+
+    <scenario label="invoked multiple times">
+      <!-- need to use a node to assert on attributes -->
+      <call function="n:element">
+        <param name="qname" select="$test-qname" />
+        <param name="attrs"
+               select="R:slot-names(
+                         R:name-slots(
+                           R:name-slots(
+                             R:make-record-header( $test-qname, 3 ),
+                             ( $sa, $sb ) ),
+                           ( $sd, $sc, $sb ) ),
+                         $slot-ns)" />
+      </call>
+
+      <expect label="overwrites slots names already specified"
+              test="count( $x:result/@* ) = 4
+                      and ( every $x in $x:result/@* satisfies
+                              deep-equal( $x, n:attr( $sd, 1 ) )
+                                or deep-equal( $x, n:attr( $sa, 1 ) )
+                                or deep-equal( $x, n:attr( $sc, 2 ) )
+                                or deep-equal( $x, n:attr( $sb, 3 ) ) )" />
+    </scenario>
+  </scenario>
+
+
   <scenario label="R:is-compatible">
     <scenario label="with super- and sub-types of same slot count">
       <call function="R:is-compatible">