+;;; sweep-tests.el --- ERT suite for sweep -*- lexical-binding:t -*-
+
(ert-deftest lists:member/2 ()
"Tests calling the Prolog predicate permutation/2 from Elisp."
(should (equal (sweep-open-query "user" "lists" "member" (list 1 2 3) t) t))
(should (equal (sweep-next-solution) (list '! 1 nil (list "foo" "bar") 3.14)))
(should (equal (sweep-next-solution) nil))
(should (equal (sweep-cut-query) t)))
+
+
+(defun sweep-test-indentation (given expected)
+ (with-temp-buffer
+ (sweep-mode)
+ (insert given)
+ (indent-region-line-by-line (point-min) (point-max))
+ (should (string= (buffer-substring-no-properties (point-min) (point-max))
+ expected))))
+
+(ert-deftest indentation ()
+ "Tests indentation rules."
+ (sweep-test-indentation
+ "
+colourise_declaration(Module:PI, _, TB,
+ term_position(_,_,QF,QT,[PM,PG])) :-
+ atom(Module), nonvar(PI), PI = Name/Arity,
+ !, % partial predicate indicators
+ colourise_module(Module, TB, PM),
+ colour_item(functor, TB, QF-QT),
+ ( (var(Name) ; atom(Name)),
+ (var(Arity) ; integer(Arity),
+ Arity >= 0)
+ -> colourise_term_arg(PI, TB, PG)
+ ; colour_item(type_error(predicate_indicator), TB, PG)
+ ).
+"
+ "
+colourise_declaration(Module:PI, _, TB,
+ term_position(_,_,QF,QT,[PM,PG])) :-
+ atom(Module), nonvar(PI), PI = Name/Arity,
+ !, % partial predicate indicators
+ colourise_module(Module, TB, PM),
+ colour_item(functor, TB, QF-QT),
+ ( (var(Name) ; atom(Name)),
+ (var(Arity) ; integer(Arity),
+ Arity >= 0)
+ -> colourise_term_arg(PI, TB, PG)
+ ; colour_item(type_error(predicate_indicator), TB, PG)
+ ).
+")
+ (sweep-test-indentation
+ "
+A is 1 * 2 + 3 *
+4.
+"
+ "
+A is 1 * 2 + 3 *
+ 4.
+")
+ (sweep-test-indentation
+ "
+A is 1 * 2 ^ 3 *
+4.
+"
+ "
+A is 1 * 2 ^ 3 *
+ 4.
+")
+ (sweep-test-indentation
+ "
+( if
+ -> ( iff1, iff2, iff3,
+iff4
+-> thenn
+; elsee
+)
+ ; else
+ )
+"
+ "
+( if
+-> ( iff1, iff2, iff3,
+ iff4
+ -> thenn
+ ; elsee
+ )
+; else
+)
+")
+ (sweep-test-indentation
+ "
+( if
+ -> ( iff
+-> thenn
+; elsee
+)
+ ; else
+ )
+"
+ "
+( if
+-> ( iff
+ -> thenn
+ ; elsee
+ )
+; else
+)
+")
+ (sweep-test-indentation
+ "
+( if
+ ; then
+ -> else
+ )
+"
+ "
+( if
+; then
+-> else
+)
+")
+ (sweep-test-indentation
+ "
+asserta( foo(bar, baz) :-
+true).
+"
+ "
+asserta( foo(bar, baz) :-
+ true).
+")
+ (sweep-test-indentation
+ "
+foo(bar, baz) :-
+true.
+"
+ "
+foo(bar, baz) :-
+ true.
+")
+
+ (sweep-test-indentation
+ "
+:- multifile
+foo/2.
+"
+ "
+:- multifile
+ foo/2.
+")
+
+ (sweep-test-indentation
+ "
+ %%%%
+ %%%%
+"
+ "
+ %%%%
+ %%%%
+")
+
+ (sweep-test-indentation
+ "
+(
+foo"
+ "
+(
+ foo")
+ (sweep-test-indentation
+ "
+functor(
+foo"
+ "
+functor(
+ foo")
+ )
+
+;;; sweep-tests.el ends here
;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
;; Keywords: prolog languages extensions
;; URL: https://git.sr.ht/~eshel/sweep
-;; Package-Version: 0.2.1
+;; Package-Version: 0.3.0
;; Package-Requires: ((emacs "28"))
;; This file is NOT part of GNU Emacs.
map)
"Keymap for `sweep-mode'.")
-(defun sweep-indent-line ()
- (interactive)
- (when-let ((pos (- (point-max) (point)))
- (indent (sweep-indent-line-indentation (point))))
- (back-to-indentation)
- (beginning-of-line)
- (combine-after-change-calls
- (delete-horizontal-space)
- (insert (make-string indent ? )))
- (when (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
- t))
-
-(defun sweep-indent-line-indentation (point)
- (save-match-data
+(defun sweep-token-boundaries (&optional pos)
+ (let ((point (or pos (point))))
(save-excursion
- (beginning-of-line)
- (re-search-backward (rx bol (zero-or-more (not "\n")) graph (zero-or-more (not "\n"))) nil t)
- (cond
- ((sweep-indent-line-ends-with-comment-or-string-p) 0)
- ((sweep-indent-line-ends-with-fullstop-p) 0)
- ((sweep-indent-line-ends-with-if))
- ((sweep-indent-line-ends-with-then point))
- ((sweep-indent-line-ends-with-else point))
- ((sweep-indent-line-ends-with-arg point))
- ((sweep-indent-line-ends-with-neck-p) 4)
- ((sweep-indent-line-ends-with-prefix-operator))
- (t (sweep-indent-line-fallback))))))
-
-(defun sweep-indent-line-fallback ()
- (save-excursion
- (when-let ((open (nth 1 (syntax-ppss))))
- (goto-char open))
- (back-to-indentation)
- (current-column)))
+ (goto-char point)
+ (unless (eobp)
+ (let ((beg (point))
+ (syn (char-syntax (char-after))))
+ (cond
+ ((or (= syn ?w) (= syn ?_))
+ (skip-syntax-forward "w_")
+ (if (= (char-syntax (char-after)) ?\()
+ (progn
+ (forward-char)
+ (list 'functor beg (point)))
+ (list 'symbol beg (point))))
+ ((= syn ?\")
+ (forward-char)
+ (while (and (not (eobp)) (nth 3 (syntax-ppss)))
+ (forward-char))
+ (list 'string beg (point)))
+ ((= syn ?.)
+ (skip-syntax-forward ".")
+ (list 'operator beg (point)))
+ ((= syn ?\()
+ (list 'open beg (point)))
+ ((= syn ?\))
+ (list 'close beg (point)))
+ ((= syn ?>) nil)
+ (t (list 'else beg (point)))))))))
+
+(defun sweep-last-token-boundaries (&optional pos)
+ (let ((point (or pos (point)))
+ (go t))
+ (save-excursion
+ (goto-char point)
+ (while (and (not (bobp)) go)
+ (skip-chars-backward " \t\n")
+ (unless (bobp)
+ (forward-char -1)
+ (if (nth 4 (syntax-ppss))
+ (goto-char (nth 8 (syntax-ppss)))
+ (setq go nil))))
+ (unless (bobp)
+ (let ((end (1+ (point)))
+ (syn (char-syntax (char-after))))
+ (cond
+ ((or (= syn ?w) (= syn ?_))
+ (skip-syntax-backward "w_")
+ (list 'symbol (point) end))
+ ((= syn ?\")
+ (list 'string (nth 8 (syntax-ppss)) end))
+ ((and (= syn ?\()
+ (or (= (char-syntax (char-before)) ?w)
+ (= (char-syntax (char-before)) ?_)))
+ (skip-syntax-backward "w_")
+ (list 'functor (point) end))
+ ((= syn ?.)
+ (skip-syntax-backward ".")
+ (list 'operator (point) end))
+ ((= syn ?\()
+ (list 'open (1- end) end))
+ ((= syn ?\))
+ (list 'close (1- end) end))
+ (t (list 'else (1- end) end))))))))
+
+(defun sweep-backward-term (pre)
+ (pcase (sweep-last-token-boundaries)
+ ('nil nil)
+ (`(open,_ ,_) nil)
+ (`(functor,_ ,_) nil)
+ (`(operator ,obeg ,oend)
+ (unless (and (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (if-let ((opre (sweep-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (when (<= opre pre)
+ (goto-char obeg)
+ (sweep-backward-term pre))
+ (if-let ((ppre (sweep-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (when (<= ppre pre)
+ (goto-char obeg)
+ (sweep-backward-term pre))
+ (goto-char obeg)
+ (sweep-backward-term pre)))))
+ (`(symbol ,obeg ,oend)
+ (if-let ((opre (sweep-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (when (<= opre pre)
+ (goto-char obeg)
+ (sweep-backward-term pre))
+ (if-let ((ppre (sweep-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (when (<= ppre pre)
+ (goto-char obeg)
+ (sweep-backward-term pre))
+ (goto-char obeg)
+ (sweep-backward-term pre))))
+ (`(close ,lbeg ,_lend)
+ (goto-char (nth 1 (syntax-ppss lbeg)))
+ (when (or (= (char-syntax (char-before)) ?w)
+ (= (char-syntax (char-before)) ?_))
+ (skip-syntax-backward "w_"))
+ (sweep-backward-term pre))
+ (`(,_ ,lbeg ,_)
+ (goto-char lbeg)
+ (sweep-backward-term pre))))
+
+(defun sweep-op-suffix-precedence (token)
+ (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweep-next-solution))
+ (det (car sol))
+ (fix (cadr sol))
+ (pre (cddr sol)))
+ (if (member fix '("xf" "yf"))
+ (setq res pre go nil)
+ (when (eq '! det)
+ (setq go nil)))
+ (setq go nil)))
+ (sweep-close-query)
+ res))
+
+(defun sweep-op-prefix-precedence (token)
+ (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweep-next-solution))
+ (det (car sol))
+ (fix (cadr sol))
+ (pre (cddr sol)))
+ (if (member fix '("fx" "fy"))
+ (setq res pre go nil)
+ (when (eq '! det)
+ (setq go nil)))
+ (setq go nil)))
+ (sweep-close-query)
+ res))
+
+(defun sweep-op-infix-precedence (token)
+ (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweep-next-solution))
+ (det (car sol))
+ (fix (cadr sol))
+ (pre (cddr sol)))
+ (if (member fix '("xfx" "xfy" "yfx"))
+ (setq res pre go nil)
+ (when (eq '! det)
+ (setq go nil)))
+ (setq go nil)))
+ (sweep-close-query)
+ res))
-(defun sweep-indent-line-ends-with-prefix-operator ()
- (save-excursion
- (end-of-line)
- (skip-syntax-backward " ")
- (when-let ((symbol (symbol-at-point)))
- (when (member (symbol-name symbol) (sweep-prefix-operators))
- (skip-syntax-backward "w_")
- (+ (current-column) 4)))))
-
-(defun sweep-indent-line-ends-with-if ()
+(defun sweep-indent-line-after-functor (fbeg _fend)
(save-excursion
- (end-of-line)
- (when-let ((start-of-ite (nth 1 (syntax-ppss))))
- (when (<= (line-beginning-position) start-of-ite)
- (goto-char start-of-ite)
- (let ((col (current-column)))
- (when (looking-at-p (rx "( "))
- col))))))
-
-(defun sweep-indent-line-ends-with-then (point)
- (save-excursion
- (when-let ((orig (save-mark-and-excursion
- (goto-char point)
- (back-to-indentation)
- (nth 1 (syntax-ppss))))
- (start-of-ite (nth 1 (syntax-ppss))))
- (when (= start-of-ite orig)
- (back-to-indentation)
- (let ((col (current-column)))
- (when (looking-at-p (rx "-> "))
- col))))))
-
-(defun sweep-indent-line-ends-with-else (point)
- (save-excursion
- (when-let ((orig (save-mark-and-excursion
- (goto-char point)
- (back-to-indentation)
- (nth 1 (syntax-ppss))))
- (start-of-ite (nth 1 (syntax-ppss))))
- (when (= start-of-ite orig)
- (back-to-indentation)
- (let ((col (current-column)))
- (when (looking-at-p (rx "; "))
- col))))))
-
-(defun sweep-indent-line-ends-with-arg (point)
+ (goto-char fbeg)
+ (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-open (fbeg _fend)
(save-excursion
- (end-of-line)
- (when-let ((orig (save-mark-and-excursion
- (goto-char point)
- (back-to-indentation)
- (nth 1 (syntax-ppss))))
- (start-of-ite (nth 1 (syntax-ppss))))
- (when (= start-of-ite orig)
- (goto-char start-of-ite)
- (forward-char 1)
- (skip-syntax-forward " ")
- (current-column)))))
-
-(defun sweep-indent-line-ends-with-neck-p ()
+ (goto-char fbeg)
+ (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-prefix (fbeg _fend _pre)
(save-excursion
- (looking-at-p (rx (zero-or-more (not "\n"))
- (or ":-" "=>" "-->")
- (zero-or-more blank)
- eol))))
+ (goto-char fbeg)
+ (+ (current-column) 4)))
+
+(defun sweep-indent-line-after-term ()
+ (if-let ((open (nth 1 (syntax-ppss))))
+ (save-excursion
+ (goto-char open)
+ (current-column))
+ 'noindent))
-(defun sweep-indent-line-ends-with-comment-or-string-p ()
+(defun sweep-indent-line-after-neck (fbeg _fend)
(save-excursion
- (end-of-line)
- (when-let ((beg (nth 8 (syntax-ppss))))
- (<= beg (line-beginning-position)))))
+ (goto-char fbeg)
+ (sweep-backward-term 1200)
+ (+ (current-column) 4)))
-(defun sweep-indent-line-ends-with-fullstop-p ()
+(defun sweep-indent-line-after-infix (fbeg _fend pre)
(save-excursion
- (end-of-line)
- (unless (nth 8 (syntax-ppss))
- (= ?. (preceding-char)))))
+ (goto-char fbeg)
+ (let ((lim (or (nth 1 (syntax-ppss)) (point-min)))
+ (cur (point))
+ (go t))
+ (while go
+ (setq cur (point))
+ (sweep-backward-term pre)
+ (when (< (point) lim)
+ (goto-char cur))
+ (when (= (point) cur)
+ (setq go nil))))
+ (current-column)))
+
+(defun sweep-indent-line ()
+ (interactive)
+ (let ((pos (- (point-max) (point))))
+ (back-to-indentation)
+ (let ((indent (if (nth 8 (syntax-ppss))
+ 'noindent
+ (pcase (sweep-last-token-boundaries)
+ ('nil 'noindent)
+ (`(functor ,lbeg ,lend)
+ (sweep-indent-line-after-functor lbeg lend))
+ (`(open ,lbeg ,lend)
+ (sweep-indent-line-after-open lbeg lend))
+ (`(symbol ,lbeg ,lend)
+ (let ((sym (buffer-substring-no-properties lbeg lend)))
+ (cond
+ ((pcase (sweep-op-prefix-precedence sym)
+ ('nil (sweep-indent-line-after-term))
+ (pre (sweep-indent-line-after-prefix lbeg lend pre)))))))
+ (`(operator ,lbeg ,lend)
+ (let ((op (buffer-substring-no-properties lbeg lend)))
+ (cond
+ ((string= op ".") 'noindent)
+ ((pcase (sweep-op-infix-precedence op)
+ ('nil nil)
+ (1200 (sweep-indent-line-after-neck lbeg lend))
+ (pre (sweep-indent-line-after-infix lbeg lend pre))))
+ ((pcase (sweep-op-prefix-precedence op)
+ ('nil nil)
+ (pre (sweep-indent-line-after-prefix lbeg lend pre)))))))
+ (`(,_ltyp ,_lbeg ,_lend)
+ (sweep-indent-line-after-term))))))
+ (when (numberp indent)
+ (unless (= indent (current-column))
+ (combine-after-change-calls
+ (delete-horizontal-space)
+ (insert (make-string indent ? )))))
+ (when (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos)))
+ indent)))
(defun sweep-syntax-propertize (start end)
(goto-char start)
(funcall
(syntax-propertize-rules
((rx bow (group-n 1 "0'" anychar))
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "w"))))
+ ((rx (group-n 1 "!"))
(1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
(string-to-syntax "w")))))
start end)))
projects / sweep.git / commitdiff