#lang racket
(require (for-syntax syntax/parse))

(define-syntax (loop stx)
  (define it (datum->syntax #`k `it))

  (define-syntax-class loop
    (pattern (_ v:variable-clause ... m:main-clause ...)
             #:with bindings #`(v.bindings ...)
             #:with actions #`(m.action ...)
             #:with vars #`(m.var ...)
             #:with returns #`(m.return ...)))

  (define-syntax-class compound-form
    (pattern (e:expr ...)))

  (define-splicing-syntax-class variable-clause
    (pattern (~seq c:for-as-clause)
             #:with bindings #`c.bindings))

  (define-splicing-syntax-class main-clause
    (pattern (~seq c:unconditional)
             #:with action #`void
             #:with var #`()
             #:with return #`())
    (pattern (~seq c:list-accumulation)
             #:with action #`c.accum
             #:with var #`c.var
             #:with return #`(#,it))
    (pattern (~seq c:conditional)
             #:with action #`#f
             #:with var #`#f
             #:with return #`#f))

  (define-splicing-syntax-class unconditional
    (pattern (~seq (~datum do) ~! f:expr)
             #:with action #`f)
    (pattern (~seq (~datum return) ~! f:expr)
             #:with action #`()))

  (define-syntax-class accumulation-target
    (pattern t:expr)
    (pattern (~datum it)
             #:with t it))

  (define-syntax-class list-accumulation-type
    (pattern (~datum collect))
    (pattern (~datum append)))

  (define-splicing-syntax-class list-accumulation
    (pattern (~seq type:list-accumulation-type ~! target:accumulation-target (~optional (~seq (~datum into) ~! v:id)))
             #:with accum (with-syntax ([var (if (attribute v) #`v it)])
                            (syntax-parse #`type
                              [(~datum collect) #`(set! var (cons target var))]
                              [(~datum append) #`(set! var (append target var))]))
             #:with var (if (attribute v) #`v it)))

  (define-splicing-syntax-class conditional
    (pattern (~seq (~datum when) ~! f:expr c:selectable-clause (~seq (~datum and) ~! cs:selectable-clause) ...)))

  (define-splicing-syntax-class selectable-clause
    (pattern c:unconditional)
    (pattern c:conditional)
    (pattern c:list-accumulation))

  (define-splicing-syntax-class termination-test
    (pattern (~seq (~datum while) ~! f:expr)))

  (define-splicing-syntax-class for-as-clause
    (pattern (~seq (~or (~datum for) (~datum as)) ~! c:for-as-subclause (~seq (~datum and) ~! cs:for-as-subclause) ...)
             #:with bindings #`(c.form cs.form ...)))

  (define-splicing-syntax-class for-as-subclause
    (pattern (~seq c:for-as-in-list)
             #:with form #`(c.var (in-list c.f)))
    (pattern (~seq c:for-as-across)
             #:with form #`(c.var (in-vector c.f))))

  (define-splicing-syntax-class for-as-in-list
    (pattern (~seq var:id (~datum in) ~! f:expr)))

  (define-splicing-syntax-class for-as-across
    (pattern (~seq var:id (~datum across) ~! f:expr)))

  (syntax-parse stx
    [l:loop
     #`(let-syntax ([helper
                     (λ (stx)
                       (syntax-case stx ()
                         [(_ (((bvar expr) (... ...))) (action) (var))
                          #`(let ([var `()])
                              (for* ([bvar expr] (... ...)) action)
                              var)]
                         [(_ (((bvar expr) (... ...)) ((bvars exprs) (... ...)) (... ...))
                             (actions (... ...) action)
                             (vars (... ...) var))
                          #`(let ([var `()])
                              (for* ([bvar expr] (... ...))
                                action
                                (#,(datum->syntax stx `helper) (((bvars exprs) (... ...)) (... ...))
                                                               (actions (... ...))
                                                               (vars (... ...))))
                              var)]))])
         (helper l.bindings l.actions l.vars))]))

(define lst (loop for x in (list 1 2 3 4 5) and y across (vector 6 7 8 9 10) collect `(,x ,y)))