mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

Remove unused variables in system/language.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2009-09-21 00:35:19 +02:00
parent a2ca725212
commit e5f5113c21
14 changed files with 50 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/assembly.scm
View file

@ -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)))

8
module/language/assembly/compile-bytecode.scm
View file

@ -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!

3
module/language/assembly/decompile-bytecode.scm
View file

@ -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)

5
module/language/assembly/disassemble.scm
View file

@ -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)

18
module/language/ecmascript/base.scm
View file

@ -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))

5
module/language/ecmascript/tokenize.scm
View file

@ -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? ?

4
module/language/glil/decompile-assembly.scm
View file

@ -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))

3
module/language/objcode/spec.scm
View file

@ -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)

22
module/language/tree-il.scm
View file

@ -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)))

22
module/language/tree-il/analyze.scm
View file

@ -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)

12
module/language/tree-il/compile-glil.scm
View file

@ -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)

6
module/system/repl/command.scm
View file

@ -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)

2
module/system/repl/repl.scm
View file

@ -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

2
module/system/xref.scm
View file

@ -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