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 ( make-ghil-void ? -1 -2 + ghil-void-env ghil-void-loc make-ghil-quote ? -1 -2 -3 + ghil-quote-env ghil-quote-loc ghil-quote-obj make-ghil-quasiquote ? -1 -2 -3 + ghil-quasiquote-env ghil-quasiquote-loc ghil-quasiquote-exp make-ghil-unquote ? -1 -2 -3 + ghil-unquote-env ghil-unquote-loc ghil-unquote-exp make-ghil-unquote-splicing ? -1 -2 -3 + ghil-unquote-env ghil-unquote-loc ghil-unquote-exp make-ghil-ref ? -1 -2 -3 + ghil-ref-env ghil-ref-loc ghil-ref-var make-ghil-set ? -1 -2 -3 -4 + ghil-set-env ghil-set-loc ghil-set-var ghil-set-val make-ghil-define ? -1 -2 -3 -4 + ghil-define-env ghil-define-loc ghil-define-var ghil-define-val make-ghil-if ? -1 -2 -3 -4 -5 + ghil-if-env ghil-if-loc ghil-if-test ghil-if-then ghil-if-else make-ghil-and ? -1 -2 -3 + ghil-and-env ghil-and-loc ghil-and-exps make-ghil-or ? -1 -2 -3 + ghil-or-env ghil-or-loc ghil-or-exps make-ghil-begin ? -1 -2 -3 + ghil-begin-env ghil-begin-loc ghil-begin-exps make-ghil-bind ? -1 -2 -3 -4 -5 + ghil-bind-env ghil-bind-loc ghil-bind-vars ghil-bind-vals ghil-bind-body make-ghil-lambda ? -1 -2 -3 -4 -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 make-ghil-inline ? -1 -2 -3 -4 + ghil-inline-env ghil-inline-loc ghil-inline-inline ghil-inline-args make-ghil-call ? -1 -2 -3 -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 make-glil-vars + glil-vars-nargs glil-vars-nrest glil-vars-nlocs glil-vars-nexts make-glil-asm ? -1 -2 -3 -4 -5 + glil-asm-vars glil-asm-body make-glil-bind ? -1 + glil-bind-vars make-glil-unbind ? make-glil-source ? -1 -2 + glil-source-loc make-glil-void ? make-glil-const ? -1 + glil-const-obj make-glil-argument ? -1 -2 + glil-argument-op glil-argument-index make-glil-local ? -1 -2 + glil-local-op glil-local-index make-glil-external ? -1 -2 -3 + glil-external-op glil-external-depth glil-external-index make-glil-module ? -1 -2 -3 + glil-module-op glil-module-module glil-module-index make-glil-label ? -1 + glil-label-label make-glil-branch ? -1 -2 + glil-branch-int glil-branch-label make-glil-call ? -1 -2 + glil-call-int glil-call-nargs )) (define-record ( nargs nrest nlocs nexts))