(defconst test-grammar
  (smie-prec2->grammar
   (smie-bnf->prec2
    '((id)

      (inst (id)
	    ("begin" bblock "end"))

      (bblock ;;(id "(" funargs ")" "\"" id "\"" insts)
	      (id "(" funargs ")" "->" funargs "\"" id "\"" insts)
	      )
      
      (insts (inst)
	     (insts ";" insts))

      (funargs (id)
               (funargs "," funargs)))

    '((assoc ";" ",")
      ;(assoc ",")
      ))))

(defun test-smie-rules-verbose (kind token)
  (message (format "point=%s kind=%s token=%s parent=%s"
			 (point) kind token
			 (if (boundp 'smie--parent)
			     smie--parent
			   'none)))
  (let ((res (test-smie-rules kind token)))
    (message (format "-> %s" res))
    res))

(defun test-smie-rules (kind token)
  (pcase (cons kind token)
    (`(:elem . basic)
     4)
    (`(:elem . args)
     0)
   (`(:before . "->")
     (smie-rule-parent 4))
    (`(:before . "\"")
     (save-excursion
       (backward-up-list)
       ('column . (+ (current-column) 4))))
    ;; (`(:after . "\"")
    ;;  0)

    (`(:after . ")")
     (smie-rule-parent 4))
    (`(:after . ";")
     0)
    (`(:before . ";")
     (smie-rule-parent))))

(defconst test-keywords-regexp
  (regexp-opt '(";" "," "::" "begin" "end")))

(defun test-smie-forward-token ()
  (forward-comment (point-max))
  (cond
   ((looking-at test-keywords-regexp)
    (goto-char (match-end 0))
    (match-string-no-properties 0))
   (t (buffer-substring-no-properties
       (point)
       (progn (skip-syntax-forward "w_")
	      (point))))))

(defun test-smie-backward-token ()
  (forward-comment (- (point)))
  (cond
   ((looking-back test-keywords-regexp (- (point) 25) t)
    (goto-char (match-beginning 0))
    (match-string-no-properties 0))
   (t (buffer-substring-no-properties
       (point)
       (progn (skip-syntax-backward "w_")
	      (point))))))

(define-derived-mode test-mode
  prog-mode
  "Test"
  "Test mode"
  (setq-local comment-start "/* ")
  (setq-local comment-end " */")
  (smie-setup
   test-grammar
   #'test-smie-rules-verbose
   :forward-token #'test-smie-forward-token
   :backward-token #'test-smie-backward-token))