(use-for-syntax matchable)
(define-syntax lcond
  (ir-macro-transformer
   (lambda (e _inj cmp)
     (apply
      (lambda [#!rest forms]
        (letrec [(let? (lambda [f] (cmp f 'let:)))
                 (let*? (lambda [f] (cmp f 'let*:)))
                 (and-let*? (lambda [f] (cmp f 'and-let*:)))
                 (receive? (lambda [f] (cmp f 'receive:)))
                 (R (lambda [fs]
                      (if (pair? fs)
                          (match fs
                            [((and l (or (? let?) (? let*?) (? and-let*?)))
                              bindings rest ...)
                             `((else
                                (,(cond
                                   [(let? l) 'let]
                                   [(let*? l)'let*]
                                   [(and-let*? l) 'and-let*]) ,bindings
                                   (cond
                                    ,@(R rest)))))]
                            [((? receive?) ((and vars ((? symbol?) ...)) form) . rest)
                             `((else
                                (receive ,vars ,form (cond ,@(R rest)))))]
                            [(form rest ...)
                             (cons form (R rest))])
                          '())))]
          `(cond
            ,@(R forms))))
      (cdr e)))))

(define (foo a)
  (lcond
    [(null? a) 'null]
    [(not (pair? a)) 'not-a-pair]
    let: [(ca (car a))]
    [(fixnum? ca) (+ ca (cdr a))]
    receive: [(x y) (bar ca)]
    [else
     (string-append x y)]))

(define (bar p) (values (car p) (cdr p)))

(print (foo '())) ; -> null
(print (foo 1)) ; -> not-a-pair
(print (foo '(1 . 2))) ; -> 3
(print (foo '(("a" . "b")))) -> "ab"

(def-ir-macro lc
  (doc: ":=    - let"
        ":=*   - let*"
        ":=?   - and-let*"
        "! exp - Evaluate exp"
        "when / unless / else")
  pps:
  [#!rest args1]
  (define (let-assign? x) (or (c =: x) (c ':= x)))
  (define (assign? x) (or (let-assign? x)
                          (c =*: x) (c ':=* x)))
  (define (maybe-assign? x) (or (c =?: x) (c ':=? x)))
  (define (when? x) (c 'when x))
  (define (when-let? x) (c 'when-let x))
  (define (unless? x) (c 'unless x))
  (define (R args)
    (match args
      ;; var := exp
      [((? symbol? var) (? assign?) exp rest ...)
       (let lp ([assigns (list `[,var ,exp])]
                [res rest])
         (match res
           [((? symbol? var) (? let-assign?) exp rest ...)
            (lp (cons `[,var ,exp] assigns) rest)]
           [_
            `(let (,@(reverse assigns))
               ,(R rest))]))]
      ;; - invalid var
      [(var (? assign?) exp res ...)
       (error 'lc (format "  (:=) expected variable, got `~s'" (strip-syntax var)))]
      ;; - lone :=
      [((? assign? a) rest ...)
       (error 'lc (format "unexpected ~a" (strip-syntax a)) rest: (strip-syntax rest))]
      ;; var :=? exp (and-let)
      [((? symbol? var) (? maybe-assign?) exp rest ...)
       `(and-let* ([,var ,exp])
          ,(R rest))]
      ;; - invalid var
      [(var (? maybe-assign?) exp rest ...)
       (error 'lc (format "  (:=?) expected variable, got `~s'" (strip-syntax var)))]
      ;; - lone :=?
      [((? maybe-assign? a) rest ...)
       (error 'lc (format "unexpected ~a" (strip-syntax a)) tail: (strip-syntax rest))]
      ;; [else exp ...]
      [(((? (cut c 'else <>)) body ...))
       `(begin ,@body)]
      [(((? (cut c 'else <>)) body ...) . rest)
       (error 'lc "expressions after else" (strip-syntax rest))]
      ;; ! exp (implicit else)
      [((? (cut c '! <>)) exp)
       exp]
      ;; ! exp rest ...
      [((? (cut c '! <>)) exp rest ...)
       `(begin ,exp
               ,(R rest))]
      ;; [when pred body ...]
      [(((? when?) pred body ...) rest ...)
       `(if ,pred
            (begin ,@body)
            ,(R rest))]
      ;; [when-let [var exp] body ...]
      [(((? when-let?) [(? symbol? var) pred] body ...) rest ...)
       `(let ([tmp ,pred])
          (if tmp
              (let ([,var tmp])
                ,@body)
              ,(R rest)))]
      ;; [unless pred body ...]
      [(((? unless?) pred body ...) rest ...)
       `(if (not ,pred)
            (begin ,@body)
            ,(R rest))]
      ;; [pred body ...]
      ;; [([pred then-body ...] rest ...)
      ;;  `(if ,pred
      ;;       (begin ,@then-body)
      ;;       ,(R rest))]
      [() (error 'lc "missing else")]
      [_ (error 'lc "unexpected expression" (strip-syntax args))]))
  (R args1))

(print "********** eval")

(lc foo := 1
    ! (print 1 foo)
    bar := (+ foo 1)
    baz :=* (+ 1 bar)
    [when (< 3 baz)
      #t]
    [when (< 3 baz)
      (print "baz yo1" baz)]
    [when-let [a (< 3 baz)]
              (print "baz yo2" baz a)]
    [unless (< 3 baz)
      (print "baz yo2" baz)]
    quux :=? (= 2 baz)
    ! (println baz: baz)
    ! (println "foo1 =" foo)
    ! (println "bar =" bar))

;; ==>
;; (let ((foo 1))
;;   (begin
;;     (print 1 foo)
;;     (let ((bar (+ foo 1)))
;;       (let ((baz (+ 1 bar)))
;;         (if (< 3 baz)
;;           (begin #t)
;;           (if (< 3 baz)
;;             (begin (print "baz yo1" baz))
;;             (let ((tmp (< 3 baz)))
;;               (if tmp
;;                 (let ((a tmp)) (print "baz yo2" baz a))
;;                 (if (not (< 3 baz))
;;                   (begin (print "baz yo3" baz))
;;                   (and-let* ((quux (= 2 baz)))
;;                     (begin
;;                       (println baz: baz)
;;                       (begin
;;                         (println "foo1 =" foo)
;;                         (println "bar =" bar)))))))))))))
;; ********** eval
;; 11
;; baz yo3