diff --git a/txexpr/private/container.rkt b/txexpr/private/container.rkt new file mode 100644 index 0000000..f4c042d --- /dev/null +++ b/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))])) + diff --git a/txexpr/stx.rkt b/txexpr/stx.rkt new file mode 100644 index 0000000..5d59ef8 --- /dev/null +++ b/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) + +;; --------------------------------------------------------- +