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

be smarter about allocating local variables, reusing slots if possible

Browse source 
* module/language/Makefile.am: OK, we can compile compile-ghil.scm now,
  thankfully.

* module/language/ecmascript/compile-ghil.scm (ormatch): New macro, a
  wrapper around pmatch to avoid some of the more egregious
  non-tail recursiveness.
  (comp): Use ormatch.

* module/language/ghil.scm (unparse-ghil): The body of bind and mv-bind
  is a single expression, not a list of expressions.

* module/language/ghil/compile-glil.scm (codegen): Be more clever when
  allocating "local" variables -- if a variable goes out of scope, its
  index can be re-used later.

* module/language/glil.scm (parse-glil, unparse-ghil): The "rest" of a
  mv-bind is a flag, not a list. The "ra" of an mv-call is a label, not a
  GLIL expression.

* module/language/objcode/spec.scm (collapse-locals, decompile-value):
  When decompiling a value, process the bindings list differently.
  Comments in the code.

* module/language/scheme/compile-ghil.scm (define-scheme-translator): Fix
  the generated error procedure.
  (let): Re-indent.
  (letrec): Re-indent.

* module/system/base/syntax.scm (record-case): If the body of a clause is
  null, fill it with the unspecified value.
This commit is contained in:
Andy Wingo 2009-02-21 19:25:35 +01:00
parent 81d677eb12
commit 594d9d4c48
9 changed files with 138 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -43,6 +43,25 @@
(values (thunk) #f)))
(values (thunk) #f))))
;; since locals are allocated on the stack and can have limited scope,
;; in many cases we use one local for more than one lexical variable. so
;; the returned locals set is a list, where element N of the list is
;; itself a list of bindings for local variable N.
(define (collapse-locals locs)
(let lp ((ret '()) (locs locs))
(if (null? locs)
(map cdr (sort! ret
(lambda (x y) (< (car x) (car y)))))
(let ((b (car locs)))
(cond
((assv-ref ret (binding:index b))
=> (lambda (bindings)
(append! bindings (list b))
(lp ret (cdr locs))))
(else
(lp (acons (binding:index b) (list b) ret)
(cdr locs))))))))
(define (decompile-value x env opts)
(cond
((program? x)
@ -53,9 +72,10 @@
(srcs (program-sources x))
(nargs (arity:nargs (program-arity x))))
(let ((blocs (and binds
(append (list-head binds nargs)
(filter (lambda (x) (not (binding:extp x)))
(list-tail binds nargs)))))
(collapse-locals
(append (list-head binds nargs)
(filter (lambda (x) (not (binding:extp x)))
(list-tail binds nargs))))))
(bexts (and binds
(filter binding:extp binds))))
(values (program-objcode x)