1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00

use common slots mechanism in ghil

* module/system/base/syntax.scm (define-type): Fix getter for common
  slot.

* module/language/ghil.scm (<ghil>): Use the common slots mechanism.
This commit is contained in:
Andy Wingo 2009-02-27 10:53:00 +01:00
parent 43e0c29305
commit 2c65f2d5a7
2 changed files with 27 additions and 24 deletions

View file

@ -24,7 +24,9 @@
#:use-module (system base pmatch) #:use-module (system base pmatch)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:export #:export
(<ghil-void> make-ghil-void ghil-void? (ghil-env ghil-loc
<ghil-void> make-ghil-void ghil-void?
ghil-void-env ghil-void-loc ghil-void-env ghil-void-loc
<ghil-quote> make-ghil-quote ghil-quote? <ghil-quote> make-ghil-quote ghil-quote?
@ -113,31 +115,32 @@
(define (print-ghil x port) (define (print-ghil x port)
(format port "#<ghil ~s>" (unparse-ghil x))) (format port "#<ghil ~s>" (unparse-ghil x)))
(define-type (<ghil> #:printer print-ghil) (define-type (<ghil> #:printer print-ghil
#:common-slots (env loc))
;; Objects ;; Objects
(<ghil-void> env loc) (<ghil-void>)
(<ghil-quote> env loc obj) (<ghil-quote> obj)
(<ghil-quasiquote> env loc exp) (<ghil-quasiquote> exp)
(<ghil-unquote> env loc exp) (<ghil-unquote> exp)
(<ghil-unquote-splicing> env loc exp) (<ghil-unquote-splicing> exp)
;; Variables ;; Variables
(<ghil-ref> env loc var) (<ghil-ref> var)
(<ghil-set> env loc var val) (<ghil-set> var val)
(<ghil-define> env loc var val) (<ghil-define> var val)
;; Controls ;; Controls
(<ghil-if> env loc test then else) (<ghil-if> test then else)
(<ghil-and> env loc exps) (<ghil-and> exps)
(<ghil-or> env loc exps) (<ghil-or> exps)
(<ghil-begin> env loc exps) (<ghil-begin> exps)
(<ghil-bind> env loc vars vals body) (<ghil-bind> vars vals body)
(<ghil-mv-bind> env loc producer vars rest body) (<ghil-mv-bind> producer vars rest body)
(<ghil-lambda> env loc vars rest meta body) (<ghil-lambda> vars rest meta body)
(<ghil-call> env loc proc args) (<ghil-call> proc args)
(<ghil-mv-call> env loc producer consumer) (<ghil-mv-call> producer consumer)
(<ghil-inline> env loc inline args) (<ghil-inline> inline args)
(<ghil-values> env loc values) (<ghil-values> values)
(<ghil-values*> env loc values) (<ghil-values*> values)
(<ghil-reified-env> env loc)) (<ghil-reified-env>))

View file

@ -50,7 +50,7 @@
`(define (,(symbol-append (trim-brackets name) `(define (,(symbol-append (trim-brackets name)
'- common-slot) '- common-slot)
x) x)
(struct-ref x i))) (struct-ref x ,i)))
common-slots (iota (length common-slots))))))) common-slots (iota (length common-slots)))))))