Changeset 9345 in project


Ignore:
Timestamp:
03/09/08 14:53:47 (12 years ago)
Author:
Alex Shinn
Message:

Adding support for vector patterns.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/riaxpander/synrules.scm

    r5506 r9345  
    5959  (define %car (r 'car))
    6060  (define %cdr (r 'cdr))
     61  (define %vector? (r 'vector?))
     62  (define %vector-length (r 'vector-length))
     63  (define %vector-ref (r 'vector-ref))
     64  (define %vector->list (r 'vector->list))
     65  (define %>= (r '>=))
     66  (define %= (r '=))
     67  (define %+ (r '+))
     68  (define %i (r 'i))
    6169  (define %compare (r 'compare))
    6270  (define %cond (r 'cond))
     
    118126                    ,@(process-match `(,%car ,%temp) (car pattern))
    119127                    ,@(process-match `(,%cdr ,%temp) (cdr pattern))))))
     128          ((vector? pattern)
     129           (process-vector-match input pattern))
    120130          ((or (null? pattern) (boolean? pattern) (char? pattern))
    121131           `((,%eq? ,input ',pattern)))
     
    131141                    (,%and (,%pair? ,%l)
    132142                           (,%loop (,%cdr ,%l)))))))))
     143
     144  (define (process-vector-match input pattern)
     145    (let* ((len (vector-length pattern))
     146           (segment? (and (>= len 2)
     147                          (memq (vector-ref pattern (- len 1))
     148                                indicators-for-zero-or-more))))
     149      `((,%let ((,%temp ,input))
     150         (,%and (,%vector? ,%temp)
     151                ,(if segment?
     152                     `(,%>= (,%vector-length ,%temp) ,(- len 2))
     153                     `(,%= (,%vector-length ,%temp) ,len))
     154                ,@(let lp ((i 0))
     155                    (cond
     156                     ((>= i len)
     157                      '())
     158                     ((and (= i (- len 2)) segment?)
     159                      `((,%let ,%loop ((,%i ,i))
     160                           (,%or (,%>= ,%i ,len)
     161                                 (,%and ,@(process-match
     162                                           `(,%vector-ref ,%temp ,%i)
     163                                           (vector-ref pattern (- len 2)))
     164                                        (,%loop (,%+ ,%i 1)))))))
     165                     (else
     166                      (append (process-match `(,%vector-ref ,%temp ,i)
     167                                             (vector-ref pattern i))
     168                              (lp (+ i 1)))))))))))
    133169
    134170  ; Generate code to take apart the input expression
     
    151187           (append (process-pattern (car pattern) `(,%car ,path) mapit)
    152188                   (process-pattern (cdr pattern) `(,%cdr ,path) mapit)))
     189          ((vector? pattern)
     190           (let* ((len (vector-length pattern))
     191                  (segment? (and (>= len 2)
     192                                 (memq (vector-ref pattern (- len 1))
     193                                       indicators-for-zero-or-more))))
     194             (if segment?
     195                 (process-pattern (vector->list pattern)
     196                                  `(,%vector->list ,path)
     197                                  mapit)
     198                 (let lp ((i 0))
     199                   (cond
     200                    ((>= i len)
     201                     '())
     202                    (else
     203                     (append (process-pattern (vector-ref pattern i)
     204                                              `(,%vector-ref ,path ,i)
     205                                              mapit)
     206                             (lp (+ i 1)))))))))
    153207          (else '())))
    154208
     
    207261           (meta-variables (car pattern) dim
    208262                           (meta-variables (cdr pattern) dim vars)))
     263          ((vector? pattern)
     264           (meta-variables (vector->list pattern) dim vars))
    209265          (else vars)))
    210266
     
    228284                                (free-meta-variables (cdr template)
    229285                                                     dim env free)))
     286          ((vector? template)
     287           (free-meta-variables (vector->list template) dim env free))
    230288          (else free)))
    231289
Note: See TracChangeset for help on using the changeset viewer.