Como incluir metaprogramação em um curso de Paradigmas de Programação?
:-)
Na última aula de Paradigmas mostrei como implementar (de maneira pouco
eficiente e bem simplória) casamento de padrões em Common Lisp.
Uma macro mais algumas funções auxiliares transformam
(def ackermann
0 n -> (1+ n)
m 0 -> (ackermann (1- m) 1)
m n -> (ackermann (1- m) (ackermann m (1- n))))
em
(defun ackermann (m n) ; note que a macro advinhara os parametros
(cond ((AND (equalp m 0)) (1+ n))
((AND (equalp n 0)) (ackermann (1- m) 1))
((AND) (ackermann (1- m) (ackermann m (1- n))))))
Note que (AND) vale T.
Foi divertido...
Na maior parte do curso usamos Haskell, mas também muito Common Lisp.
Para quem quiser dar uma olhada, segue anexo. Dá uma aula legal sobre
metaprogramação. (É interessante também notar que outras linguagens
também tem suporte a metaprogramação -- Tcl, Forth e Prolog, por exemplo.
Prolog é bem peculiar, com assert/retract/clause, etc.)
J.
#|
| Agora implementaremos uma macro que define funcoes. Parecida
| com DEFUN, mas com casamento de padroes (muito limitado).
| Por exemplo, poderemos definir a funcao de Ackerman assim:
|
| (def ackermann
| 0 n -> (1+ n)
| m 0 -> (ackermann (1- m) 1)
| m n -> (ackermann (1- m) (ackermann m (1- n))))
|
| Nossa macro DEF traduzira isso para
|
| (defun ackermann (m n) ; note que a macro advinhara os parametros
| (cond ((AND (equalp m 0)) (1+ n))
| ((AND (equalp n 0)) (ackermann (1- m) 1))
| ((AND) (ackermann (1- m) (ackermann m (1- n))))))
|
|
| Regras:
|
| - O ultimo padrao deve necessariamente conter todos os parametros
| (m e n neste caso)
| - So uma forma apos o ->
| - Cada padrao contem simbolos ou expressoes (0, m e n na funcao
| Ackermann)
|#
;; Uma funcao auxiliar:
(defun drop-n (n lst)
"Remove os n primeiros elementos de uma lista"
(if (or (eql n 0)
(null lst))
lst
(drop-n (1- n) (cdr lst))))
;; O trabalho pesado esta aqui!
(defun split-body-aux (body args acc)
"Dados tres argumentos:
- Um corpo de funcao na forma
'(3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL)
- Uma lista com os simbolos usados em cada posicao
(neste caso, (a b c)
- Um acumulador)
Esta funcao vai recursivamente olhar para cada linha do corpo,
e transforma-lo em algo do tipo:
(((AND (EQUALP A 3)) (PPRINT B))
((AND (EQUALP B 2)) (TERPRI))
((AND) NIL))
O acumulador e usado para passar para a proxima chamada recursiva as
linhas ja transformadas."
(if (not (null body))
(let ((case ())
(code (nth (1+ (length args)) body)))
;; O loop percorre os argumentos:
(loop for i from 0 to (1- (length args)) do
(let ((formal-arg (nth i args)) ; Parametro formal (da lista "args")
(actual-arg (nth i body))) ; Parametro real (usado nesta linha)
;; Se o parametro for um simbolo, nao o usaremos ainda no COND...
;; Mas se nao for um simbolo, e uma expressao e deve ser comparada
com
;; o argumento formal ( "EQUALP x expressao" )
(when (not (symbolp actual-arg))
(push (list 'equalp formal-arg actual-arg) case))))
;; Ja temos uma lista de "EQUALP's" para esta linha, constituindo um
;; caso do COND. Agora vamos para a proxima:
(let ((newacc (append acc (list (list (append '(AND) case) code)))))
(split-body-aux (drop-n (+ 2 (length args)) body) args newacc)))
acc))
;; Verifique a expansao:
(pprint (split-body-aux '(3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL)
'(a b c)
'(cond-plus-code) ) )
(defun get-args (body)
"Dado um corpo de funcao na forma
3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL
Esta funcao retorna uma lista com os simbolos usados como nomes de
argumento. Neste caso, (a b c)."
(let ((nargs (position '-> body)))
(values (drop-n (- (length body) nargs 2)
(reverse (rest (rest (reverse body)))))
nargs)))
;; Teste:
(get-args '(3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL))
(defun split-body (body)
"Esta funcao vai tomar o corpo da definicao da funcao, como por exemplo
3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL
E transformar em um COND:
(COND ((and (equalp a 3)) (pprint b))
((and (equal b 2)) (terpri))
((and) NIL))
Note que (and) e o mesmo que true, portanto serve como caso default para o
COND."
(let* ((args (get-args body))
(cond-body (split-body-aux body args () )))
(push 'cond cond-body)))
;; Teste:
(pprint
(split-body '(3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL)))
;; Nossa macro para definir funcoes:
;; Descobre quais sao os argumentos, transforma o corpo em COND, e
;; devolve um DEFUN.
(defmacro def (name &body body)
(append (list 'defun name (get-args body))
(list (split-body body))))
;; Veja:
(macroexpand-1
'(def func
3 b c -> (pprint b)
a 2 c -> (terpri)
a b c -> NIL)
)
;; O notoriamente familiar fatorial, definido com mdefun,
;; parece Haskell:
(pprint (macroexpand-1
'(def fat 0 -> 1
n -> (* n (fat (1- n))))
))
;; A expansao:
(defun FAT (N)
(cond ((and (equalp N 0)) 1)
((and) (* N (FAT (1- N))))))
;; Uma funcao diferente do fatorial...
(def fato
0 -> 1
n -> (* n n (fato (1- n))))
;; Veja:
(pprint (fat 100))
(pprint (fato 100))
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Lisp-br" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/lisp-br?hl=en
-~----------~----~----~----~------~----~------~--~---
