mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
expanded type constructors in psyntax
* module/ice-9/psyntax.scm (define-expansion-constructors): Define constructors for expanded types. * module/ice-9/psyntax-pp.scm: Regenerated.
This commit is contained in:
parent
f7b61b39d3
commit
3d10018e7f
2 changed files with 9113 additions and 8067 deletions
File diff suppressed because it is too large
Load diff
|
@ -224,6 +224,24 @@
|
|||
(apply f (cons x xr))
|
||||
(and (apply f (cons x xr)) (andmap first rest)))))))))
|
||||
|
||||
(define-syntax define-expansion-constructors
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_)
|
||||
(let lp ((n 0) (out '()))
|
||||
(if (< n (vector-length %expanded-vtables))
|
||||
(lp (1+ n)
|
||||
(let* ((vtable (vector-ref %expanded-vtables n))
|
||||
(stem (struct-ref vtable (+ vtable-offset-user 0)))
|
||||
(fields (struct-ref vtable (+ vtable-offset-user 2)))
|
||||
(sfields (map (lambda (f) (datum->syntax x f)) fields))
|
||||
(ctor (datum->syntax x (symbol-append 'make- stem))))
|
||||
(cons #`(define (#,ctor #,@sfields)
|
||||
(make-struct (vector-ref %expanded-vtables #,n) 0
|
||||
#,@sfields))
|
||||
out)))
|
||||
#`(begin #,@(reverse out))))))))
|
||||
|
||||
(define-syntax define-structure
|
||||
(lambda (x)
|
||||
(define construct-name
|
||||
|
@ -278,6 +296,8 @@
|
|||
(let ()
|
||||
(define *mode* (make-fluid))
|
||||
|
||||
(define-expansion-constructors)
|
||||
|
||||
;;; hooks to nonportable run-time helpers
|
||||
(begin
|
||||
(define fx+ +)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue