Support vector in patterns, like we already support list

syndicate/pattern.rkt

@@ -56,6 +56,10 @@
     (and (identifier? stx)
          (free-identifier=? #'list stx)))
 
+  (define (vector-id? stx)
+    (and (identifier? stx)
+         (free-identifier=? #'vector stx)))
+
   (define (analyse-pattern stx)
     (syntax-case stx ($)
       [(ctor piece ...)
@@ -68,6 +72,11 @@
        (list* 'compound
               'list
               (stx-map analyse-pattern #'(piece ...)))]
+      [(vector piece ...)
+       (vector-id? #'vector)
+       (list* 'compound
+              'vector
+              (stx-map analyse-pattern #'(piece ...)))]
       [id
        (dollar-id? #'id)
        (list 'capture (undollar #'id) (list 'discard))]
@@ -87,6 +96,9 @@
       [(list piece ...)
        (list-id? #'list)
        (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
+      [(vector piece ...)
+       (vector-id? #'vector)
+       (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->pattern #'(piece ...))))]
       [id
        (dollar-id? #'id)
        (undollar #'id)]
@@ -106,6 +118,9 @@
       [(list piece ...)
        (list-id? #'list)
        (quasisyntax/loc stx (list #,@(stx-map instantiate-pattern->value #'(piece ...))))]
+      [(vector piece ...)
+       (vector-id? #'vector)
+       (quasisyntax/loc stx (vector #,@(stx-map instantiate-pattern->value #'(piece ...))))]
       [id
        (dollar-id? #'id)
        (undollar #'id)]
@@ -148,6 +163,8 @@
     (match desc
       [`(compound list ,pieces ...)
        #`(list 'list #,@(map desc->skeleton-stx pieces))]
+      [`(compound vector ,pieces ...)
+       #`(list 'vector #,@(map desc->skeleton-stx pieces))]
       [`(compound (,struct-type ,_ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...)
        #`(list #,struct-type #,@(map desc->skeleton-stx pieces))]
       [`(capture ,_ ,p) (desc->skeleton-stx p)]
@@ -168,6 +185,8 @@
     (match desc
       [`(compound list ,pieces ...)
        #`(list #,@(map desc->assertion-stx pieces))]
+      [`(compound vector ,pieces ...)
+       #`(vector #,@(map desc->assertion-stx pieces))]
       [`(compound (,_struct-type ,ctor ,_pred ,_getters ,_setters ,_super) ,pieces ...)
        #`(#,ctor #,@(map desc->assertion-stx pieces))]
       [`(capture ,_ ,p) #`(capture #,(desc->assertion-stx p))]

syndicate/skeleton.rkt

@@ -27,11 +27,12 @@
 ;;
 ;;       Skeleton = (skeleton-node SkCont (AListof SkSelector (MutableHash SkClass SkNode)))
 ;;     SkSelector = (skeleton-selector Nat Nat)
-;;        SkClass = StructType | (list-type Nat)
+;;        SkClass = StructType | (list-type Nat) | (vector-type Nat)
 ;;
 (struct skeleton-node (continuation [edges #:mutable]) #:transparent)
 (struct skeleton-selector (pop-count index) #:transparent)
 (struct list-type (arity) #:transparent)
+(struct vector-type (arity) #:transparent)
 ;;
 ;; A `SkDesc` is a single assertion silhouette, usually the
 ;; evaluation-result of `desc->skeleton-stx` from `pattern.rkt`.
@@ -156,6 +157,7 @@
 (define (term-matches-class? term class)
   (cond
     [(list-type? class) (and (list? term) (= (length term) (list-type-arity class)))]
+    [(vector-type? class) (and (vector? term) (= (vector-length term) (vector-type-arity class)))]
     [(struct-type? class) (and (non-object-struct? term) (eq? (struct->struct-type term) class))]
     [else (error 'term-matches-class? "Invalid class: ~v" class)]))
 
@@ -170,8 +172,9 @@
     (match desc
       [(list class-desc pieces ...)
        (define class
-         (cond [(eq? class-desc 'list) (list-type (length pieces))]
+         (cond [(struct-type? class-desc) class-desc]
-               [(struct-type? class-desc) class-desc]
+               [(eq? class-desc 'list) (list-type (length pieces))]
+               [(eq? class-desc 'vector) (vector-type (length pieces))]
                [else (error 'extend-skeleton! "Invalid class-desc: ~v" class-desc)]))
        (define selector (skeleton-selector pop-count index))
        (define table
@@ -232,14 +235,16 @@
       (define pieces (car popped-stack))
       (define term (vector-ref pieces (+ index 1))) ;; adjust for struct identifier at beginning
       (define entry (hash-ref table
-                              (cond [(list? term) (list-type (length term))]
+                              (cond [(non-object-struct? term) (struct->struct-type term)]
-                                    [(non-object-struct? term) (struct->struct-type term)]
+                                    [(list? term) (list-type (length term))]
+                                    [(vector? term) (vector-type (vector-length term))]
                                     [else #f])
                               #f))
       (when entry
         (define new-pieces
-          (cond [(list? term) (list->vector (cons 'list term))]
+          (cond [(non-object-struct? term) (struct->vector term)]
-                [(non-object-struct? term) (struct->vector term)]))
+                [(list? term) (list->vector (cons 'list term))]
+                [(vector? term) (list->vector (cons 'list (vector->list term)))]))
         (walk-node! entry (cons new-pieces term-stack)))))
 
   (walk-node! sk (list (vector 'list term0))))
@@ -303,8 +308,9 @@
 
 (define (apply-projection-path term path)
   (for/fold [(term (list term))] [(index (in-list path))]
-    (cond [(list? term) (list-ref term index)]
+    (cond [(non-object-struct? term) (vector-ref (struct->vector term) (+ index 1))]
-          [(non-object-struct? term) (vector-ref (struct->vector term) (+ index 1))]
+          [(list? term) (list-ref term index)]
+          [(vector? term) (vector-ref term index)]
           [else (error 'apply-projection "Term representation not supported: ~v" term)])))
 
 ;;---------------------------------------------------------------------------

syndicate/term.rkt

@@ -22,6 +22,8 @@
        (cons (struct->struct-type t) (map walk (cdr (vector->list (struct->vector t)))))]
       [(? list?)
        (cons 'list (map walk t))]
+      [(? vector?)
+       (cons 'vector (map walk (vector->list t)))]
       [atom
        #f])))
 
@@ -36,6 +38,8 @@
        (walk-edge 0 key-rev (cdr (vector->list (struct->vector t))))]
       [(? list?)
        (walk-edge 0 key-rev t)]
+      [(? vector?)
+       (walk-edge 0 key-rev (vector->list t))]
       [atom
        (atom-fn key-rev atom)]))
 
@@ -79,6 +83,8 @@
        (for-each pop-captures! (cdr (vector->list (struct->vector t))))]
       [(? list?)
        (for-each pop-captures! t)]
+      [(? vector?)
+       (for [(tt (in-vector t))] (pop-captures! tt))]
       [_ (void)]))
 
   (define (walk t)
@@ -93,6 +99,8 @@
               (map walk (cdr (vector->list (struct->vector t)))))]
       [(? list?)
        (map walk t)]
+      [(? vector?)
+       (for/vector [(tt t)] (walk tt))]
       [other other]))
 
   (walk t))