(yacc:define-parser dsl-parser
  (:start-symbol all)
  (:terminals (number symbol identifier none
               + - / * = < > equal expt
               left-paren right-paren
               left-square right-square
               <- ->
               define strategy
               if then else cond
               let in
               comma))
  (:precedence ((:left <-)
                (:left define strategy define-strategy)
                (:left ->)
                (:left anonymous)
                (:left expression)
                (:left left-paren right-paren)
                (:left comma)
                (:left funcall)
                (:left if cond)
                (:left cond-case)
                (:left square-list)
                (:left lambda-list)
                (:left begin)
                (:right expt)
                (:left = < > equal)
                (:left * /)
                (:left + -)
                (:left symbol number)))

  ;; (a, b, c)

  (lambda-list*
   (right-paren (constantly nil))
   (expression right-paren (lambda (a b) (declare (ignore b)) (list a)))
   (expression comma lambda-list* (lambda (a b c)
                                    (declare (ignore b))
                                    (cons a c))))
  (lambda-list
   (left-paren lambda-list* (lambda (a b)
                              (declare (ignore a))
                              b)))

  ;; [a, b, c]

  (square-list*
   (right-paren (constantly nil))
   (expression right-square (lambda (a b) (declare (ignore b)) (list a)))
   (expression comma square-list* (lambda (a b c)
                                    (declare (ignore b))
                                    (cons a c))))
  (square-list
   (left-square square-list* (lambda (a b)
                               (declare (ignore a))
                               b)))

  ;; a[b]
  ;; a[b -> c]

  (subarray
   (term left-square term -> term right-square
         (lambda (a b c d e f)
           (declare (ignore b d f))
           (list 'subarray a c e)))
   (term left-square term right-square
         (lambda (a b c d)
           (declare (ignore b d))
           (list 'aref a c))))

  ;; f(x, y, ...)

  (funcall
   (term lambda-list (lambda (a b)
                       (cons a b))))

  ;; define f(x, y, ...) x

  (define-body
   (define funcall expression))

  ;; strategy
  (define-strategy
   (strategy identifier parameter-list state-list anonymous
    (lambda (b c d e f)
      (declare (ignore b))
      (list 'define-strategy c d e f))))
  ;; foo = 4 -> options(4, 5, 6),
  ;; bar = 1.0 -> slider(1.0, 10.0)
  (parameter
   (identifier = term -> funcall
    (lambda (a b c d e)
      (declare (ignore b d))
      (list a c e))))
  (parameter-list
   (parameter comma parameter-list
              (lambda (a b c)
                (declare (ignore b))
                (cons a c)))
   (parameter #'list))
  ;; state1 = 2,
  ;; state2 = #false
  ;; [or]
  ;; none
  (state
   (identifier = term (lambda (a b c)
                        (declare (ignore b))
                        (list a c))))
  (state-list
   (none (constantly nil))
   (state comma state-list (lambda (a b c)
                             (declare (ignore b))
                             (cons a c)))
   (state #'list))


  ;; cond c1 -> v1, c2 -> v2, ... else -> ve

  (cond-case
   (else       -> expression (lambda (a b c)
                               (declare (ignore a b))
                               (list 't c)))
   (expression -> expression (lambda (a b c)
                               (declare (ignore b))
                               (list a c))))

  (cond-list
   (cond-case #'list)
   (cond-case comma cond-list (lambda (a b c)
                                (declare (ignore b))
                                (cons a c))))

  (cond-expr
   (cond cond-list #'cons))

  ;; (a, b, c)

  (begin
   (lambda-list (lambda (a) (cons 'progn a))))

  ;; (a, b, ...) -> a

  (anonymous
   (lambda-list -> expression
    (lambda (a b c)
      (declare (ignore b))
      (list 'lambda a c))))
  ;; let n1 = v1, n2 = v2, ... in x

  (let-bindings
   (identifier = expression
               (lambda (a b c)
                 (declare (ignore b))
                 (list (list a c))))
   (identifier = expression comma let-bindings
           (lambda (a b c d e)
             (declare (ignore b d))
             (cons (list a c) e))))
  (let-form
   (let let-bindings in expression
        (lambda (a b c d)
          (declare (ignore a c))
          (list 'let* b d))))

  (toplevel
   define-strategy
   define-body
   expression)

  (all
   (toplevel #'list)
   (toplevel all #'cons))

  (expression
   (identifier <- expression #'i2p)
   anonymous
   begin
   subarray
   let-form
   (expression = expression #'i2p)
   (expression < expression #'i2p)
   (expression > expression #'i2p)
   (expression equal expression #'i2p)
   (expression + expression #'i2p)
   (expression * expression #'i2p)
   (expression / expression #'i2p)
   (expression expt expression #'i2p)
   cond-expr
   (if expression then expression else expression
       (lambda (a b c d e f)
         (declare (ignore c e))
         (list a b d f)))
   funcall
   term)

  (term
   number
   symbol
   none
   identifier
   (square-list (lambda (a) (cons 'vector a)))
   (- term)
   (left-paren expression right-paren (lambda (a b c) (declare (ignore a c)) b))))