mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

procedures-with-setters, debitrot `optimize', dedottification

Browse source 
* module/system/base/syntax.scm (define-record): Define the accessors as
  procedures-with-setters, not just as getters.

* module/system/il/compile.scm (optimize): This function was bitrotten
  since the addition of source locations in
  cb4cca12e7. Untested attempts to
  de-bitrot it. Dedottify as well.

* module/system/il/ghil.scm:
* module/system/il/glil.scm (unparse):
* module/system/vm/debug.scm (debugger-repl): Ongoing dedottification.
This commit is contained in:
Andy Wingo 2008-05-04 15:37:54 +02:00
parent 9f8ec6eb1f
commit 61dc81d993
5 changed files with 60 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/system/base/syntax.scm
View file

@ -93,13 +93,15 @@
(and (vector? x) (eq? (vector-ref x 0) ',name)))
,@(do ((n 1 (1+ n))
(slots (cdr def) (cdr slots))
(ls '() (append (let* ((slot (car slots))
(slot (if (pair? slot) (car slot) slot)))
(ls '() (append (let* ((sdef (car slots))
(sname (if (pair? sdef) (car sdef) sdef)))
`((define ,(string->symbol
(format #f "~A-~A" name n))
(lambda (x) (slot x ',slot)))
(define ,(symbol-append stem '- slot)
(lambda (x) (slot x ',slot)))))
(lambda (x) (slot x ',sname)))
(define ,(symbol-append stem '- sname)
,(make-procedure-with-setter
(lambda (x) (get-slot x sname))
(lambda (x v) (set-slot! x sname v))))))
ls)))
((null? slots) (reverse! ls))))))