diff options
author | Andy Wingo <wingo@pobox.com> | 2008-05-04 13:54:41 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-05-04 13:54:41 +0200 |
commit | bdaffda2c4dbc14f679bfed0b11e472f7eb64bc5 (patch) | |
tree | 7a3c2c80d196416b49bcae4a26aaa870baa1450a | |
parent | f245e62cf87076c5a77101a509090851ccbd8da5 (diff) | |
download | guile-bdaffda2c4dbc14f679bfed0b11e472f7eb64bc5.tar.gz |
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.
-rw-r--r-- | module/system/base/syntax.scm | 14 | ||||
-rw-r--r-- | module/system/il/ghil.scm | 17 | ||||
-rw-r--r-- | module/system/il/glil.scm | 12 |
3 files changed, 37 insertions, 6 deletions
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index e379f722e..27baa5558 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -93,12 +93,14 @@ (and (vector? x) (eq? (vector-ref x 0) ',name))) ,@(do ((n 1 (1+ n)) (slots (cdr def) (cdr slots)) - (ls '() (cons (let* ((slot (car slots)) - (slot (if (pair? slot) (car slot) slot))) - `(define ,(string->symbol - (format #f "~A-~A" name n)) - (lambda (x) (slot x ',slot)))) - ls))) + (ls '() (append (let* ((slot (car slots)) + (slot (if (pair? slot) (car slot) slot))) + `((define ,(string->symbol + (format #f "~A-~A" name n)) + (lambda (x) (slot x ',slot))) + (define ,(symbol-append stem '- slot) + (lambda (x) (slot x ',slot))))) + ls))) ((null? slots) (reverse! ls)))))) (define (%make-struct args slots) diff --git a/module/system/il/ghil.scm b/module/system/il/ghil.scm index f287f8aba..5b42c63f9 100644 --- a/module/system/il/ghil.scm +++ b/module/system/il/ghil.scm @@ -25,33 +25,50 @@ :export ( <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-env ghil-quote-loc ghil-quote-obj <ghil-quasiquote> make-ghil-quasiquote <ghil-quasiquote>? <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>-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>-1 <ghil-unquote-splicing>-2 <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-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-env ghil-set-loc ghil-set-var ghil-set-val <ghil-define> make-ghil-define <ghil-define>? <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>-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-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-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-env ghil-begin-loc ghil-begin-exps <ghil-bind> make-ghil-bind <ghil-bind>? <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>-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>-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>-1 <ghil-call>-2 <ghil-call>-3 <ghil-call>-4 + ghil-call-env ghil-call-loc ghil-call-proc ghil-call-args )) diff --git a/module/system/il/glil.scm b/module/system/il/glil.scm index c7fba8592..33c44b1e7 100644 --- a/module/system/il/glil.scm +++ b/module/system/il/glil.scm @@ -24,25 +24,37 @@ :export (pprint-glil <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>-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-vars <glil-unbind> make-glil-unbind <glil-unbind>? <glil-source> make-glil-source <glil-source>? <glil-source>-1 <glil-source>-2 + glil-source-loc <glil-void> make-glil-void <glil-void>? <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-op glil-argument-index <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>-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>-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-label <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-int glil-call-nargs )) (define-record (<glil-vars> nargs nrest nlocs nexts)) |