From 463f3b41ac6a17f6fe88f6c114aa849876bfcf4e Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Thu, 22 Jul 2021 17:35:34 +0000
Subject: Warn about singleton variables in clauses, as it is often a sign of a
 mis-spelling

---
 loader.pl | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

(limited to 'loader.pl')

diff --git a/loader.pl b/loader.pl
index 3d94566..9126c1f 100644
--- a/loader.pl
+++ b/loader.pl
@@ -19,17 +19,18 @@ load_module_from_file(File) :-
 	close(Stream).
 
 read_and_handle_terms(Stream, Module0, Module) :-
-	( read_one_term(Stream, Term)
-	-> handle_term(Term, Module0, Module1),
+	( read_one_term(Stream, Term, Singles)
+	-> handle_term(Term, Singles, Module0, Module1),
 	   read_and_handle_terms(Stream, Module1, Module)
 	; Module = Module0
 	).
 
-read_one_term(Stream, Term) :-
+read_one_term(Stream, Term, Singles) :-
 	consume_whitespace(Stream),
 	peek_char(Stream, NextCh),
 	NextCh \= end_of_file,
-	read_term(Stream, Term, []).
+	read_term(Stream, Term, [singletons(Singletons)]),
+	singleton_names(Singletons, Singles).
 
 whitespace(' ').
 whitespace('	').
@@ -43,19 +44,33 @@ consume_whitespace(S) :-
 	; true
 	).
 
-handle_term(:- Directive, Module, NewModule) :-
+singleton_names([], []).
+singleton_names([Name = _|Rest0], Names) :-
+	singleton_names(Rest0, Rest),
+	( atom_concat('_', _, Name)
+	-> Names = Rest
+	; Names = [Name|Rest]
+	).
+
+handle_term(:- Directive, _, Module, NewModule) :-
 	!,
 	handle_directive(Directive, Module, NewModule).
-handle_term(Head :- Body, Module, Module) :-
+handle_term(Head :- Body, Singles, Module, Module) :-
 	!,
-	Module:assertz(Head :- Body).
-handle_term(Head --> Body, Module, Module) :-
+	handle_clause(Head, Body, Singles, Module).
+handle_term(Head --> Body, Singles, Module, Module) :-
 	!,
 	write('DCG RULE: '),
 	write(Head --> Body),
 	nl.
-handle_term(Head, Module, Module) :-
-	Module:assertz(Head).
+handle_term(Head, Singles, Module, Module) :-
+	handle_clause(Head, true, Singles, Module).
+
+handle_clause(Head, Body, Singletons, Module) :-
+	functor(Head, Name, Arity),
+	PredicateIndicator = Name / Arity,
+	warn_singletons(PredicateIndicator, Singletons),
+	Module:assertz(Head :- Body).
 
 handle_directive(op(Priority, Specifier, Operator), Module, Module) :-
 	Module:op(Priority, Specifier, Operator).
@@ -74,6 +89,15 @@ handle_directive(D, Module, Module) :-
 	write(D),
 	nl.
 
+warn_singletons(_, []).
+warn_singletons(PI, Singles) :-
+	write('Warning: singleton variables in '), 
+	write(PI),
+	write(': '),
+	write(Singles),
+	write('.'),
+	nl.
+
 ensure_loads(_) :- fail.
 
 ensure_load(F) :-
-- 
cgit v1.2.3