1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

Define named accessors for legacy record types

* module/system/base/syntax.scm (define-record): Define named accessors,
  to prepare the code for srfi-9 records switchover.

* module/system/il/ghil.scm:
* module/system/il/glil.scm: Export a bunch of named accessors.
This commit is contained in:
Andy Wingo 2008-05-04 13:54:41 +02:00
parent f245e62cf8
commit bdaffda2c4
3 changed files with 37 additions and 6 deletions

View file

@ -93,12 +93,14 @@
(and (vector? x) (eq? (vector-ref x 0) ',name))) (and (vector? x) (eq? (vector-ref x 0) ',name)))
,@(do ((n 1 (1+ n)) ,@(do ((n 1 (1+ n))
(slots (cdr def) (cdr slots)) (slots (cdr def) (cdr slots))
(ls '() (cons (let* ((slot (car slots)) (ls '() (append (let* ((slot (car slots))
(slot (if (pair? slot) (car slot) slot))) (slot (if (pair? slot) (car slot) slot)))
`(define ,(string->symbol `((define ,(string->symbol
(format #f "~A-~A" name n)) (format #f "~A-~A" name n))
(lambda (x) (slot x ',slot)))) (lambda (x) (slot x ',slot)))
ls))) (define ,(symbol-append stem '- slot)
(lambda (x) (slot x ',slot)))))
ls)))
((null? slots) (reverse! ls)))))) ((null? slots) (reverse! ls))))))
(define (%make-struct args slots) (define (%make-struct args slots)

View file

@ -25,33 +25,50 @@
:export :export
( (
<ghil-void> make-ghil-void <ghil-void>? <ghil-void>-1 <ghil-void>-2 <ghil-void> make-ghil-void <ghil-void>? <ghil-void>-1 <ghil-void>-2
ghil-void-env ghil-void-loc
<ghil-quote> make-ghil-quote <ghil-quote>? <ghil-quote>-1 <ghil-quote>-2 <ghil-quote>-3 <ghil-quote> make-ghil-quote <ghil-quote>? <ghil-quote>-1 <ghil-quote>-2 <ghil-quote>-3
ghil-quote-env ghil-quote-loc ghil-quote-obj
<ghil-quasiquote> make-ghil-quasiquote <ghil-quasiquote>? <ghil-quasiquote> make-ghil-quasiquote <ghil-quasiquote>?
<ghil-quasiquote>-1 <ghil-quasiquote>-2 <ghil-quasiquote>-3 <ghil-quasiquote>-1 <ghil-quasiquote>-2 <ghil-quasiquote>-3
ghil-quasiquote-env ghil-quasiquote-loc ghil-quasiquote-exp
<ghil-unquote> make-ghil-unquote <ghil-unquote>? <ghil-unquote> make-ghil-unquote <ghil-unquote>?
<ghil-unquote>-1 <ghil-unquote>-2 <ghil-unquote>-3 <ghil-unquote>-1 <ghil-unquote>-2 <ghil-unquote>-3
ghil-unquote-env ghil-unquote-loc ghil-unquote-exp
<ghil-unquote-splicing> make-ghil-unquote-splicing <ghil-unquote-splicing>? <ghil-unquote-splicing> make-ghil-unquote-splicing <ghil-unquote-splicing>?
<ghil-unquote-splicing>-1 <ghil-unquote-splicing>-2 <ghil-unquote-splicing>-1 <ghil-unquote-splicing>-2
<ghil-unquote-splicing>-3 <ghil-unquote-splicing>-3
ghil-unquote-env ghil-unquote-loc ghil-unquote-exp
<ghil-ref> make-ghil-ref <ghil-ref>? <ghil-ref>-1 <ghil-ref>-2 <ghil-ref>-3 <ghil-ref> make-ghil-ref <ghil-ref>? <ghil-ref>-1 <ghil-ref>-2 <ghil-ref>-3
ghil-ref-env ghil-ref-loc ghil-ref-var
<ghil-set> make-ghil-set <ghil-set>? <ghil-set>-1 <ghil-set>-2 <ghil-set>-3 <ghil-set>-4 <ghil-set> make-ghil-set <ghil-set>? <ghil-set>-1 <ghil-set>-2 <ghil-set>-3 <ghil-set>-4
ghil-set-env ghil-set-loc ghil-set-var ghil-set-val
<ghil-define> make-ghil-define <ghil-define>? <ghil-define> make-ghil-define <ghil-define>?
<ghil-define>-1 <ghil-define>-2 <ghil-define>-3 <ghil-define>-4 <ghil-define>-1 <ghil-define>-2 <ghil-define>-3 <ghil-define>-4
ghil-define-env ghil-define-loc ghil-define-var ghil-define-val
<ghil-if> make-ghil-if <ghil-if>? <ghil-if> make-ghil-if <ghil-if>?
<ghil-if>-1 <ghil-if>-2 <ghil-if>-3 <ghil-if>-4 <ghil-if>-5 <ghil-if>-1 <ghil-if>-2 <ghil-if>-3 <ghil-if>-4 <ghil-if>-5
ghil-if-env ghil-if-loc ghil-if-test ghil-if-then ghil-if-else
<ghil-and> make-ghil-and <ghil-and>? <ghil-and>-1 <ghil-and>-2 <ghil-and>-3 <ghil-and> make-ghil-and <ghil-and>? <ghil-and>-1 <ghil-and>-2 <ghil-and>-3
ghil-and-env ghil-and-loc ghil-and-exps
<ghil-or> make-ghil-or <ghil-or>? <ghil-or>-1 <ghil-or>-2 <ghil-or>-3 <ghil-or> make-ghil-or <ghil-or>? <ghil-or>-1 <ghil-or>-2 <ghil-or>-3
ghil-or-env ghil-or-loc ghil-or-exps
<ghil-begin> make-ghil-begin <ghil-begin>? <ghil-begin>-1 <ghil-begin>-2 <ghil-begin>-3 <ghil-begin> make-ghil-begin <ghil-begin>? <ghil-begin>-1 <ghil-begin>-2 <ghil-begin>-3
ghil-begin-env ghil-begin-loc ghil-begin-exps
<ghil-bind> make-ghil-bind <ghil-bind>? <ghil-bind> make-ghil-bind <ghil-bind>?
<ghil-bind>-1 <ghil-bind>-2 <ghil-bind>-3 <ghil-bind>-4 <ghil-bind>-5 <ghil-bind>-1 <ghil-bind>-2 <ghil-bind>-3 <ghil-bind>-4 <ghil-bind>-5
ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body
<ghil-lambda> make-ghil-lambda <ghil-lambda>? <ghil-lambda>-1 <ghil-lambda>-2 <ghil-lambda> make-ghil-lambda <ghil-lambda>? <ghil-lambda>-1 <ghil-lambda>-2
<ghil-lambda>-3 <ghil-lambda>-4 <ghil-lambda>-5 <ghil-lambda>-3 <ghil-lambda>-4 <ghil-lambda>-5
ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body
ghil-lambda-env ghil-lambda-loc ghil-lambda-vars ghil-lambda-rest ghil-lambda-body
<ghil-inline> make-ghil-inline <ghil-inline>? <ghil-inline> make-ghil-inline <ghil-inline>?
<ghil-inline>-1 <ghil-inline>-2 <ghil-inline>-3 <ghil-inline>-4 <ghil-inline>-1 <ghil-inline>-2 <ghil-inline>-3 <ghil-inline>-4
ghil-inline-env ghil-inline-loc ghil-inline-inline ghil-inline-args
<ghil-call> make-ghil-call <ghil-call>? <ghil-call> make-ghil-call <ghil-call>?
<ghil-call>-1 <ghil-call>-2 <ghil-call>-3 <ghil-call>-4 <ghil-call>-1 <ghil-call>-2 <ghil-call>-3 <ghil-call>-4
ghil-call-env ghil-call-loc ghil-call-proc ghil-call-args
)) ))

View file

@ -24,25 +24,37 @@
:export :export
(pprint-glil (pprint-glil
<glil-vars> make-glil-vars <glil-vars> make-glil-vars
glil-vars-nargs glil-vars-nrest glil-vars-nlocs glil-vars-nexts
<glil-asm> make-glil-asm <glil-asm>? <glil-asm> make-glil-asm <glil-asm>?
<glil-asm>-1 <glil-asm>-2 <glil-asm>-3 <glil-asm>-4 <glil-asm>-5 <glil-asm>-1 <glil-asm>-2 <glil-asm>-3 <glil-asm>-4 <glil-asm>-5
glil-asm-vars glil-asm-body
<glil-bind> make-glil-bind <glil-bind>? <glil-bind>-1 <glil-bind> make-glil-bind <glil-bind>? <glil-bind>-1
glil-bind-vars
<glil-unbind> make-glil-unbind <glil-unbind>? <glil-unbind> make-glil-unbind <glil-unbind>?
<glil-source> make-glil-source <glil-source>? <glil-source>-1 <glil-source>-2 <glil-source> make-glil-source <glil-source>? <glil-source>-1 <glil-source>-2
glil-source-loc
<glil-void> make-glil-void <glil-void>? <glil-void> make-glil-void <glil-void>?
<glil-const> make-glil-const <glil-const>? <glil-const>-1 <glil-const> make-glil-const <glil-const>? <glil-const>-1
glil-const-obj
<glil-argument> make-glil-argument <glil-argument>? <glil-argument>-1 <glil-argument>-2 <glil-argument> make-glil-argument <glil-argument>? <glil-argument>-1 <glil-argument>-2
glil-argument-op glil-argument-index
<glil-local> make-glil-local <glil-local>? <glil-local>-1 <glil-local>-2 <glil-local> make-glil-local <glil-local>? <glil-local>-1 <glil-local>-2
glil-local-op glil-local-index
<glil-external> make-glil-external <glil-external>? <glil-external> make-glil-external <glil-external>?
<glil-external>-1 <glil-external>-2 <glil-external>-3 <glil-external>-1 <glil-external>-2 <glil-external>-3
glil-external-op glil-external-depth glil-external-index
<glil-module> make-glil-module <glil-module>? <glil-module> make-glil-module <glil-module>?
<glil-module>-1 <glil-module>-2 <glil-module>-3 <glil-module>-1 <glil-module>-2 <glil-module>-3
glil-module-op glil-module-module glil-module-index
<glil-label> make-glil-label <glil-label>? <glil-label>-1 <glil-label> make-glil-label <glil-label>? <glil-label>-1
glil-label-label
<glil-branch> make-glil-branch <glil-branch>? <glil-branch>-1 <glil-branch>-2 <glil-branch> make-glil-branch <glil-branch>? <glil-branch>-1 <glil-branch>-2
glil-branch-int glil-branch-label
<glil-call> make-glil-call <glil-call>? <glil-call>-1 <glil-call>-2 <glil-call> make-glil-call <glil-call>? <glil-call>-1 <glil-call>-2
glil-call-int glil-call-nargs
)) ))
(define-record (<glil-vars> nargs nrest nlocs nexts)) (define-record (<glil-vars> nargs nrest nlocs nexts))