From 2b717de5d7949688c7c639414a5765cbc4169f8c Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 20 Mar 2023 22:52:57 -0700
Subject: compiler: fix unused variable situations
We fix numerous unused variable situations uncovered
by the new diagnostic. Most of those occurring inside
tree-bind or mac-param-bind forms remain unfixed.
These are caused by the idiom of binding a dummy variable
as a placeholder in the structure. I am instead going to
introduce a mechanism into tree-bind/mac-param-bind
for indicating an ignored piece of structure.
* stdlib/compiler.tl (compiler (comp-if, eliminate-frame,
comp-lambda-impl, comp-typep, comp-fun-form, expand-and,
reduce-or, compiler-emit-warnings, usr:compile
with-compile-opts): Eliminate unused variables in structural
pattern matches in various ways: eliminating predicate
argument variables, replacing place holder variables by
@nil, or just using the variables when possible.
(compiler compile-in-toplevel): Remove unused saved-nlev variable.
(compiler comp-atom): Use (use oreg) form to suppress
unused parameter warning.
(compiler comp-return-form): Eliminate unused binfo variable.
The lookup-block method is called for the side effect of
marking the block used, so we keep that call.
(compiler comp-let): Unused variable specials is gone.
(compiler comp-or): Unused variable lastfrag is gone,
as is the assignment to it. There is a reason assignment
isn't use!
(compiler comp-inline-lambda): Get rid of the two variables
called dummy by folding the associated calculation into
an adjacent initform using progn and prog1.
(comp-tree-case): Remove unused ncases, lerrtest and lnext
variables.
(safe-const-eval): Remove unused reduced-form variable,
and simplify code, eliminating another local.
---
stdlib/compiler.tl | 62 ++++++++++++++++++++++++------------------------------
1 file changed, 28 insertions(+), 34 deletions(-)
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 174f5b26..226bc132 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -252,7 +252,7 @@
(eval-only
(defmacro compile-in-toplevel (me . body)
- (with-gensyms (saved-tregs saved-treg-cntr saved-nlev saved-discards)
+ (with-gensyms (saved-tregs saved-treg-cntr saved-discards)
^(let* ((,saved-tregs (qref ,me tregs))
(,saved-treg-cntr (qref ,me treg-cntr))
(,saved-discards (qref ,me discards)))
@@ -569,6 +569,7 @@
(t (compile-error form "invalid operator")))))))
(defmeth compiler comp-atom (me oreg form)
+ (use oreg)
(cond
((null form) (new (frag '(t 0) nil)))
(t (let ((dreg me.(get-dreg form)))
@@ -673,7 +674,7 @@
me.(compile oreg env (if (safe-const-eval test) then else)))
((@(safe-constantp @test) @then)
me.(compile oreg env (if (safe-const-eval test) then)))
- ((@(safe-constantp @test))
+ ((@(safe-constantp))
me.(compile oreg env nil))
(((@(member @op %test-funs%) @a @b) . @rest)
me.(compile oreg env ^(ift ,op ,a ,b ,*rest)))
@@ -720,7 +721,7 @@
te-frag.fvars
te-frag.ffuns))))
(() me.(compile oreg env nil))
- (@else (compile-error form "excess argument forms"))))
+ (@nil (compile-error form "excess argument forms"))))
(defmeth compiler comp-ift (me oreg env form)
(mac-param-bind form (op fun left right : then else) form
@@ -872,8 +873,8 @@
nil
me.(get-dreg name)))
(opcode (if (eq op 'return-from) 'ret 'abscsr))
- (vfrag me.(compile oreg env value))
- (binfo env.(lookup-block name t)))
+ (vfrag me.(compile oreg env value)))
+ env.(lookup-block name t)
(new (frag oreg
^(,*vfrag.code
(,opcode ,nreg ,vfrag.oreg))
@@ -980,11 +981,11 @@
(push treg tregs))))
(let ((ncode (append-each ((insns (conses code)))
(match-case insns
- (((frame @lev @size) . @rest)
+ (((frame @lev @size) . @nil)
^((frame ,(pred lev) ,size)))
- (((dframe @lev @size) . @rest)
+ (((dframe @lev @size) . @nil)
^((dframe ,(pred lev) ,size)))
- (((@op . @args) . @rest)
+ (((@op . @args) . @nil)
(let ((nargs (mapcar (lambda-match
((@(as arg (v @lev @idx)))
(or [trhash arg]
@@ -994,7 +995,7 @@
((@arg) arg))
args)))
^((,op ,*nargs))))
- ((@else . @rest) (list else))))))
+ ((@else . @nil) (list else))))))
(dohash (loc treg trhash)
(let ((vb [vbhash loc]))
(set vb.loc treg)))
@@ -1007,7 +1008,6 @@
(defmeth compiler comp-let (me oreg env form)
(mac-param-bind form (sym raw-vis . body) form
(let* ((vis (mapcar [iffi atom list] raw-vis))
- (specials [keep-if special-var-p vis car])
(lexsyms [remove-if special-var-p [mapcar car vis]])
allsyms
(specials-occur [find-if special-var-p vis car])
@@ -1215,7 +1215,7 @@
,lskip)))
me.(free-treg btreg)
(when (and cspy (plusp frsize) (null cspy.cap-vars))
- (when-match ((close @reg @frsize @nreg . @irest) . @crest)
+ (when-match ((close @reg @frsize @nil . @irest) . @crest)
me.(eliminate-frame code nenv)
(set code ^((close ,reg 0 ,me.treg-cntr ,*irest)
,*crest))))
@@ -1283,7 +1283,6 @@
((op . args)
(let* (ffuns fvars
(nargs (len args))
- lastfrag
(lout (gensym "l"))
(treg me.(maybe-alloc-treg oreg))
(code (build
@@ -1291,8 +1290,6 @@
(n (range 1)))
(let ((islast (eql n nargs)))
(let ((frag me.(compile treg env form)))
- (when islast
- (set lastfrag frag))
(pend frag.code
me.(maybe-mov treg frag.oreg))
(unless islast
@@ -1359,7 +1356,7 @@
((typep @exp @(require @(constantp @type)
(null (safe-const-eval type))))
me.(compile oreg env ^(progn ,exp nil)))
- (@else
+ (@nil
me.(comp-fun-form oreg env form))))
(defmeth compiler comp-fun-form (me oreg env form)
@@ -1387,7 +1384,7 @@
((not (@(and @(or eq eql equal) @op) @a @b))
(let ((nop (caseq op (eq 'neq) (eql 'neql) (equal 'nequal))))
(return-from comp-fun-form me.(compile oreg env ^(,nop ,a ,b)))))
- ((@(or append cons list list*) . @args)
+ ((@(or append cons list list*) . @nil)
(set form (reduce-lisp form)))
((@(@bin [%bin-op% @sym]) @a @b)
(set form (rlcp ^(,bin ,a ,b) form)))
@@ -1518,12 +1515,14 @@
(let* ((treg me.(alloc-treg))
(ifrag me.(comp-progn treg env inits))
(*load-time* nil)
- (dummy (inc me.loop-nest))
- (tfrag (if test-p me.(compile treg env test)))
+ (tfrag (progn
+ (inc me.loop-nest)
+ (if test-p me.(compile treg env test))))
(rfrag me.(comp-progn oreg env rets))
(nfrag me.(comp-progn treg env incs))
- (bfrag me.(comp-progn treg env body))
- (dummy (dec me.loop-nest))
+ (bfrag (prog1
+ me.(comp-progn treg env body)
+ (dec me.loop-nest)))
(lback (gensym "l"))
(lskip (gensym "l"))
(frags (build
@@ -1583,8 +1582,7 @@
(defmeth compiler comp-tree-case (me oreg env form)
(mac-param-bind form (op obj . cases) form
- (let* ((ncases (len cases))
- (nenv (new env up env co me))
+ (let* ((nenv (new env up env co me))
(obj-immut-var nenv.(extend-var (gensym)))
(obj-var nenv.(extend-var (gensym)))
(err-blk (gensym))
@@ -1604,8 +1602,6 @@
params nil obj-var.sym :
err-blk
body))))
- (lerrtest (gensym "l"))
- (lnext (gensym "l"))
(cfrag me.(compile treg nenv src)))
(new (frag treg
^(,*cfrag.code
@@ -1743,7 +1739,7 @@
((and) t)
((and @a) a)
((and @(true-const-p) . @rest) (expand-and ^(and ,*rest)))
- ((and nil . @rest) nil)
+ ((and nil . @nil) nil)
((and @a . @rest) ^(if ,a ,(expand-and ^(and ,*rest))))
(@else else)))
@@ -1755,9 +1751,9 @@
(defun reduce-or (form)
(match-case form
((or) form)
- ((or @a) form)
+ ((or @nil) form)
((or nil . @rest) (reduce-or ^(or ,*rest)))
- ((or @(true-const-p @c) . @rest) ^(or ,c))
+ ((or @(true-const-p @c) . @nil) ^(or ,c))
((or @a . @rest) ^(or ,a ,*(cdr (reduce-or ^(or ,*rest)))))
(@else else)))
@@ -2224,10 +2220,8 @@
reduced-form))))
(defun safe-const-eval (form)
- (let* ((reduced-form (safe-const-reduce form))
- (ece [%eval-cache% form]))
- (unless ece.?throws
- (eval form))))
+ (unless [%eval-cache% form].?throws
+ (eval form)))
(defun safe-constantp (form)
(if (constantp form)
@@ -2299,7 +2293,7 @@
\ then defined as vars`)
(continue ()))))
(each ((uc (zap *unchecked-calls*)))
- (when-match (@(as form (@sym . @args)) . @nargs) uc
+ (when-match (@(as form (@sym . @nil)) . @nargs) uc
(whenlet ((fun (symbol-function sym)))
(param-check form nargs (get-param-info sym))))))
@@ -2540,7 +2534,7 @@
(vm-desc (compile-toplevel form t))
(comp-fun (vm-execute-toplevel vm-desc)))
(set (symbol-function obj) comp-fun))))
- (@else (error "~s: cannot compile ~s" 'compile obj))))
+ (@else (error "~s: cannot compile ~s" 'compile else))))
(defmacro usr:with-compile-opts (:form form . clauses)
(with-gensyms (co)
@@ -2554,4 +2548,4 @@
(compile-error form "~s isn't a recognized warning option" s)))
^(set ,*(mappend (ret ^((qref ,co ,@1) ,op)) syms)))
(@(or @(atom) (@(not @(keywordp)) . @nil)) cl)
- (@else (compile-error form "uncrecognized clause syntax: ~s" cl)))))))
+ (@nil (compile-error form "uncrecognized clause syntax: ~s" cl)))))))
--
cgit v1.2.3