summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-09-21 00:35:19 +0200
committerLudovic Courtès <ludo@gnu.org>2009-09-21 00:36:31 +0200
commite5f5113c21f396705d7479a570c96690135c9d36 (patch)
tree5cef5937b403ce841b70e49f80f69b658357caed
parenta2ca7252121e968798b0638b758ea99d7bf62409 (diff)
downloadguile-e5f5113c21f396705d7479a570c96690135c9d36.tar.gz
Remove unused variables in system/language.
* module/language/assembly.scm (byte-length): Don't match unused record slots. * module/language/tree-il.scm (tree-il->scheme, post-order!, pre-order!): Likewise. * module/language/tree-il/analyze.scm (analyze-lexicals): Likewise. * module/language/tree-il/compile-glil.scm (flatten): Likewise. * module/language/assembly/disassemble.scm (disassemble-load-program): Don't match unused list elements. * module/language/glil/decompile-assembly.scm (decompile-toplevel, decompile-load-program): Likewise. * module/system/xref.scm (program-callee-rev-vars): Likewise. * module/language/assembly/compile-bytecode.scm (write-bytecode)[write-sized-loader]: Remove. * module/language/assembly/decompile-bytecode.scm (decode-load-program): Factorize `pad' variables. * module/language/ecmascript/base.scm (object->value/string, object->value/number)[v]: Remove. * module/language/ecmascript/tokenize.scm (read-slash)[c0]: Remove. * module/language/objcode/spec.scm (decompile-value)[nargs]: Remove. * module/system/repl/command.scm (time)[vms-start, vms-end]: Remove. * module/system/repl/repl.scm (prompting-meta-read): Use `prompt'.
-rw-r--r--module/language/assembly.scm2
-rw-r--r--module/language/assembly/compile-bytecode.scm8
-rw-r--r--module/language/assembly/decompile-bytecode.scm3
-rw-r--r--module/language/assembly/disassemble.scm5
-rw-r--r--module/language/ecmascript/base.scm18
-rw-r--r--module/language/ecmascript/tokenize.scm5
-rw-r--r--module/language/glil/decompile-assembly.scm4
-rw-r--r--module/language/objcode/spec.scm3
-rw-r--r--module/language/tree-il.scm22
-rw-r--r--module/language/tree-il/analyze.scm22
-rw-r--r--module/language/tree-il/compile-glil.scm12
-rw-r--r--module/system/repl/command.scm6
-rw-r--r--module/system/repl/repl.scm2
-rw-r--r--module/system/xref.scm2
14 files changed, 50 insertions, 64 deletions
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 683da6cc1..95f8a2d12 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -49,7 +49,7 @@
(+ 1 *len-len* (string-length str)))
((load-array ,bv)
(+ 1 *len-len* (bytevector-length bv)))
- ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+ ((load-program _ _ _ _ ,len ,meta . _)
(+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0)))
((,inst . _) (guard (>= (instruction-length inst) 0))
(+ 1 (instruction-length inst)))
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 688cb6b31..e8bba9e7e 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -80,14 +80,6 @@
(define (write-loader str)
(write-loader-len (string-length str))
(write-string str))
- (define (write-sized-loader str)
- (let ((len (string-length str))
- (wid (string-bytes-per-char str)))
- (write-loader-len len)
- (write-byte wid)
- (if (= wid 4)
- (write-wide-string str)
- (write-string str))))
(define (write-bytevector bv)
(write-loader-len (bytevector-length bv))
;; Ew!
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
index 8cdebcfd0..511c6ccc6 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -57,8 +57,7 @@
(e (pop)) (f (pop)) (g (pop)) (h (pop))
(len (+ a (ash b 8) (ash c 16) (ash d 24)))
(metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
- (totlen (+ len metalen))
- (pad0 (pop)) (pad1 (pop)) (pad2 (pop)) (pad3 (pop))
+ (%unused-pad (begin (pop) (pop) (pop) (pop)))
(labels '())
(i 0))
(define (ensure-label rel1 rel2)
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index 492acb7e5..e40a73c6f 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -35,7 +35,7 @@
(define (disassemble-load-program asm env)
(pmatch asm
- ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+ ((load-program ,nargs _ _ ,labels _ _ . ,code)
(let ((objs (and env (assq-ref env 'objects)))
(free-vars (and env (assq-ref env 'free-vars)))
(meta (and env (assq-ref env 'meta)))
@@ -106,8 +106,7 @@
(define *uninteresting-props* '(name))
(define (disassemble-meta meta)
- (let ((sources (cadr meta))
- (props (filter (lambda (x)
+ (let ((props (filter (lambda (x)
(not (memq (car x) *uninteresting-props*)))
(cddr meta))))
(unless (null? props)
diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm
index 1d031fcde..f133bb05b 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -149,17 +149,15 @@
o))))
(define (object->value/string o)
- (let ((v (object->string o #f)))
- (if (is-a? x <js-object>)
- (object->number o #t)
- x)))
-
+ (if (is-a? x <js-object>)
+ (object->number o #t)
+ x))
+
(define (object->value/number o)
- (let ((v (object->number o #f)))
- (if (is-a? x <js-object>)
- (object->string o #t)
- x)))
-
+ (if (is-a? x <js-object>)
+ (object->string o #t)
+ x))
+
(define (object->value o)
;; FIXME: if it's a date, we should try numbers first
(object->value/string o))
diff --git a/module/language/ecmascript/tokenize.scm b/module/language/ecmascript/tokenize.scm
index 1b6a7eeaf..2ab8045cc 100644
--- a/module/language/ecmascript/tokenize.scm
+++ b/module/language/ecmascript/tokenize.scm
@@ -50,8 +50,9 @@
(+ 10 (- (char->integer (char-downcase c)) (char->integer #\a)))))
(define (read-slash port div?)
- (let* ((c0 (read-char port))
- (c1 (peek-char port)))
+ (let ((c1 (begin
+ (read-char port)
+ (peek-char port))))
(cond
((eof-object? c1)
;; hmm. error if we're not looking for a div? ?
diff --git a/module/language/glil/decompile-assembly.scm b/module/language/glil/decompile-assembly.scm
index 3cb887d44..ac623db19 100644
--- a/module/language/glil/decompile-assembly.scm
+++ b/module/language/glil/decompile-assembly.scm
@@ -31,7 +31,7 @@
(define (decompile-toplevel x)
(pmatch x
- ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,body)
+ ((load-program ,nargs ,nrest ,nlocs ,labels _ ,meta . ,body)
(decompile-load-program nargs nrest nlocs
(decompile-meta meta)
body labels #f))
@@ -123,7 +123,7 @@
(lp (cdr in) stack out (1+ pos)))
((make-false)
(lp (cdr in) (cons #f stack) out (1+ pos)))
- ((load-program ,a ,b ,c ,d ,labels ,sublen ,meta . ,body)
+ ((load-program ,a ,b ,c ,d ,labels _ ,meta . ,body)
(lp (cdr in)
(cons (decompile-load-program a b c d (decompile-meta meta)
body labels (car stack))
diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm
index 4cb600f1d..42110271d 100644
--- a/module/language/objcode/spec.scm
+++ b/module/language/objcode/spec.scm
@@ -68,8 +68,7 @@
(meta (program-meta x))
(free-vars (program-free-variables x))
(binds (program-bindings x))
- (srcs (program-sources x))
- (nargs (arity:nargs (program-arity x))))
+ (srcs (program-sources x)))
(let ((blocs (and binds (collapse-locals binds))))
(values (program-objcode x)
`((objects . ,objs)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index ad8b73176..123363208 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -226,10 +226,10 @@
((<primitive-ref> name)
name)
- ((<lexical-ref> name gensym)
+ ((<lexical-ref> gensym)
gensym)
- ((<lexical-set> name gensym exp)
+ ((<lexical-set> gensym exp)
`(set! ,gensym ,(tree-il->scheme exp)))
((<module-ref> mod name public?)
@@ -436,37 +436,37 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (conditional-then x) (lp then))
(set! (conditional-else x) (lp else)))
- ((<lexical-set> name gensym exp)
+ ((<lexical-set> exp)
(set! (lexical-set-exp x) (lp exp)))
- ((<module-set> mod name public? exp)
+ ((<module-set> exp)
(set! (module-set-exp x) (lp exp)))
- ((<toplevel-set> name exp)
+ ((<toplevel-set> exp)
(set! (toplevel-set-exp x) (lp exp)))
- ((<toplevel-define> name exp)
+ ((<toplevel-define> exp)
(set! (toplevel-define-exp x) (lp exp)))
- ((<lambda> vars meta body)
+ ((<lambda> body)
(set! (lambda-body x) (lp body)))
((<sequence> exps)
(set! (sequence-exps x) (map lp exps)))
- ((<let> vars vals body)
+ ((<let> vals body)
(set! (let-vals x) (map lp vals))
(set! (let-body x) (lp body)))
- ((<letrec> vars vals body)
+ ((<letrec> vals body)
(set! (letrec-vals x) (map lp vals))
(set! (letrec-body x) (lp body)))
- ((<fix> vars vals body)
+ ((<fix> vals body)
(set! (fix-vals x) (map lp vals))
(set! (fix-body x) (lp body)))
- ((<let-values> vars exp body)
+ ((<let-values> exp body)
(set! (let-values-exp x) (lp exp))
(set! (let-values-body x) (lp body)))
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index b93a0bd7e..10c1d0bd6 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -162,7 +162,7 @@
((<conditional> test then else)
(lset-union eq? (step test) (step-tail then) (step-tail else)))
- ((<lexical-ref> name gensym)
+ ((<lexical-ref> gensym)
(hashq-set! refcounts gensym (1+ (hashq-ref refcounts gensym 0)))
(if (not (and tail-call-args
(memq gensym labels-in-proc)
@@ -172,18 +172,18 @@
(hashq-set! labels gensym #f))
(list gensym))
- ((<lexical-set> name gensym exp)
+ ((<lexical-set> gensym exp)
(hashq-set! assigned gensym #t)
(hashq-set! labels gensym #f)
(lset-adjoin eq? (step exp) gensym))
- ((<module-set> mod name public? exp)
+ ((<module-set> exp)
(step exp))
- ((<toplevel-set> name exp)
+ ((<toplevel-set> exp)
(step exp))
- ((<toplevel-define> name exp)
+ ((<toplevel-define> exp)
(step exp))
((<sequence> exps)
@@ -194,7 +194,7 @@
(else
(lp (cdr exps) (lset-union eq? ret (step (car exps))))))))
- ((<lambda> vars meta body)
+ ((<lambda> vars body)
(let ((locally-bound (let rev* ((vars vars) (out '()))
(cond ((null? vars) out)
((pair? vars) (rev* (cdr vars)
@@ -326,22 +326,22 @@
((<conditional> test then else)
(max (recur test) (recur then) (recur else)))
- ((<lexical-set> name gensym exp)
+ ((<lexical-set> exp)
(recur exp))
- ((<module-set> mod name public? exp)
+ ((<module-set> exp)
(recur exp))
- ((<toplevel-set> name exp)
+ ((<toplevel-set> exp)
(recur exp))
- ((<toplevel-define> name exp)
+ ((<toplevel-define> exp)
(recur exp))
((<sequence> exps)
(apply max (map recur exps)))
- ((<lambda> vars meta body)
+ ((<lambda> vars body)
;; allocate closure vars in order
(let lp ((c (hashq-ref free-vars x)) (n 0))
(if (pair? c)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 9de5c8858..d18d5edd4 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -251,7 +251,7 @@
(maybe-emit-return))
;; FIXME: should represent sequence as exps tail
- ((<sequence> src exps)
+ ((<sequence> exps)
(let lp ((exps exps))
(if (null? (cdr exps))
(comp-tail (car exps))
@@ -422,7 +422,7 @@
;; rename & goto
(for-each (lambda (sym)
(pmatch (hashq-ref (hashq-ref allocation sym) self)
- ((#t ,boxed? . ,index)
+ ((#t _ . ,index)
;; set unboxed, as the proc prelude will box if needed
(emit-code #f (make-glil-lexical #t #f 'set index)))
(,x (error "what" x))))
@@ -510,7 +510,7 @@
'ref (module-name (fluid-ref *comp-module*)) name #f))))
(maybe-emit-return))))
- ((<lexical-ref> src name gensym)
+ ((<lexical-ref> src gensym)
(case context
((push vals tail)
(pmatch (hashq-ref (hashq-ref allocation gensym) self)
@@ -520,7 +520,7 @@
(error "badness" x loc)))))
(maybe-emit-return))
- ((<lexical-set> src name gensym exp)
+ ((<lexical-set> src gensym exp)
(comp-push exp)
(pmatch (hashq-ref (hashq-ref allocation gensym) self)
((,local? ,boxed? . ,index)
@@ -578,7 +578,7 @@
(for-each
(lambda (loc)
(pmatch loc
- ((,local? ,boxed? . ,n)
+ ((,local? _ . ,n)
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
@@ -684,7 +684,7 @@
(for-each
(lambda (loc)
(pmatch loc
- ((,local? ,boxed? . ,n)
+ ((,local? _ . ,n)
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index a99e1bae9..d3d166076 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -337,13 +337,11 @@ Disassemble a file."
(define-meta-command (time repl (form))
"time FORM
Time execution."
- (let* ((vms-start (vm-stats (repl-vm repl)))
- (gc-start (gc-run-time))
+ (let* ((gc-start (gc-run-time))
(tms-start (times))
(result (repl-eval repl (repl-parse repl form)))
(tms-end (times))
- (gc-end (gc-run-time))
- (vms-end (vm-stats (repl-vm repl))))
+ (gc-end (gc-run-time)))
(define (get proc start end)
(exact->inexact (/ (- (proc end) (proc start)) internal-time-units-per-second)))
(repl-print repl result)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 2f4a3783a..bdbf1ded8 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -54,7 +54,7 @@
(let ((prompt (lambda () (repl-prompt repl)))
(lread (language-reader (repl-language repl))))
(with-fluid* current-reader (meta-reader lread)
- (lambda () (repl-reader (lambda () (repl-prompt repl)))))))
+ (lambda () (repl-reader prompt)))))
(define (default-catch-handler . args)
(pmatch args
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 906ec8e4a..27c0de56d 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -35,7 +35,7 @@
(progv (make-vector (vector-length objects) #f))
(asm (decompile (program-objcode prog) #:to 'assembly)))
(pmatch asm
- ((load-program ,nargs ,nrest ,nlocs ,labels ,len . ,body)
+ ((load-program _ _ _ _ _ . ,body)
(for-each
(lambda (x)
(pmatch x