PasteRack.org
Paste # 5017
2021-04-05 15:24:16

Fork as a new paste.

Paste viewed 242 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. (define-syntax bup
  14.   (syntax-rules ()
  15.     [(_ x (a ...))
  16.        (a ... x)]
  17.     [(_ x (a ...) b ...)
  18.        (a ... (map (λ (v) (bup v b ...)) x))] ))
  19.  
  20. (define-syntax (wup stx)
  21.   (let ((grps (split-ups (drop (syntax-e stx) 2))))
  22.   (syntax-case stx (up)
  23.     [(_ x a ...)
  24.        #`(bup x #,@grps) ])))
  25.  
  26. (define (norm mat)
  27.   (wup mat apply max up apply + up abs))
  28.  
  29. (norm '((1 2 3) (4 5 6) (7 8 9)))

=>

24