[<<][staapl][>>][..]
Thu Apr 9 20:12:44 CEST 2009

transposes

Loop transformations.. These are really just about permutations of
indices.

Anyways..  I'd like to transform this:


(((a 1) (b 2)) ((c 3) (d 4)))

=> (((a b) (c d))
    ((1 2) (3 4)))


Which is the (outer) index transpose (i j k) -> (k i j)

Fixed. Transposition is really best handled with syntax-case
ellipsis.

box> (disassembler-body #'foo #'(s k) #'(((118  7) (s  1) (3 2)) ((k 12))))
(lambda (temp54 temp55)
  (let-values (((temp56 s temp57) (disassemble/values '(7 1 2) temp54))
               ((k) (disassemble/values '(12) temp55)))
    (and (= temp57 3) (= temp56 118) (list 'foo s k))))


The macro:


(define-syntax-rule (push! stack x) (set! stack (cons x stack)))
(define-syntax-rule (lambda* formals . body) (lambda (a) (apply (lambda formals . body) a)))
(define (generate-temp) (car (generate-temporaries #'(#f))))

(define (disassembler-body opcode formals body-stx)
  (define literals '())
  (define (fix-names! stx)
    (for/list ((n (syntax->list stx))
               (i (in-naturals)))
      (let ((_n (syntax-e n)))
        (if (number? _n)
          (let ((__n (generate-temp)))
            (push! literals (list __n _n))
            __n)
          n))))
  (let ((ws (generate-temporaries body-stx)))
    (syntax-case (list ws body-stx) ()
      (((w ...)  (((name bits) ...) ...))
       #`(lambda (w ...)
           (let-values
               ;; Transpose it
               #,(for/list ((stx (syntax->list #'((w (name ...) (bits ...)) ...))))
                   (syntax-case stx ()
                     ((w ns bs)
                      #`(#,(fix-names! #'ns)
                         (disassemble/values 'bs w)))))
             (and
              #,@(map (lambda* (name value)
                               #`(= #,name #,value))
                      literals)
              (list '#,opcode #,@formals))))))))


Looks like i'm getting the hang of combining the highlevel ellipsis
based pattern matching where possible with lowlevel macros where
needed.


[Reply][About]
[<<][staapl][>>][..]