PasteRack.org
Paste # 28493
2021-04-05 15:25:54

Fork as a new paste.

Paste viewed 162 times.


Embed:

  1. #lang racket
  2. (require (for-syntax racket/list))
  3.  
  4. (begin-for-syntax
  5.   (define (isup x) (if (identifier? x) (eq? (syntax-e x) 'up) #f))
  6.   (define (split-ups lst)
  7.     (let ((pos (index-where lst isup)))
  8.       (if pos
  9.           (let-values ([(a b) (split-at lst pos)])
  10.             (cons a (split-ups (cdr b))))
  11.           (list lst))))
  12. )
  13.  
  14. (define-syntax bup
  15.   (syntax-rules ()
  16.     [(_ x (a ...))
  17.        (a ... x)]
  18.     [(_ x (a ...) b ...)
  19.        (a ... (map (λ (v) (bup v b ...)) x))] ))
  20.  
  21. (define-syntax (wup stx)
  22.   (let ((grps (split-ups (drop (syntax-e stx) 2))))
  23.   (syntax-case stx ()
  24.     [(_ x a ...)
  25.        #`(bup x #,@grps) ])))
  26.  
  27. (define (norm mat)
  28.   (wup mat apply max up apply + up abs))
  29.  
  30. (norm '((1 2 3) (4 5 6) (7 8 9)))

=>

24