PasteRack.org
Paste # 31923
2019-06-08 21:41:56

Forked from paste # 16744.

Fork as a new paste.

Paste viewed 402 times.


Embed:

  1. #lang racket
  2.  
  3. (require syntax/srcloc (for-syntax syntax/parse))
  4.  
  5. (define-struct cfg (srcloc expr) #:transparent)
  6.  
  7. (define-syntax (config stx)
  8.   (syntax-parse stx
  9.     [(_ e:expr)
  10.      #'(cfg-with-srclocs (quasiquote e) #'e)]))
  11.  
  12. (define (cfg-with-srclocs expr stx)
  13.   (if (list? expr)
  14.       (let* [(stx-list (syntax-e stx))
  15.              (config-list (map cfg-with-srclocs expr stx-list))]
  16.         (cfg (build-source-location stx) config-list))
  17.       (cfg (build-source-location stx) expr)))
  18.  
  19. (define x 5)
  20. (pretty-print (config (foo bar (baz (quux (zot ,(+ x 5)))))))

=>

(cfg

 (srcloc 'eval 5 0 5 1)

 (list

  (cfg (srcloc 'eval 5 0 5 1) 'foo)

  (cfg (srcloc 'eval 5 0 5 1) 'bar)

  (cfg

   (srcloc 'eval 5 0 5 1)

   (list

    (cfg (srcloc 'eval 5 0 5 1) 'baz)

    (cfg

     (srcloc 'eval 5 0 5 1)

     (list

      (cfg (srcloc 'eval 5 0 5 1) 'quux)

      (cfg

       (srcloc 'eval 5 0 5 1)

       (list

        (cfg (srcloc 'eval 5 0 5 1) 'zot)

        (cfg (srcloc 'eval 5 0 5 1) 10)))))))))