add stx txexpr functions in txexpr/stx

txexpr/private/container.rkt

@@ -0,0 +1,43 @@
+#lang racket/base
+
+(provide txexpr?/recur
+         txexpr->values/attrs?)
+
+(require racket/list)
+
+;; A [TXcontainer T A E] is one of:
+;;  - (List* T A (Listof E))
+;;  - (Lxst* T (Listof E))
+;; Where A and E are disjoint.
+
+;; txexpr?/recur :
+;;   Any
+;;   [Any -> Bool : T]
+;;   [Any -> Bool : #:+ (and A (! E)) #:- (! A)]
+;;   [Any -> Bool : #:+ (and E (! A)) #:- (! E)]
+;;   ->
+;;   Bool
+;;   : [TXcontainer T A E]
+;; the attrs? predicate and the element? predicate should be disjoint
+(define (txexpr?/recur v tag? attrs? element?)
+  (and (list? v)
+       (not (empty? v))
+       (tag? (first v))
+       (cond [(and (not (empty? (rest v)))
+                   (attrs? (second v)))
+              (andmap element? (rest (rest v)))]
+             [else
+              (andmap element? (rest v))])))
+
+;; txexpr->values/attrs? :
+;;   [TXcontainer T A E]
+;;   [Any -> Bool : #:+ (and A (! E)) #:- (! A)]
+;;   ->
+;;   (values T A (Listof E))
+(define (txexpr->values/attrs? tx attrs?)
+  (cond [(and (not (empty? (rest tx)))
+              (attrs? (second tx)))
+         (values (first tx) (second tx) (rest (rest tx)))]
+        [else
+         (values (first tx) '() (rest tx))]))
+

txexpr/stx.rkt

@@ -0,0 +1,127 @@
+#lang racket/base
+
+(provide stx-xexpr?
+         stx-txexpr?
+         stx-txexpr-tag?
+         stx-txexpr-attrs?
+         stx-txexpr->values
+         stx-txexpr->list
+         stx-txexpr-tag
+         stx-txexpr-attrs
+         stx-txexpr-elements)
+
+(require syntax/stx
+         xml
+         "base.rkt"
+         "private/container.rkt")
+
+;; ---------------------------------------------------------
+
+;; Data Definitions
+
+;; A [Stx E] is one of:
+;;  - (Syntaxof E)
+;;  - E
+
+;; A StxXexpr is a [Stx XexprE]
+;; A StxTXexpr is a [Stx TXexprE]
+;; A StxTag is a [Stx Symbol]
+;; A StxAttrs is a (StxListof (StxList [Stx Symbol] [Stx String]))
+;; A StxElements is a (StxListof StxXexpr)
+
+;; A XexprE is one of:
+;;  - String
+;;  - TXexprE
+;;  - Symbol       ; for example 'nbsp representing ` `
+;;  - ValidChar    ; for example #x20 representing ` `
+;;  - CData        ; an instance of the `cdata` structure type from `xml`
+;;  - Misc         ; an instance of the `comment` or `p-i` structure types
+
+;; A TXexprE is one of:
+;;  - (list* StxTag StxAttrs StxElements)
+;;  - (list* StxTag StxElements)
+
+;; The types `StxAttrs` and `StxXexpr` are disjoint, as they
+;; need to be for this to be unambiguous.
+
+;; ---------------------------------------------------------
+
+;; Predicates
+
+;; Any -> Bool
+(define (stx-xexpr? v)
+  (stx-xexpr?/recur v stx-xexpr?))
+
+;; Any -> Bool
+(define (stx-txexpr? v)
+  (stx-txexpr?/recur v stx-xexpr?))
+
+;; Any [Any -> Bool] -> Bool
+(define (stx-xexpr?/recur v rec)
+  (cond
+    [(syntax? v) (stx-xexpr?/recur (syntax-e v) rec)]
+    [(pair? v) (stx-txexpr?/recur v rec)]
+    [else (xexpr?/recur v rec)]))
+
+;; Any [Any -> Bool] -> Bool
+;; the `rec` predicate should not overlap with `txexpr-attrs?`
+(define (xexpr?/recur v rec)
+  (cond
+    [(pair? v) (txexpr?/recur v txexpr-tag? txexpr-attrs? rec)]
+    [(string? v) #true]
+    [(symbol? v) #true]
+    [(integer? v) (valid-char? v)]
+    [(cdata? v) #true]
+    [(comment? v) #true]
+    [(p-i? v) #true]
+    [else #false]))
+
+;; Any [Any -> Bool] -> Bool
+;; the `rec` predicate should not overlap with
+;; `stx-txexpr-attrs?`
+(define (stx-txexpr?/recur v rec)
+  ;; Even if it's not stx, the cdr or cddr might be syntax.
+  ;; This flattens it so that the cdd...r is always a pair or empty.
+  (define lst (stx->list v))
+  (and lst (txexpr?/recur lst stx-txexpr-tag? stx-txexpr-attrs? rec)))
+
+;; Any -> Bool
+(define (stx-txexpr-tag? v)
+  (cond
+    [(syntax? v) (txexpr-tag? (syntax-e v))]
+    [else (txexpr-tag? v)]))
+
+;; Any -> Bool
+(define (stx-txexpr-attrs? v)
+  (txexpr-attrs? (syntax->datum (datum->syntax #f v))))
+
+;; ---------------------------------------------------------
+
+;; Accessors
+
+;; StxTxexpr -> (values StxTag StxAttrs StxElements)
+(define (stx-txexpr->values v)
+  (txexpr->values/attrs? (stx->list v) stx-txexpr-attrs?))
+
+;; StxTxexpr -> (List StxTag StxAttrs StxElements)
+(define (stx-txexpr->list v)
+  (define-values [tag attrs elements] (stx-txexpr->values v))
+  (list tag attrs elements))
+
+;; StxTxexpr -> StxTag
+(define (stx-txexpr-tag v)
+  (define-values [tag attrs elements] (stx-txexpr->values v))
+  tag)
+
+;; StxTxexpr -> StxAttrs
+(define (stx-txexpr-attrs v)
+  (define-values [tag attrs elements] (stx-txexpr->values v))
+  attrs)
+
+;; StxTxexpr -> StxElements
+(define (stx-txexpr-elements v)
+  (define-values [tag attrs elements] (stx-txexpr->values v))
+  elements)
+
+;; ---------------------------------------------------------
+