A seguir está um exemplo de implementação bem simplificada de um criador de objetos em Scheme (Chicken Scheme).
Considerações:
- Objetos são representados por closures que aceitam mensagens para acesso a atributos internos.
- Em Scheme, funções (procedures) são objetos de primeira classe, ou seja, podem ser manipuladas como qualquer outro tipo de valor (e.g., números, strings). Assim, uma "chamada de método" nesse sistema de objetos exemplo corresponde ao acesso a um atributo cujo valor é uma função.
(use (srfi 1))
(define (cria-ponto)
(letrec
((atributos
`((pos-x . 0)
(pos-y . 0)
(posicao . ,(lambda ()
(cons (this 'pos-x)
(this 'pos-y)
)))))
(this (lambda (var)
(alist-ref var atributos))))
(lambda args
(if (null? args)
(error "Nenhuma mensagem.")
(let ((acao (car args)))
(case acao
((set!) (let ((atributo (cadr args))
(valor (caddr args)))
(alist-update! atributo valor
atributos)
(void)))
((get) (let ((atributo (this (cadr args))))
(or atributo
(error "Atributo inexistente."))))
(else (error "Mensagem nao conhecida."))
))))))
A função
cria-ponto retorna um objeto ponto, o qual é representado por uma função que aceita um número arbitrário de argumentos, que correspondem a mensagens. Os atributos do objeto são declarados na alist atributos, com um valor inicial. Um dos atributos (posicao) é uma função, que retorna um par representando as coordenadas do ponto.A criação de um objeto ponto é feita com a avaliação da expressão
(cria-ponto):(define ponto (cria-ponto))
ponto, então, passa a representar um objeto ponto, o qual aceita mensagens. Alguns exemplos:csi> (define ponto (cria-ponto))
csi> (ponto 'get 'pos-x)
0
csi> (ponto 'get 'pos-y)
0
csi> (ponto 'set! 'pos-y 10)
csi> (ponto 'get 'pos-y)
10
csi> (ponto 'get 'posicao)
#<procedure (?)>
csi> ((ponto 'get 'posicao))
(0 . 10)
Algumas mensagens causam alteração nos objetos (i.e.,
set!). Como a representação de pontos é feita com closures, a alteração do estado interno de um objeto não deve alterar o dos outros:csi> (define outro-ponto (cria-ponto))
csi> (outro-ponto 'get 'pos-x)
0
csi> (outro-ponto 'set! 'pos-x 15)
csi> ((outro-ponto 'get 'posicao))
(15 . 0)
csi> ((ponto 'get 'posicao))
(0 . 10)
A implementação de introspecção pode ser feita com a implementação tratadores para duas novas mensagens:
tipo e atributos, ou seja, fazemos com que objetos ponto respondam a mensagens tipo e atributos:(use (srfi 1))
(define (cria-ponto)
(letrec
((tipo 'ponto)
(atributos
`((pos-x . 0)
(pos-y . 0)
(posicao . ,(lambda ()
(cons (this 'pos-x)
(this 'pos-y)
)))))
(this (lambda (var)
(alist-ref var atributos))))
(lambda args
(if (null? args)
(error "Nenhuma mensagem.")
(let ((acao (car args)))
(case acao
((set!) (let ((atributo (cadr args))
(valor (caddr args)))
(alist-update! atributo valor
atributos)
(void)))
((get) (let ((atributo (this (cadr args))))
(or atributo
(error "Atributo inexistente."))))
((tipo) tipo)
((atributos) atributos)
(else (error "Mensagem nao conhecida."))
))))))
Para obter as informações de tipo e atributos do objeto ponto, então:
csi> (define ponto (cria-ponto))
csi> (ponto 'tipo)
ponto
csi> (ponto 'atributos)
((pos-x . 0) (pos-y . 0) (posicao . #<procedure (?)>))
Para a implementação de um simples mecanismo de herança, fazemos com que a função criadora de objetos passe a aceitar uma lista de ancestrais, e incorpore a lista de atributos dos ancestrais aos atributos do objeto sendo criado. O exemplo a seguir mostra a criação de um objeto representando um ponto em três dimensões, aproveitando características de um ponto em duas dimensões (
pos-x e pos-y):(use (srfi 1))
(define (cria-ponto-3D . pais)
(letrec
((tipo 'ponto-3D)
(tipos (cons tipo
(map (lambda (pai)
(pai 'tipo))
pais)))
(supers (apply append
(map (lambda (pai)
(pai 'atributos))
pais)))
(atributos
`((pos-z . 0)
(posicao . ,(lambda ()
(list (this 'pos-x)
(this 'pos-y)
(this 'pos-z)
)))))
(this (lambda (var)
(or (alist-ref var atributos)
(alist-ref var supers)))))
(lambda args
(if (null? args)
(error "Nenhuma mensagem.")
(let ((acao (car args)))
(case acao
((set!) (let ((atrib (cadr args))
(valor (caddr args)))
(if (alist-ref atrib atributos)
(alist-update! atrib valor
atributos)
(alist-update! atrib valor
supers))
(void)))
((get) (let ((atributo (this (cadr args))))
(or atributo
(error "Atributo inexistente."))))
((tipo) tipo)
((atributos) (append supers atributos))
((is-a?) (lambda (t)
(not (not (memq t tipos)))))
(else (error "Mensagem nao conhecida."))
))))))
O objeto ponto 3D incorpora as características de seus ancestrais e adiciona uma nova:
pos-z, além de responder mensagens novas, como is-a?.csi> (define ponto-3D (cria-ponto-3D ponto))
csi> (ponto-3D 'tipo)
ponto-3D
csi> ((ponto-3D 'is-a?) 'ponto)
#t
csi> ((ponto-3D 'is-a?) 'ponto-3D)
#t
csi> ((ponto-3D 'is-a?) 'ponto-4D)
#f
É possível generalizar a função criadora de objetos para que ela receba como argumentos o tipo, os atributos e os ancestrais dos objetos a serem criados:
(use (srfi 1))
(define-macro (cria tipo atributos pais)
`(letrec
((tipo ,tipo)
(tipos (cons ,tipo
(map (lambda (pai)
(pai 'tipo))
,pais)))
(supers (apply append
(map (lambda (pai)
(alist-copy (pai 'atributos)))
,pais)))
(atributos ,atributos)
(this (lambda (var)
(or (alist-ref var atributos)
(alist-ref var supers)))))
(lambda args
(if (null? args)
(error "Nenhuma mensagem.")
(let ((acao (car args)))
(case acao
((set!) (let ((atrib (cadr args))
(valor (caddr args)))
(if (alist-ref atrib atributos)
(alist-update! atrib valor
atributos)
(alist-update! atrib valor
supers))
(void)))
((get) (let ((atributo (this (cadr args))))
(or atributo
(error "Atributo inexistente."))))
((tipo) tipo)
((atributos) (append supers atributos))
((is-a?) (lambda (t)
(not (not (memq t tipos)))))
(else (error "Mensagem nao conhecida."))
))))))
csi> (define obj (cria 'ponto
---> `((pos-x . 0)
---> (pos-y . 0)
---> (posicao . ,(lambda ()
---> (cons (this 'pos-x)
---> (this 'pos-y)))))
---> '()))
csi>
csi> (obj 'get 'pos-x)
0
csi> (obj 'set! 'pos-x 30)
csi> (obj 'get 'pos-x)
30
csi> (obj 'tipo)
ponto
csi> ((obj 'is-a?) 'ponto)
#t
csi> ((obj 'is-a?) 'ponto00)
#f
csi>
csi> (define obj2 (cria 'ponto-3D
---> `((pos-z . 0)
---> (posicao . ,(lambda ()
---> (list (this 'pos-x)
---> (this 'pos-y)
---> (this 'pos-z)))))
---> (list obj)))
csi>
csi> ((obj2 'is-a?) 'ponto)
#t
csi> (obj2 'get 'pos-x)
30
csi> (obj2 'set! 'pos-x 90)
csi> (obj 'get 'pos-x)
30
csi> (obj2 'get 'pos-x)
90
csi> ((obj2 'get 'posicao))
(90 0 0)
O sistema de objetos mostrado aqui não utiliza classes para a representação de características de objetos. As características de objetos são representadas em uma função geradora de objetos. A herança utiliza objetos para a representação de ancestrais, não classes, havendo a clonagem dos objetos usados como ancestrais. A ordem para resolução de atributos é a ordem de passagem de ancestrais na criação de objetos, ou seja, se dois ancestrais possuem um atributo comum, o atributo do primeiro antecestral será o usado pelo objeto filho.
3 comentários:
Post muito interessante, Mário, muito educativo. Só uma dúvida tangencial: o quasiquote em cria-ponto não retorna uma referência sempre para a mesma alist? Eu imaginava que o R5RS pedia isso.
Alô Alex!
Sim, mas cada closure retornada por cria-ponto tem sua alist.
A definição de cria-ponto é, na verdade (define cria-ponto (lambda () ... (letrec ...))) (compactada na forma (define (cria-ponto) (letrec ...))). Os objetos compartilhariam os mesmos atributos (semelhante a "variáveis de classe") se a definição fosse (define cria-ponto (letrec ...)). Neste caso, todos os objetos ficariam com a referência para a mesma alist.
Um abraço.
E eu estava, acidentalmente, procurando exatamente algo do gênero deste post (ainda mais, em Chicken)
Postar um comentário