Time is always critical because somebody might beat you to the punch
Founders at Work, Jessica Livingston
val (a,b) = (1,2)
a: Int = 1
b: Int = 2
by Leonardo Varuzza (noreply@blogger.com) at October 23, 2008 06:55 PM
There will be presentations about Lisp in the V Latin America Conference on Free Software, via call-with-hopeless-continuation.
| 15h-16h | Usando Common Lisp no Dia-a-dia | Pedro Ribeiro Kroger Junior |
| 16h-17h | Chicken - Uma Implementação de Scheme para Aplicações Práticas | Mario Domenech Goulart |
| 17h-18h | CL-Weblocks - Programando Aplicações Web com Blocos | Vilson Vieira da Silva Junior |
Meroon is a Scheme object system by Christian Queinnec. It is portable, fast, CLOS-like and reflexive. The Meroon home page cites versions for several popular Scheme systems, including Gambit-C. But the links to the Gambit-C version are broken. Doing a bit of research, that actually involved some guessing, I found the Meroon Gambit-C port in Bradley Lucier’s home page. Instructions to build this Meroon port can be found in this thread in the Gambit-C mailing list.
I am not a heavy user of object orientation, but I can certainly see its value where it is worth. In the LiSP book, for instance, a beautiful interpreter and a compiler are written in OO-style, in chapter 3 and 10, respectively. Another example is writing a scene graph for a Computer Graphics application, it almost begs to be written object-oriented.
Para testar algumas coisas refiz hoje o código do post Common Lisp e Ajax. Desta vez estou usando o patch para o HT-AJAX com suporte e jQuery. Além disso, para gerar código JavaScript uso Parenscript. Assim todo HTML e JS é produzido por s-exps:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *dependencies*
‘(:asdf :hunchentoot :ht-ajax :cl-who :parenscript))
(map nil ‘require *dependencies*))
(defpackage :ajax-test
(:use :common-lisp :hunchentoot :ht-ajax :cl-who :parenscript))
(in-package :ajax-test)
(defparameter *local-dir* “/Users/lucindo/Documents/Lisp/web/3rdparty/”)
(defparameter *ajax-handler-url* “/ajax”)
(defparameter *ajax-processor*
(make-ajax-processor :type :jquery
:server-uri *ajax-handler-url*
:js-file-uris “/static/jquery.js”))
(defun testfunc (command)
(prin1-to-string (handler-case (eval (read-from-string command nil))
(error (c) (format nil “~a” c)))))
(defun js ()
(ps
(defun command_clicked ()
(let ((command (document.get-element-by-id “command”)))
(with-slots (value) command
(ajax_testfunc_set_element “result” value))))))
(defun main-page ()
(with-html-output-to-string
(*standard-output* nil :prologue t)
(:html
(:head
(:script :type “text/javascript” :src “/js”)
(:title “AJAX test”)
(fmt “~a” (generate-prologue *ajax-processor*)))
(:body
(:h1 “ajax test”)
(:table :width “50%”
(:tr
(:td :colspan “2″
(:span :id “result”
(:i “no results yet”))))
(:tr
(:td :width “70%”
(:input :type “text”
:size “70″
:name “command”
:id “command”))
(:td (:input :type “button”
:value “eval”
:onclick (ps-inline (command_clicked))))))))))
(eval-when (:load-toplevel :execute)
(export-func *ajax-processor* ‘testfunc :method :post)
(setf *dispatch-table*
(list ‘dispatch-easy-handlers
(create-folder-dispatcher-and-handler “/static/”
*local-dir* “text/plain”)
(create-prefix-dispatcher *ajax-handler-url*
(get-handler *ajax-processor*))
(create-prefix-dispatcher “/js” ‘js)
(create-prefix-dispatcher “/” ‘main-page))))
(defparameter *webserver* nil)
(defun start-web (&optional (port 4242))
(setf *webserver* (start-server :port port)))
(defun stop-web ()
(stop-server *webserver*))
Download: ajax2.lisp
Há algum tempo eu desisti de Ruby. Como linguagem de programação tem coisas muito legais, mas ainda é muito imatura (apesar da idade). Poderia mostrar vários exemplos de coisas estranhas em Ruby, mas hoje vai a causa de um bug que me mostraram.
Veja se o defined? não funciona de maneira não intuitiva:
lucindo@marvin:~$ irb irb(main):001:0> defined?(cu) => nil irb(main):002:0> if false irb(main):003:1> cu = "ruby" irb(main):004:1> end => nil irb(main):005:0> defined?(cu) => "local-variable" irb(main):006:0> if defined?(cu) irb(main):007:1> puts "ruby cu" irb(main):008:1> end ruby cu => nil irb(main):009:0>
Imagina se você usa isso em algo como configuração…
Nos últmos dias me reanimei a voltar a postar nesse blog.
Estou tentando mudar para Python como a minha principal linguagem de script, mas ainda preciso aprender a programar direito nessa linguagem. Enquanto isso não acontece, eu fico replicando código de outros lugares, como a cópia de pobre da ACE_Task abaixo:
import threading, Queue, signal
class Task(object):
def __init__(self):
self.queue = Queue.Queue(0)
def __worker(self):
while True:
item = self.queue.get()
self.process(item)
self.queue.task_done()
def __start(self):
thread = threading.Thread(target=self.__worker)
thread.setDaemon(True)
thread.start()
def activate(self, threads):
for thread in xrange(threads):
self.__start()
signal.signal(signal.SIGINT, signal.SIG_DFL)
def put(self, item):
self.queue.put(item)
def wait(self):
self.queue.join()
def process(self, item):
pass
class task(Task):
def __init__(self, func):
Task.__init__(self)
self.process = func
A única coisa pytônica do código é o decorator do final.
Bom, um exemplo de uso: digamos que você é um spammer e quer mandar vários emails. Você tem um arquivo em que cada linha tem as seguintes informações: servidor; email; subject; mensagem. Tudo separado por ponto e vírgula.
Usando o decorator acima o código ficaria mais ou menos assim (usando 100 threads):
from __future__ import with_statement
from task import task
import smtplib, sys
@task
def send_spam(item):
server, toaddr, subject, msg = item.strip().split(‘;’)
fromaddr = ’spammer@evil.org’
message = (“From: %s\r\nTo: %s\r\nSubject: %s\r\n\r\n%s”
% (fromaddr, toaddr, subject, msg))
try:
smtp = smtplib.SMTP(server)
smtp.sendmail(fromaddr, toaddr, message)
except Exception:
pass
def process_file(filename):
send_spam.activate(100)
with open(filename) as file:
map(lambda line: send_spam.put(line), file.readlines())
send_spam.wait()
if __name__ == ‘__main__’:
process_file(sys.argv[1])
Coloquei esse exemplo porque não tinha um melhor… é apenas um exemplo, não um programa de verdade, ok? 
Download: task.py
To do: reescrever em Python 2.6 usando Multiprocessos
Só porque esse blog está muito parado:
Eight years to do TeX? How smart can he be? He should have used Lisp.
Kenny Tilton, sobre Donald Knuth
I have found a very interesting thread in the Gambit-C Scheme mailing list. Marc Feeley tries to dismiss the myth that floating-point calculations are inherently faster in C/C++ than in Scheme, which is taken as common wisdom. The the work of Bradley Lucier is cited as a case of very fast numerical Scheme code.
Bradley himself replies, in which he explains that his code is roughly half as fast as it would have been if coded in C, but the memory bandwidth is the culprit and it does not matter anyway. An interesting part of the email is this:
I didn’t mind rewriting the level-1 BLAS code in Scheme, however, as it didn’t seem worth the trouble to get a small speedup in the entire system just to use a dot-product or saxpy written in C and called from an FFI. I have enough difficulty in getting students to admit to themselves that, yes, this system is fast (just about as fast as any expert could have written it, and probably much faster than your average graduate student could have written it) and it’s flexible (it’s only at the end of the course that some students reluctantly admit that they could not have finished their semester project in their favorite language, whether C or C++), and that the speed doesn’t arise from level-1 BLAS written in C (because they’re written in Scheme). One point that most students seem to take away from the class is that multigrid is one hell of a lot faster than conjugate gradient, and many of them have been using conjugate gradient in their own projects simply because it’s too hard to program multigrid in C or C++ (at least the first time you try it). So one gets a lot of speedup simply by being able to program more sophisticated algorithms.
There is also a toy ray-tracer written in Gambit-C, Schemeray, which was further optimised by Marc Feeley, and even more by (again) Bradley Lucier. The times are impressive, thanks to all the clever compiler tricks Gambit-C uses when generating C code, like inlining, partial code evaluation and generating one C function per Scheme module (avoiding expensive inter-module C calls).
The code generated by Gambit-C is fast enough for 99.99% of the applications out there. And this is using a strong, dynamically-typed language, with first-class closures and continuations, arbitrary-precision numbers, and the powerful macros of the Lisp family of languages. There is hardly need to use C or C++ even in the most demanding applications. The same cannot be said of Perl, Python or Ruby, whose applications usually run much slower than one created with Gambit-C. And, if the need really arises, interfacing Gambit-C with C code is extremely easy.
But there are out there things like this:
We don’t really care about the title but we want someone good (who doesn’t?). We need someone able to model and code well (No architect who never codes). The ability to communicate well with a team is also a big plus. You don’t need to speak French (we are in France) but a reasonably good English is mandatory.
If You:
The boss really codes. He likes Haskell, Python, Reddit, and wants the team to be there for the long run (i.e. happy). He also modestly wrote and posted this jobs offer.
So let me see: Haskell, games, and Computer Graphics. How sweet. Also, note the emphasis on how the boss and “architects” still code. In underdeveloped places, coding is just for drones, and bosses and “architects” can’t do it to save their lives.
$ ldap-groups.scm -h
Uso: ldap-groups.scm -h | -a <user> <group> | -l <group> | -g <user>
-a : adiciona <user> ao grupo <group> (cria <group> se nao existir)
-l : lista os usuarios do grupo <group>
-g : lista os grupos a que pertence o usuario <user>
admin:
$ ldap-groups.scm -l admin
mario
joao
$ ldap-groups.scm -g mario
sgpc
admin
printer:
$ ldap-groups.scm -a mario printer
(use posix srfi-13)
(define (system-output . command)
(let ((cmd (string-intersperse (map ->string command))))
(read-all (open-input-pipe (sprintf "~A 2>&1" cmd)))))
(define *groups-data* #f)
(define (set-groups-data!)
(set! *groups-data*
;; lista de listas (("grupo" "user1" "user2" ... "usern"))
(let ((data (with-input-from-string
(cadr (string-split-fields
"Group Entries\n"
(system-output "cpu cat")
infix:))
read-lines)))
(map (lambda (line)
(let ((ldata (string-split line ":")))
(cons (car ldata) ;; nome do grupo
(let ((users (cdddr ldata))) ;; usuarios
(if (null? users)
'()
(map
string-trim-both
(string-split (car users) ",")))))))
data))))
(define (get-groups user)
(let ((user-groups '()))
(for-each (lambda (group/users)
(when (member user (cdr group/users))
(set! user-groups
(cons (car group/users) user-groups))))
*groups-data*)
user-groups))
(define (group-exists? group)
(not (not (alist-ref group *groups-data* equal?))))
(define (get-users group)
(alist-ref group *groups-data* equal?))
(define (add-user-to-group! user group)
(unless (group-exists? group)
(let ((cmd (conc "cpu groupadd " group)))
(print cmd)
(system-output cmd)))
(let ((cmd (conc "cpu usermod " user " -G "
(string-intersperse
(cons group (get-groups user)) ","))))
(print cmd)
(system-output cmd)))
(define (usage #!optional exit-code)
(print #<#EOF
Uso: #(program-name) -h | -a <user> <group> | -l <group> | -g <user>
-a : adiciona <user> ao grupo <group> (cria <group> se nao existir)
-l : lista os usuarios do grupo <group>
-g : lista os grupos a que pertence o usuario <user>
EOF
)
(when exit-code
(exit exit-code)))
(let ((args (command-line-arguments)))
(when (null? args)
(usage 1))
(set-groups-data!)
(cond ((member (car args) '("-h" "--help" "-help"))
(usage))
((member "-a" args)
(add-user-to-group! (cadr args) (caddr args)))
((member "-l" args)
(map print (or (get-users (cadr args)) '())))
((member "-g" args)
(map print (or (get-groups (cadr args)) '())))
(else (usage 1))))
by mario (noreply@blogger.com) at September 04, 2008 06:32 AM
There is a recurrent angst I feel every time I think I could be working daily in a decent programming language. Usually the management people believe the choice of programming language is irrelevant, but we developers know better. Languages shape our thoughts.
Today I found an interesting post about getting work using non-mainstream languages.
Well, unlike Java jobs or C# jobs or VB jobs, where one can scan the newspaper or go to dice.com, these magical jobs are not the ones I get when recruiters solicit me (three times a day). No, they appear between the cracks of the sky when it rends in two. All but one contract (that did come from dice.com) came from the company CEO pulling me aside or phoning me out of the blue from the materials I had published inside the company where I was employed, or from my web-sites on programming languages.
This basically means you must be a reference. You must blog a lot or, better yet, write even a book. When your name is said in a company meeting, somebody of the team must already have heard of you. Needless to say, this is not easy at all.
Usually and because of the exclusivity of the work it takes anywhere from at least 3 months to 2 years to secure these kinds of contracts, so the adage “Don’t quit your day job” is an appropriate one here. When I do get these contracts, however, they usually last longer (3 years) than the Java/C++/XML/web-services-code-grinder ones (that usually last around 6 months), and the peer group is much more intelligent, genteel and just plain more interesting than the code-grinding crowd. Is is harder to find these magical contracts? Yes, they are rarified air. But are they worth preparing for and then finding? Definitely.
Here we see that even after all this work, it is still very hard to find these dream jobs. You can wait as long as two years to get one, simply because in most companies the management employ Java/C#/VB drones anyway, as they are cheaper and easier to find. Only when they face really hard problems they start thinking of alternatives.
This post only reinforces what was already in the back of my mind for a while: The least hard way to earn money and be happy at the same time is to start an own business. Now if I could only move my lazy ass…
by Leonardo Varuzza (noreply@blogger.com) at August 17, 2008 08:53 PM
-:aNUMBER, onde NUMBER é o número de chamadas a ser mostrado (http://chicken.wiki.br/Using%20the%20compiler#runtime-options).(define (l) (error 'oops))
(define (k) (l))
(define (j) (k))
(define (i) (j))
(define (h) (i))
(define (g) (h))
(define (f) (g))
(define (e) (f))
(define (d) (e))
(define (c) (d))
(define (b) (c))
(define (a) (b))
(a)
$ csi -s oops.scm
Error: oops
Call history:
[e] (f)
[f] (g)
[g] (h)
[h] (i)
[i] (j)
[j] (k)
[k] (l)
[l] (error (quote oops)) --
l foi a. Mas, se aumentarmos o tamanho do relatório:
$ csi -:a14 -s oops.scm
Error: oops
Call history:
(a)
(a)
[a] (b)
[b] (c)
[c] (d)
[d] (e)
[e] (f)
[f] (g)
[g] (h)
[h] (i)
[i] (j)
[j] (k)
[k] (l)
[l] (error (quote oops)) --
-:aNUMBER também é válido para programas compilados com o compilador de Chicken (csc):
$ csc oops.scm
$ ./oops
Error: oops
Call history:
oops.scm: 8 f
oops.scm: 7 g
oops.scm: 6 h
oops.scm: 5 i
oops.scm: 4 j
oops.scm: 3 k
oops.scm: 2 l
oops.scm: 1 error --
$ ./oops -:a14
Error: oops
Call history:
oops.scm: 14 a
oops.scm: 12 b
oops.scm: 11 c
oops.scm: 10 d
oops.scm: 9 e
oops.scm: 8 f
oops.scm: 7 g
oops.scm: 6 h
oops.scm: 5 i
oops.scm: 4 j
oops.scm: 3 k
oops.scm: 2 l
oops.scm: 1 error --
db-repl.scm usa como argumentos não interativos (opcionais) o usuário do banco de dados, o nome do host e a base de dados, os quais devem ser fornecidos no seguinte formato:<usuario>@<host>/<base de dados>
toplevel-command). Na implementação mostrada abaixo, são definidos três comandos:tables: mostras as tabelas da base de dados.table: mostra estrutura da tabela dada como argumento (nome e tipo das colunas e se podem ou não ser nulas).-: executa a consulta SQL dada como argumento.csi -s db-repl.scm mario@localhost/sgpc
Senha: *****
#;1> ,tables
perms
news
users_sites
ticket_comments
ticket_attachments
obj_type
acervos
autores
videos
audios
images
objects
texts
scanners
users
wiki
sites
tickets
#;1> ,table news
news_id integer NO
user_id integer NO
site_id integer NO
timestamp timestamp without time zone YES
title character varying(100) NO
news text YES
#;1> ,- select * from news
(#(2
1
1
#(2008 7 30 19 37 54 271625)
"Teste."
"teste
=== titulo")
#(3
1
1
#(2008 7 30 19 40 27 180765)
"Outra notícia!"
"Aqui vai o texto da notícia.
[[image:http://subversion.tigris.org/branding/images/logo.gif|Logo]]"))
pg-repl:conn armazena o objeto que representa a conexão com o banco de dados, de forma que ele pode ser usado pelos procedimentos do egg postgresql para a execução de consultas:
#;1> (define query "select * from news")
#;2> (vector-ref (car (pg:query-tuples query (pg-repl:conn))) 3)
#(2008 7 30 19 37 54 271625)
db-repl.scm) está a seguir:(use utils postgresql readline stty regex (srfi 13))
(define pg-repl:conn (make-parameter #f))
(define (pg-repl:query . query)
(pg:query-tuples
(string-intersperse (map ->string query) "")
(pg-repl:conn)))
(toplevel-command
'-
(lambda ()
(pp (pg-repl:query
(with-output-to-string
(cut print (read-line)))))))
(toplevel-command
'table
(lambda ()
(let* ((table (string-trim-both (read-line)))
(cols
(pg-repl:query
"select column_name,data_type,"
"character_maximum_length,is_nullable "
"from information_schema.columns "
"where table_name = '" table "'")))
(if (null? cols)
(print "Tabela \"" table "\" nao existe.")
(for-each
(lambda (f)
(let ((colname (vector-ref f 0))
(type (vector-ref f 1))
(size (let ((size (vector-ref f 2)))
(if (pg:sql-null-object? size)
""
(conc "(" size ")"))))
(nullable (vector-ref f 3)))
colname
(make-string
(- 30 (string-length colname)))
type size
(make-string
(- 30 (string-length (conc type size))))
nullable)))
cols)))))
(toplevel-command
'tables
(lambda ()
(for-each
(lambda (item)
(print (vector-ref item 0)))
(pg-repl:query
"select table_name from information_schema.tables "
"where table_type = 'BASE TABLE' "
"and table_schema not in "
"('pg_catalog', 'information_schema')"))))
(define (pg-repl:usage #!optional exit-code)
(print (program-name) " [<user>@<server>/<database>]")
(when exit-code (exit exit-code)))
(let ((args (command-line-arguments))
(user "postgres")
(host "localhost")
(db "template")
(passwd #f))
;; Restaura o terminal em caso de termino via C-c
(set-signal-handler! signal/int
(lambda (_) (stty '(echo))))
(unless (or (null? args) (equal? "\"\"" (car args)))
(let* ((cred (string-trim-both
(car args)
(cut memq <> '(#\space #\newline #\")))) ;"
(@tokens (string-split cred "@"))
(/tokens (if (null? @tokens)
'()
(string-split (cadr @tokens) "/"))))
(if (and (null? @tokens) (null? /tokens))
(pg-repl:usage 1)
(begin
(unless (null? @tokens)
(set! user (car @tokens)))
(unless (null? /tokens)
(set! host (car /tokens))
(set! db (cadr /tokens)))))))
(display "Senha: ")
(pg-repl:conn
(pg:connect
`((user . ,user)
(dbname . ,db)
(host . ,host)
(password . ,(with-stty '(not echo) read-line)))))
(current-input-port (make-gnu-readline-port))
(gnu-history-install-file-manager
(string-append (or (getenv "HOME") ".")
"/.csi.history"))
(newline)
(repl))
(defun copy&comment (begin end)
(interactive "r")
(save-excursion
(copy-region-as-kill begin end)
(goto-char end)
(yank)
(comment-region begin end)))
by Leonardo Varuzza (noreply@blogger.com) at July 29, 2008 02:03 PM
by Leonardo Varuzza (noreply@blogger.com) at July 27, 2008 07:33 AM
I do not have strong feelings about XML, be it for or against it. I don’t use it much because I use either S-Expressions with Scheme or Lua tables with Lua. I believe XML can be helpful, but people need to know how to use it.
I have come across an application of XML to store an animation, frame by frame, like the animated GIFs of old. Each frame is then an image, stored as an XML element. The bizarre part is that every pixel is stored as an individual element inside the frame:
<frame id="Frame001" width="180" height="240">
<array type="Int8">
<Int8 value="230"/>
<Int8 value="012"/>
.
.
.
</array>
</frame>
I believe this is the most “by the book” implementation. But this is far from optimal. When inspecting the files with a text editor (yes, I needed to do that) it was very painful. Besides, the files are huge! Why not be sensible and use Base64 encoding for the image part:
<frame id="Frame001" width="180" height="240"> TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz IHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg dGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu dWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo . . . </frame>
Nobody could inspect the information of previous format anyway, the files gets much smaller, one could edit them by hand (like I did to copy frames between animations). And no, the files are not being compressed because they are part of a build process.
It only remains to be seen why it is done this way. I believe it was a mixture of a non-too-intimate knowledge of the technology and a desire to use it in it “purest” form, like those people who must design their programs with all the design patterns known to man. With time they may learn that a sensible dose of pragmatism is very healthy.
by Leonardo Varuzza (noreply@blogger.com) at July 15, 2008 05:18 AM
by Leonardo Varuzza (noreply@blogger.com) at July 13, 2008 06:40 PM
3.141592653589793238462643383279502884197169399375
10582097494459230781640628620899862803482534211706
79821480865132823066470938446095505822317253594081
28481117450284102701938521105559644622948954930381
96442881097566593344612847564823378678316527120190
91456485669234603486104543266482133936072602491412
73724587006606315588174881520920962829254091715364
36789259036001133053054882046652138414695194151160
94330572703657595919530921861173819326117931051185
48074462379962749567351885752724891227938183011949
12983367336244065664308602139494639522473719070217
98609437027705392171762931767523846748184676694051
32000568127145263560827785771342757789609173637178
72146844090122495343014654958537105079227968925892
35420199561121290219608640344181598136297747713099
60518707211349999998372978049951059731732816096318
59502445945534690830264252230825334468503526193118
81710100031378387528865875332083814206171776691473
03598253490428755468731159562863882353787593751957
78185778053217122680661300192787661119590921642019
89380952572010654858632788659361533818279682303019
52035301852968995773622599413891249721775283479131
51557485724245415069595082953311686172785588907509
by Leonardo Varuzza (noreply@blogger.com) at July 13, 2008 06:37 PM
add <reg> <number | reg>: Soma um número ou o conteúdo do registrador usado como segundo argumento com o conteúdo do registrador usado como primeiro argumento. O resultado é armazenado no registrador usado como primeiro argumento.mov <reg> <number | reg>: Armazena o número ou o conteúdo do registrador usado como segundo argumento no registrador usado como primeiro argumento.lbl <label>: Associa um endereço de memória a um rótulo, o qual pode ser referenciado no programa pelas instruções jmp e jnz.jmp <label>: Desvia o fluxo de execução para <label> (uma marca determinada através da instrução lbl).jnz <reg> <label>: Desvia o fluxo de execução para <label> se o conteúdo do registrador usado como primeiro argumento for diferente de zero.out <number | reg>: Imprime o número ou conteúdo do registrador usado como argumento.r1 a r8), nenhum deles com função específica. Há também um registrador somente para leitura (ip) que armazena o endereço de memória da última instrução executada.(mov r1 3)
tiny-assembly.scm):;; Instrucoes:
;; add <reg> <number | reg>
;; mov <reg> <number | reg>
;; jmp <label>
;; jnz <reg> <label>
;; lbl <label>
;; out <number | reg>
;;
;; Registradores: r1..r8
;; Registrador "read-only": ip
(use srfi-1)
(define (run code)
(define memory (map cons (iota (length code)) code))
(define labels '())
(define registers
'((r1 . 0) (r2 . 0) (r3 . 0) (r4 . 0)
(r5 . 0) (r6 . 0) (r7 . 0) (r8 . 0)))
(define ip 0)
(define code-len (length code))
(define (die . msg)
(print "Error: "
(string-intersperse (map ->string msg) ""))
(exit 1))
(define (next-ip)
(set! ip (add1 ip)))
(define (reg-get register)
(alist-ref register registers))
(define (val-get thing)
(if (eq? thing 'ip)
ip
(if (number? thing)
thing
(reg-get thing))))
(define (reg-set! reg val)
(set! registers
(alist-update! reg (val-get val) registers)))
(define (label-address label)
(alist-ref label labels))
(define (add reg val)
(reg-set! reg (+ (reg-get reg) (val-get val))))
(define (mov reg val)
(reg-set! reg (val-get val)))
(define (jmp label)
(let ((address (or (reg-get label)
(label-address label))))
(if address
(set! ip address)
(die "label " label " not found."))))
(define (jnz reg label)
(if (zero? (reg-get reg))
(next-ip)
(jmp label)))
(define (lbl label)
(set! labels (alist-update! label ip labels)))
(define (finished? ip) (>= ip code-len))
(set! labels
(map (lambda (label)
(cons (caddr label) (car label)))
(filter (lambda (expr)
(eq? (cadr expr) 'lbl))
memory)))
(let loop ()
(if (finished? ip)
(exit)
(begin
(let* ((expr (alist-ref ip memory))
(op (car expr))
(arg1 (cadr expr))
(arg2 (and (not (null? (cddr expr)))
(caddr expr))))
(case op
((mov) (mov arg1 arg2))
((add) (add arg1 arg2))
((jmp) (jmp arg1))
((jnz) (jnz arg1 arg2))
((lbl) (noop))
((out) (print
(or (reg-get arg1)
(if (eq? arg1 'ip)
ip
arg1))))
(else (die op ": unknown command.")))
(unless (memq op '(jmp jnz))
(next-ip)))
(loop)))))
;;; Command line parser
(let ((args (command-line-arguments)))
(when (null? args)
(print "Usage: " (program-name) " <input-file>")
(exit 1))
(let ((file (car args)))
(unless (file-exists? file)
(print "Could not open " file)
(exit 1))
(run (handle-exceptions
exn
(die "parse error.")
(with-input-from-file file read-file)))))
(mov r1 7)
(mov r2 4)
(mov r4 ip)
(jmp mul)
(jmp end)
;; Multiplicacao (x * y)
;; x -> r1
;; y -> r2
;; produto -> r3
;; endereco de retorno -> r4
(lbl mul)
(jnz r1 not-zero)
(jmp end)
(lbl not-zero)
(mov r3 0)
(lbl loopmul)
(add r3 r2)
(add r1 -1)
(jnz r1 loopmul)
(add r4 2)
(jmp r4)
(lbl end)
(out r3)
$ csi -s tiny-assembly.scm multiplicacao.asm
28
(mov r5 7) ;; entrada de dados
;; Fatorial
;; entrada -> r5
;; resultado -> r6
(lbl fatorial)
(mov r6 1)
(lbl fat-loop)
(jnz r5 fat-not-0)
(jmp end)
(lbl fat-not-0)
(add r5 -1)
(jnz r5 fat-not-1)
(jmp end)
(lbl fat-not-1)
(add r5 1)
(mov r1 r6)
(mov r2 r5)
(mov r4 ip)
(jmp mul)
(mov r6 r3)
(add r5 -1)
(jmp fat-loop)
;; Multiplicacao (x * y)
;; x -> r1
;; y -> r2
;; produto -> r3
;; endereco de retorno -> r4
(lbl mul)
(jnz r1 mul-not-0)
(jmp end)
(lbl mul-not-0)
(mov r3 0)
(lbl loopmul)
(add r3 r2)
(add r1 -1)
(jnz r1 loopmul)
(add r4 2)
(jmp r4)
(lbl end)
(out r6) ;; imprime o resultado
$ csi -s tiny-assembly.scm fatorial.asm
5040
Acabo de ler o incrível livro do Nobel José Saramago, Ensaio Sobre a Cegueira.
Uma breve resenha encontra-se em aqui.
The XII Brazilian Symposium on Programming Languages is going to be happen in my home city of Fortaleza, on August 27th-29th. The programme looks very promising, with sessions about Software Transaction Memory in Haskell, concurrency with Lua (with the main architect of Lua, Roberto Ierusalimschy from PUC-Rio) and an invited talk of Shriram Krishnamurthi, the author of Programming Languages: Application and Interpretation, among other interesting stuff. I hope to be there, I even get to see my family and my friends. 
(use srfi-1)
(define count-defines
(let* ((definers '(define define-macro define-constant
define-inline define-syntax))
(count-defines
(lambda (file)
(cons file
(length
(filter
(lambda (form)
(and (pair? form)
(memq (car form) definers)))
(with-input-from-file
file read-file)))))))
(lambda (files)
(let ((defines-count (map count-defines files)))
(for-each (lambda (file/defcount)
(print (car file/defcount) ": "
(cdr file/defcount)))
defines-count)
(print "Total: "
(reduce + 0 (map cdr defines-count)))))))
(let ((files (command-line-arguments)))
(if (null? files)
(exit 0)
(count-defines files)))
$ csi -s count-defines.scm count-defines.scm
count-defines.scm: 1
Total: 1
$ csi -s count-defines.scm spiffy/trunk/*.scm
spiffy/trunk/cgi-handler.scm: 5
spiffy/trunk/simple-directory-handler.scm: 4
spiffy/trunk/spiffy-base.scm: 70
spiffy/trunk/spiffy.scm: 1
spiffy/trunk/ssp-handler.scm: 10
spiffy/trunk/web-scheme-handler.scm: 4
Total: 94
car de cada expressão é um dos símbolos define, define-macro, define-constant, define-inline ou define-syntax (se a expressão for um par).export e hide. Outros motivos são que este programa não consegue inferir as definições de toplevel que serão geradas através da expansão de macros (web-scheme, por exemplo, usa esta estratégia) e que não computa definições feitas dentro de blocos cond-expand.Doing some research about compilers, interpreters and virtual machines, I have gathered some bibliography from several resources. Here it is, in no particular order:
And anyway, the subject line presupposes that Lisp has not caught on. This is like saying that astrophysics or calculus or brain surgery has not caught on because in relative numbers, there might be more people doing other things. The success of Lisp is not measured in the number of people using it, it’s measured in the utility to those people who do use it. Turning it into C (or C++ or C#) to make it more popular would not be success. In the world’s menu of computer language options, we don’t need them all to be Taco Bell.
A alguns dias atrás recebi um email do pessoal da Powerset prometendo uma camiseta para quem usasse e abusasse de um de seus serviços, o Factz. Estou atrasado, a campanha termina hoje, mas uma camiseta nova ia bem, então vamos lá!
O objetivo da Powerset é aplicar o processamento de linguagem natural para extrair informação de bases de dados. Se os computadores conseguirem entender nossa língua, então este post não será só mais um amontoado de caracteres, mas sim, será um texto que fala sobre a Powerset, escrito por mim, relacionado ao Factz, enfim, haverá significado, haverá semântica agregada. Web Semântica?! Exato, o processamento de linguagem natural é uma das estratégias que podem ser usadas para chegarmos a ela.
Em maio deste ano a Powerset lançou seu primeiro serviço baseado nesta tecnologia, o Factz. Factz é um serviço de busca para todo o conteúdo disponível na Wikipedia, só que ao invés de buscar por palavras simples, você pode buscar por palavras-chave, frases e até mesmo fazer perguntas! Isso mesmo, Factz é capaz de responder às suas perguntas! Duvida?! Então vamos tentar...
Além de entender sua pergunta, Factz mostra resultados muito mais interessantes, com semântica agregada. Por exemplo, Factz está nos dizendo que John McCarthy inventou Lisp, fundou o Laboratório de Inteligência Artificial de Stanford, já publicou artigos e escreveu livros, ganhou premiações e afins. E ao clicar em algum termo, é mostrado o contexto em que o termo foi citado.
Os resultados retornados por Factz lembram as triplas de RDF: sujeito-relação-objeto. Claro, são relações semânticas! Não poderia ser diferente! Desta forma, Factz aceita perguntas que se baseiam neste formato:
o quê/quem verbo algo
o quê/quem algo verbo
Quem matou JFK? O quê gatos matam? O quê são computadores? São todas perguntas passíveis de resposta em Factz. Mas vamos testar coisas mais interessantes ;-)
BINGO! De primeira! :-)
Estou com medo de me apaixonar pela minha torradeira ;-)
Cérebros, ratos, aranhas, iguanas e outros humanos, claro, os canibais ;-) E por falar neles...
Pessoas, claro, principalmente missionários, bebês e crianças :-)
Deus não tem piedade :-)
Sim, até ele ajudou ;-)
A concorrência é grande... Deus, Lúcifer, aliens, goblins, Einstein e até Tolkien :-)
OK, o próximo não foi um resultado de Factz, mas eu não resisti...
Qual a resposta para a vida, o universo e tudo mais?
Powerset está para nos mostrar grandes resultados em breve. Factz é muito interessante e útil. E eu estou aqui esperando a minha camiseta ;-)
:-)). As credenciais do banco mantenho em um parâmetro (definido com make-parameter). O procedimento é algo como:(define db-credentials (make-parameter '()))
(define (db-query query)
(let* ((db (pg:connect (db-credentials)))
(output (pg:query-tuples query db)))
(pg:close db)
output))
db-query, o acesso a colunas do banco não é das tarefas mais simples. Abaixo está um exemplo em que quero acessar as colunas username e email de uma tabela e associar o valor delas à variáveis em Scheme:(db-credentials '((host . "localhost")
(user . "usuario")
(password . "****")
(dbname . "nome-da-base")))
(let* ((results
(let ((results
(db-query
"select username,email from users where user_id=1")))
(if (null? results)
#f
(car results))))
(username (and results (vector-ref results 0)))
(email (and results (vector-ref results 1))))
(print username)
(print email))
(use postgresql)
(define db-map:credentials (make-parameter '()))
(define db-map:create-object
(let ()
(define (db-query query)
(let* ((db (pg:connect (db-map:credentials)))
(output (pg:query-tuples query db)))
(pg:close db)
output))
(lambda (query fields)
(let* ((query-results (let ((results (db-query query)))
(if (null? results)
#f
(car results)))))
(lambda (field)
(and query-results
(let ((pos (list-index (cut eq? <> field)
fields)))
(vector-ref query-results pos))))))))
db-map:create-object recebe uma query SQL e uma lista de símbolos a serem associados com os valores das colunas obtidos como resultado da execução da query. db-map:create-object retorna um procedimento que recebe como argumento um símbolo representando uma coluna da base de dados e que retorna o valor associado ao símbolo.username e email, faço o seguinte:(let ((obj (db-map:create-object
"select username,email from users where user_id=1"
'(username email))))
(print (obj 'username))
(print (obj 'email)))
Browsing the web today I found an interesting poster about programming paradigms. Interestingly, it puts Java right there with OCaml in the state + closures section, and Java does not have closures. But since there is no OOP in the poster, I assume the author is equaling closures to objects, which according to some is very wise.
mem (criado com o procedimento make-mem) e procedimentos para manipulação desse tipo de objeto: mem-get (para leitura de dados) e mem-set! (para escrita em memória e em disco).(use s11n)
(define (make-mem file)
(cons file (if (file-exists? file)
(with-input-from-file
file
(cut deserialize))
(make-hash-table))))
(define (mem-get mem key #!optional default)
(hash-table-ref/default (cdr mem) key default))
(define (mem-set! mem key val)
(let ((file (car mem))
(data (cdr mem)))
(hash-table-set! data key val)
(with-output-to-file file (cut serialize data))))
(let ((mem (make-mem "teste.data")))
(print (mem-get mem 'a))
(mem-set! mem 'a '(1 2 3))
(print (mem-get mem 'a))
(mem-set! mem 'soma (lambda (a b) (+ a b)))
(print ((mem-get mem 'soma) 2 2)))
teste.data inicialmente não existe):
#f
(1 2 3)
4
As part of my Lisp studies, I have implemented a toy Scheme interpreter in roughly 1000 lines of Lua. It is here. It supports tail-call optimisation, lexical scope for closures, and first-class continuations via call/cc.
I have departed from the traditional approach of implementing a Scheme interpreter in Scheme itself because I wanted to avoid possible confusions between the defined language and the defining language. This has made a lot of the concepts clearer. The evaluator is written in continuation-passing style, which is easily done in Lua because the latter has tail-call optimisations. This way it is easier to reify continuations to first-class values.
I have also added a few primitives to allow me to run some examples, as the factorial and fibonacci functions. More primitives can be easily added if desired.
HT-AJAX (documentação aqui) é uma extenção do Hunchentoot que permite exportar suas funções lisp de modo que elas podem ser acessadas via JavaScript, usando AJAX. Um pequeno exemplo de uso dessa biblioteca está nesse post.
HT-AJAX suporta vários AJAX processors, como Prototype e Dojo, mas não jQuery. Então fiz um pequeno patch adicionando suporte a jQuery.
Download: ht-ajax_0.0.7-jquery.patch
Aplicando o patch (SBCL):
$ cd ~/.sbcl/site/ht-ajax_0.0.7 $ wget http://lucindo.com.br/lisp/ht-ajax_0.0.7-jquery.patch $ cat ht-ajax_0.0.7-jquery.patch | patch -p0 $ sbcl * (require :asdf) * (asdf:oos 'asdf:compile-op :ht-ajax)
Two options for lispers:
define, let e set!, tirando proveito das regras de escopo.
(define proc-api-1 #f)
(define proc-api-2 #f)
(let ()
(define (proc-aux arg) (codigo))
(set! proc-api-1 (lambda () (proc-aux 3)))
(set! proc-api-2 (lambda () (proc-aux (proc-aux 1000)))))
proc-api-1 e proc-api-2. A outra definição proc-aux, que é útil para a implementação dos procedimentos da API, fica no escopo do bloco (let () ...), ou seja, não é visível do toplevel. Dentro do bloco (let () ...), então, fazemos a atribuição do código dos procedimentos da API às variáveis definidas no toplevel.(define ul #f)
(define li #f)
(define p #f)
(let ()
(define cria-tag
(lambda (nome)
(let ((nome (symbol->string nome)))
(lambda args
(string-append "<" nome ">"
(string-intersperse args "")
"</" nome ">"))))
(set! ul (cria-tag 'ul))
(set! li (cria-tag 'li))
(set! p (cria-tag 'p)))
$ csi -n
CHICKEN
(c)2008 The Chicken Team
(c)2000-2007 Felix L. Winkelmann
Version 3.2.0 - linux-unix-gnu-x86 [ manyargs dload ptables applyhook ]
SVN rev. 10664 compiled 2008-05-08 on ze-dureza (Linux)
#;1> (load "cria-tag.scm")
; loading cria-tag.scm ...
#;2> p
#<procedure (? . args)>
#;3> li
#<procedure (? . args)>
#;4> ul
#<procedure (? . args)>
#;5> cria-tag
Error: unbound variable: cria-tag
#;5> (p "nada")
"<p>nada</p>"
cria-tag não é visível no toplevel, mas as funções que a usam funcionam.