mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

oop goops save: fix compile-time availability of write-component

Browse source 
* module/oop/goops/save.scm (write-component)
  (write-component-procedure): Move definitions up so that syntax
  definition is available when compiling the rest of the file.
This commit is contained in:
Andy Wingo 2013-01-23 16:53:54 +01:00
parent a20eb9a39b
commit a3df9ad9e6
1 changed files with 23 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/oop/goops/save.scm
View file

@ -127,6 +127,29 @@
(define (readable? obj)
(hashq-ref readables obj))
;;;
;;; Writer helpers
;;;
(define (write-component-procedure o file env)
"Return #f if circular reference"
(cond ((immediate? o) (write o file) #t)
((readable? o) (write (readable-expression o) file) #t)
((excluded? o env) (display #f file) #t)
(else
(let ((info (object-info o env)))
(cond ((not (binding? info)) (write-readably o file env) #t)
((not (eq? (visiting info) #:defined)) #f) ;forward reference
(else (display (binding info) file) #t))))))
;;; write-component OBJECT PATCHER FILE ENV
;;;
(define-macro (write-component object patcher file env)
`(or (write-component-procedure ,object ,file ,env)
(begin
(display #f ,file)
(add-patcher! ,patcher ,env))))
;;;
;;; Strings
;;;
@ -603,24 +626,6 @@
(pop-ref! env)
(set! (objects env) (cons o (objects env)))))))
(define (write-component-procedure o file env)
"Return #f if circular reference"
(cond ((immediate? o) (write o file) #t)
((readable? o) (write (readable-expression o) file) #t)
((excluded? o env) (display #f file) #t)
(else
(let ((info (object-info o env)))
(cond ((not (binding? info)) (write-readably o file env) #t)
((not (eq? (visiting info) #:defined)) #f) ;forward reference
(else (display (binding info) file) #t))))))
;;; write-component OBJECT PATCHER FILE ENV
;;;
(define-macro (write-component object patcher file env)
`(or (write-component-procedure ,object ,file ,env)
(begin
(display #f ,file)
(add-patcher! ,patcher ,env))))
;;;
;;; Main engine