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:
parent
43e0c29305
commit
2c65f2d5a7
2 changed files with 27 additions and 24 deletions
|
@ -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>))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue