Wednesday, 30 January 2008

Experience report: Common Lisp and OpenGL

I am working through the (in)famous OpenGL Red Book using cl-opengl(-thomas). Who is this Thomas guy anyway?

I just thought I would post my experience about it so far.

I considered just using C or C++ to work through the examples but the thought of the turnaround time before something was running was bugging me. So I decided to use Common Lisp.

First of all, using clbuild was a smart idea. I additionally set up Emacs+Slime to be able to use the clbuild core or using the default core. I currently have a couple of projects and don't use clbuild for the others. The .emacs is quite ugly as a result but does what I need it to ;-)

Secondly, cl-opengl uses generic functions instead of direct function callbacks. At first, I did not like this deviation from the way OpenGL normally works (via callbacks) but now I have come to appreciate it. One benefit is that there are (apparently!) no global variables. Secondly, there is a lot of nice stuff you can do with generic functions that you cannot do with function callbacks and cl-opengl takes full advantage of this fact.

Thirdly, I was afraid that it might not perform well enough but it turns out that I haven't reached any part of the book yet that requires absolute performance (or it is fast enough!) I'm told that choice of language should not generally be an issue if you have done things right so that is encouraging.

Last, but not least, Emacs + Slime for development of the examples is awesome. I can modify the definition of the display code at runtime and the changes show up. That is very, very useful for understanding (for example) how functions like gluLookAt work.

In general, I believe the experience has been better than it would have been had I used C or C++ for going through the book's examples.

Tuesday, 29 January 2008

Getting started with clbuild and opengl


A script to update/install the latest versions of all the most important Common Lisp packages.

  -- clbuild project page

clbuild is a nice way to keep up to date on the latest libraries. An advantage over ASDF-INSTALL is that it can retrieve from more than just http. Look at Bill Clementson's blog for a good overview on how to get started. This post is about how to get started with cl-opengl(-thomas) with clbuild.

Once you have retrieved clbuild (lines prefixed by $ are what you would type in, everything else is output):


$ cd /path/to/clbuild
$ ./clbuild build cl-opengl
The following extra dependencies were found: alexandria babel cffi trivial-features
include dependencies in update? (Y/n)y
UPDATE darcs pull alexandria
Pulling from "http://common-lisp.net/project/alexandria/darcs/alexandria"...
No remote changes to pull in!
UPDATE darcs pull babel
Pulling from "http://common-lisp.net/~loliveira/darcs/babel"...
No remote changes to pull in!
UPDATE darcs pull cffi
Pulling from "http://common-lisp.net/~loliveira/darcs/cffi+lotsastuff"...
No remote changes to pull in!
UPDATE darcs pull cl-opengl
Pulling from "http://common-lisp.net/~loliveira/darcs/cl-opengl-thomas"...
No remote changes to pull in!
UPDATE darcs pull trivial-features
Pulling from "http://common-lisp.net/~loliveira/darcs/trivial-features"...
No remote changes to pull in!
update complete
20 system definition files registered
; loading system definition from
; /home/sohail/src/thirdparty/clbuild/systems/cl-ppcre.asd into
; #
; registering # as CL-PPCRE
Loading cl-glu...
Loading cl-glut-examples...
Loading cl-glut...
Loading cl-opengl...
Dumping monster.core...
[undoing binding stack and other enclosing state... done]
[saving current Lisp image into /home/sohail/src/thirdparty/clbuild/monster.core:
writing 2976 bytes from the read-only space at 0x01000000
writing 5424 bytes from the static space at 0x01100000
writing 33984512 bytes from the dynamic space at 0x09000000
done]

You can start the core as follows:

sbcl --core monster.core

Now, you might think you can just call (glut:init) and be off to the races, but you would be wrong:

* (glut:init)
*** glibc detected *** sbcl: free(): invalid pointer: 0x080876a8 ***
*** lockup ensues ***

The problem here is that when clbuild dumped core, the pointers for command line arguments are saved along with it. Unfortunately, these are FFI pointers and so the values are invalid. When you call glut:init, it tries to free these pointers which results in the lockup above. Luis Oliveira (luis on #lisp!) suggested that this is something CFFI should handle and said he would make a note of it.

In the meantime, you can execute the following to get around it:

* (progn (setq glut::*argcp* (cffi:null-pointer) glut::*argv* (cffi:null-pointer)))
#.(SB-SYS:INT-SAP #X00000000)

And now, you are good to go:

* (glut:init)
; No value
*

Thursday, 24 January 2008

Not very clever.

I've just been formally adding the notion of fixtures to my CLSQL-backed application using Postgres SQL. Fixtures are fixed scenarios for your application that you can run tests against. Atleast that is what I call them!

One of the tasks when dealing with testing database applications is that you have to populate the database for part of your tests. The problem is that you have to also empty the tables before running the same set of tests again otherwise your results are either not repeatable or you will accidentally violate some uniqueness constraints. For example, you might have some users table and one of the uniqueness constraints applies to email addresses.

I came up with a really clever way of keeping the database clean during testing by abusing transactions (hint: whenever someone says they did something clever, it usually isn't!) The idea was to begin and always rollback a transaction for each fixture. This way, the database never actually got populated. Score one for me. The code looks something like this:


(defmacro with-no-db-side-effects (&body body)
`(progn
(clsql:start-transaction)
(unwind-protect
(progn ,@body)
(clsql:rollback))))

(defmacro def-fixture (name args &body body)
`(defun ,name ,args
,@body))

(defmacro with-fixtures ((&rest fixtures) &body body)
`(with-no-db-side-effects
(let (
,@(loop for fixture in fixtures
collect `(,fixture (,fixture))))
(declare (ignorable ,@fixtures))
,@body)))
...
(def-fixture fixture-a ()
(populate-database))
...
(test test-something-specific-about-scenario-a
(with-fixtures (fixture-a)
(validate-foo)
(validate-bar)))

Pretty clever (remember the above hint!) It worked as I expected.

At some point during the testing, you must also test the integrity of the relational model. I think you must do this because the integrity of your database should not solely be protected by the application. The IT department will always figure out a way to futz with your data!

One way in which you might try to test the integrity of your database is by entering some data that should be unique. You might try and add the same user twice, for example. So I did:

(test test-something-specific-about-scenario-a
(with-fixtures (fixture-a)
(validate-foo)
(validate-bar)
(signals duplicate-key-error (insert-duplicate-user))))


Which immediately results in:

Error POSTGRESQL-ERROR / ERROR:  current transaction is aborted, commands ignored until end of transaction block


Duh! If a query fails within a transaction, you are supposed to roll it back. It especially doesn't make any sense for PGSQL to execute any more of my commands until I rollback the transaction.

Oh well, it was almost clever. I wonder how people solve this problem with testing? I guess another way around it might be to force your fixtures to tell you which tables they populate:

(def-fixture fixture-a (:view-classes '(user foo bar))
...

Then the with-fixtures macro collects all the view classes and does a clause-less delete:

(defmacro with-fixtures ((&rest fixtures) &body body)
(let ((tables (collect-all-tables-from-view-classes-of-fixtures fixtures)))
`(unwind-protect (progn ,@body)
(progn ,@(loop for table in tables collect `(clsql:delete-records :from ,table))))))

Clever!

Update: Still not very clever as the success of the above depends on the order of deletion. Dang it.

Sunday, 20 January 2008

cl-selenium moved to common-lisp.net

CL-Selenium, a project that I use/contribute to is now located at http://common-lisp.net/project/cl-selenium.

A little bit about the project:

Selenium is a test tool for web applications. You might use Selenium as a foundation for acceptance or functional testing. CL-Selenium is a Common Lisp interface to Selenium.

Right now, it is at version 0.1 as it is very new but it is quite usable. See the getting started tutorial if you don't believe me. As a bonus, it is now adsf-installable!

Thanks to the common-lisp.net guys, whoever you are. Thanks also to Matt Kennedy for starting up the project!

Saturday, 19 January 2008

Some useful CLSQL helper functions

Quite often, you need to query the database for when all values equal something or the other. For example, you might look for an authenticated user as follows (in SQL):


SELECT USERS.* FROM USERS WHERE USER_LOGIN='sohail' AND USER_PASSWORD='myhashedpassword'

Of course, in the year 2008, no one writes their own SQL anymore (or so Rails propaganda would have you believe!) So you use something like CLSQL and end up writing something like:

(clsql:select 'user :where [ and [ = [ user-login ] "sohail" ] [ user-password ] 'myhashedpassword' ])

Certainly more Lispy but still quite annoying. The Rails and Django guys have you write something that looks like:

ModelObject.find(id=5)

I've written a couple of helper functions for CLSQL (reproduced below) that let you write:

CL-USER> (find-one 'user :user-login "sohail" :user-password "myhashedpassword")
#<USER {B47D0C9}>
CL-USER> (find-all 'user :user-site-id 3)
(#<USER {B729209}> #<USER {B72AD81}>)

Makes it a lot easier to write bespoke queries without resorting to CLSQL's bracket syntax or SQL itself.

The code is here (would appreciate any comments as to how to clean it up a bit!):

(defun find-all (type &rest args &key (clause-op 'and) &allow-other-keys)
(if (> (length args) 0) ;; if there are any filters to apply
(let ((expressions (loop for (k v) on args by #'cddr
collect
(let ((op '=)
(value v))
(make-instance 'clsql-sys:sql-relational-exp
:operator op
:sub-expressions
(list (make-instance 'clsql-sys:sql-ident-attribute :name k :qualifier nil :type nil)
value))))))
(clsql:select type :flatp t
:where (make-instance 'clsql-sys:sql-relational-exp
:operator clause-op
:sub-expressions expressions)))
(clsql:select type :flatp t)))


(defun find-one (&rest args)
(let ((result (apply #'find-all args)))
(if (= 1 (length result))
(first result)
(error "More than one result returned when only one expected!"))))

Enjoy!

Wednesday, 16 January 2008

A lock-free hash table

A very interesting Google talk on a lock-free hash table given by Cliff Click.

It is pretty accessible and it is very cool how the whole thing hinges on CAS (as these things often do!)

PS: Java still sucks but for a different value of suck.

Monday, 14 January 2008

I could not make this up!

I usually don't do any metablogging but this was too good to pass up. I was looking at my feed stats and noticed something interesting:

Coming from programming.reddit.com to boot! I'm sorry, this is very, very funny to me.

If you don't get it, see here.

That made my day. Too bad I'm about to go to sleep!

Getting started with cl-selenium

I've created some documentation for the cl-selenium package. You can find it here. Let me know if you have any issues.

Update: CL-Selenium has been moved to http://common-lisp.net/project/cl-selenium/tutorial.html.

Sunday, 13 January 2008

Why is Boost.StaticAssert so complex?

Boost.StaticAssert is a way to perform some assertions at compile time.

Perhaps you require longs to be twice as long as ints. You would write:


BOOST_STATIC_ASSERT(sizeof(long)==2*sizeof(int));

Now if you ever compile on a platform/compiler where this statement is false, the compilation will fail. Traditionally, I believe this was implemented as follows:

#define MY_STATIC_ASSERT(expr) int A[int(expr)];

Since arrays of size 0 are not allowed in C++, you would get an error like:

/tmp/test.cc:11: error: ISO C++ forbids zero-size array ‘A’

Which tells you nothing at all. If you saw this error you would have no idea why it occurred. until you navigated to the erroneous line (a non-issue with IDEs, for sure.) As a side-effect, if the assertion is true, it creates an array of size 1. Not very nice. So we need some way to ensure that the compilation can atleast show what happened without navigating to the source.

The latest version of boost/static_assert.hpp uses the fact that sizeof(T) is pretty much guaranteed to show T in the error message when T is an incomplete type (STATIC_ASSERTION_FAILURE<false> in the case of Boost.) The header file is full of if-defery that makes my eyes bleed. But it gets the job done:

/tmp/test.cc:9: error: invalid application of ‘sizeof’ to incomplete type ‘boost::STATIC_ASSERTION_FAILURE<false>’


I have a simple alternative. I've only tried it on Visual C++ and GNU G++ but I can't imagine why it wouldn't work on other compilers. Instead of depending on sizeof(incomplete-type) to show incomplete-type in the compile error, it references a nested type that doesn't exist:

#define STATIC_ASSERT(expr) typedef static_assert<(bool)(expr)>::STATIC_ASSERTION_FAILED static_assertion_t_12312;

template <bool x> struct static_assert;
template <> struct static_assert<true>{struct STATIC_ASSERTION_FAILED{};};
template <> struct static_assert<false>{};

This also gets the job done:

/tmp/test.cc:9: error: ‘STATIC_ASSERTION_FAILED’ in class ‘static_assert’ does not name a type

No code, no data and performs the same job in 4 lines of code. I must be missing something.

Wednesday, 9 January 2008

Weblocks: starting with a blank slate

If you do the customary Hello World application in Weblocks, the UI looks something like this:



The code to create this page is:


(weblocks:defwebapp 'our-application)
(defun init-user-session (comp)
(setf (weblocks:composite-widgets comp)
(list "Hello!")))
(weblocks:reset-sessions)
;; Starts the server on localhost:8080
(weblocks:start-weblocks)


This minimal application brings in the following CSS files:

  • layout.css

  • dialog.css

  • main.css


And the following Javscript files:

  • scriptaculous.js

  • builder.js

  • shortcut.js

  • weblocks.js

  • dialog.js


Additionally, scriptalicious brings in a bunch of more dependencies that double the number of JS files.

The JS files are obviously what give you the nice Ajaxian effects and desktop application-like feel when you work with Weblocks widgets. However, I typically like to start from scratch so I can control what the framework brings in.

When you instantiate your Weblocks application (via weblocks:defwebapp), the variable weblocks:*application-public-dependencies* is set to a default list:

CL-USER> weblocks:*application-public-dependencies*
(#P"stylesheets/layout.css" #P"stylesheets/main.css" #P"stylesheets/dialog.css"
#P"scripts/prototype.js" #P"scripts/scriptaculous.js" #P"scripts/shortcut.js"
#P"scripts/weblocks.js" #P"scripts/dialog.js")

So that answers the question of where all those files come from. Set this list to nil and reload the page. You should get something like this:



If you look at the HTML for the page (through Firebug) you will see something like this:


Still pretty noisy. I don't care much about the meta tag, but I've got to get rid of the divs.

For every request, the function weblocks:render-page is called to actually generate the necessary HTML. This function just sends the head tag contents and is where all the external references are inserted into the output. It also opens the body tag but then calls the render-page-body function to actually output the body of the page. I redefine the function from:

(defmethod render-page-body (body-fn)
(with-html
(:div :class "page-wrapper"
(render-extra-tags "page-extra-top-" 3)
(htm (str body-fn))
(render-extra-tags "page-extra-bottom-" 3))))

To:

CL-USER> (defmethod weblocks:render-page-body (body-fn)
(weblocks:with-html
(cl-who:htm (cl-who:str body-fn))))

Now if you reload the page, the HTML looks something like this:

To get rid of the footer, redefine the after method on render-page-body to do nothing (or remove it altogether);

CL-USER> (defmethod weblocks:render-page-body :after (rendered-html))

Now the HTML looks like:

The divs come from our init-session function where we defined it to be:

(defun init-user-session (comp)
(setf (weblocks:composite-widgets comp)
(list "Hello!")))

That was enough to keep me happy however. Hope that helps!

Code coverage in SBCL

This is the most useful thing since macros: sb-cover.

No nonsense code coverage:


;;; The code coverage module
(require :sb-cover)

;;; Enable instrumentation
(declaim (optimize sb-cover:store-coverage-data))

;;; Force recompilation with instrumentation
(asdf:oos 'asdf:load-op :my-project-test :force t)

;;; Run the tests!
(my-project-test::run-all-tests)

;;; Create the report
(sb-cover:report "/tmp/report/")

;;; Disable instrumentation
(declaim (optimize (sb-cover:store-coverage-data 0)))


See Code coverage tool for SBCL for some nice output as well. I had no idea the cl-ppcre tests had such good coverage. Damn.

Tuesday, 8 January 2008

Follow the money

Computer Science Education: Where Are the Software Engineers of Tomorrow?.

Summary: Industry/Academics complaining about how schools do not adequately prepare students to be the software engineers (SWEs) of tomorrow.

My Opinion



Before reading this part, I would mention that I am in full agreement with the above linked communication (except maybe the Ada part: tried it, hated it!)

Who are the SWEs of tomorrow that they are talking about? They are the people who can implement (and therefore understand) web browsers, virtual machines and operating systems. Ok, there are more things here like graphics and programming languages, but I can't list them all :-)

But are universities responsible for this state of affairs? I would submit that universities have become businesses and so they are only interested in providing what customers (students) want. And what do students want? Good grades and a piece of paper with their name on it. When I went to school, there was rarely a person who wasn't interested only in these two things. I recall how much that frustrated some professors who genuinely wanted to enlighten their students.

The authors of the above are complaining to the wrong people. The universities don't care. They just want money. So do the students when they graduate. If you make it hard for them to make money (say, by outsourcing) guess what? They aren't going to join your industry. Now sure, there will always be those who are wired to do computer programming, but if you want to find them, you need to open your wallet otherwise someone else will.

Saturday, 5 January 2008

Handling vendor/third-party libraries in Common Lisp projects

Any non-trivial application is going to have some third party dependencies. When working in C++, I have this very annoying habit to always have all third-party source in source control so that I could build it. And in fact, I would build the third-party libraries along with my own code. The benefits of this setup are:


  • No extra package installation besides compilers and build tools (ideally, I'd put these in as well!)

  • Package versions are fixed.

  • Free to patch libraries because SVN would usually merge nicely on library upgrades.


As we know, Common Lisp is compiled so this annoying habit should carry over nicely. Unfortunately, until very recently, I just didn't get how I would do it. Tonight, I threw together a small hack that works well enough which is all you can hope for at the end of the day.

Typically, my project layouts look like:

sohail@dev:~/project$ find . -maxdepth 1
.
./src
./test
./project.asd
./project-test.asd
./vendor

The vendor directory is where I usually stuff all the third-party dependencies. For example, you might have cl-fad as one of your dependencies. In the project's ASD file, you would add cl-fad as one of the modules you depend on. But the only problem is, how do you tell ASDF to look in ~/project/vendor/cl-fad for the asd files?

Obviously, the answer is asdf:*central-registry*, a list of directory pathnames that ASDF searches when asked to load something. But the problem is that I can check out my project anywhere on the file system, so I can't hardcode the paths.

So dynamically, we need to figure out the root of the checkout, call it *project-root*, get a list of all the ASDF-loadable packages in vendor and add their respective directories to asdf:*central-registry*. Simple enough, but I know more about pathnames than I ever wanted to know! Here is the code (put into project.asd):

(defparameter *project-root*
(make-pathname :directory (pathname-directory *load-truename*)))

(defparameter *vendor-root*
(merge-pathnames "vendor/" *project-root*))

(defparameter *asd-wildcard*
(merge-pathnames "*/*.asd" *vendor-root*))

(defparameter *all-asd-files*
(directory *asd-wildcard*))

(dolist (asd-file *all-asd-files*)
(pushnew (make-pathname :directory (directory-namestring asd-file))
asdf:*central-registry*
:test #'equal))

(defsystem myproject
...
:depends-on (#:cl-fad))

Fun! Hopefully someone knows a simpler way to do this but this makes me happy for now!

Thursday, 3 January 2008

A login widget for Weblocks

Update: Thanks to some comments from readers, I've made an updated version. Please see the code here. Specifically, the concept of the auth-provider and the auth-login-fields have gone the way of the dodo and been merged into a singular auth-method.

In this earlier post, I abused the Weblocks dataform object to implement a widget for creating a new user.

I have since been heads down coding but last night, I teased the login/authentication logic apart from the rest of my app and I have created a login widget that should be usable as a component. The main concept is the concept of an authentication provider, called the auth-provider. This is the part that the application writer fills in. Here is a sample:


;;; Not always just user/login :-)
(def-auth-login-fields my-auth-login-fields
((site
:initarg :site
:accessor my-auth-login-fields-site
:type string ; Weblocks types
:initform nil)
(login
:initarg :login
:accessor my-auth-login-fields-login
:type string
:initform nil)
(password
:initarg :password
:accessor my-auth-login-fields-password
:type password
:initform nil)))

;;; In this instance, only a tag but could have state.
(defclass my-auth-provider ()
())

;;; Helper function
(defun make-my-auth-provider ()
(make-instance 'my-auth-provider))

;;; The meat of it - return a generalized boolean. The result of this method is returned
;;; to the user
(defmethod auth-provider-authenticate ((map my-auth-provider) (fields my-auth-login-fields))
(user-find-match (site-find (my-auth-login-fields-site fields))
(my-auth-login-fields-login fields)
(my-auth-login-fields-password fields)))

;;; The auth-provider and auth-login-fields are intimately connected.
(defmethod auth-provider-make-fields ((map my-auth-provider))
(make-instance 'my-auth-login-fields :auth-provider map))

To use the login widget:

(defmacro current-user ()
`(hunchentoot:session-value 'current-user))

(defun init-user-session (comp)
(with-flow (composite-widgets comp)
;; The value returned here is whatever was returned by
;; auth-provider-authenticate. The widget does not return
;; until auth-provider-authenticate returns not nil.
(setf (current-user)
(yield (make-instance 'login
:auth-provider (make-my-auth-provider))))
(unless (current-user)
(error "Um... User wasn't returned? This world is crazy. Atleast I still have my Lisp."))
...

Here is some code you should be able to copy-and-paste (you still need to write an auth-provider.) Let me know if you think there are improvements to be made. I'd like to submit this to Slava when I get a round tuit.

(defwidget login (weblocks:composite)
((auth-provider
:accessor login-auth-provider
:initarg :auth-provider)))

(defwidget login-form (weblocks:dataform)
())

(defmethod initialize-instance :after ((self login)
&rest args
&key auth-provider
(login-title "Login")
&allow-other-keys)
(declare (ignore args))
(let ((fields (auth-provider-make-fields auth-provider)))
(setf (widget-name self) "login-composite")
(setf (composite-widgets self)
(list (lambda () (with-html (:h1 (str login-title))))
(make-instance 'login-form
:name 'loginform
:data fields
:ui-state :form
:allow-close-p nil
:on-success
(lambda (&rest args)
(declare (ignore args))
(answer self (slot-value fields 'result))))))))

(defclass auth-login-fields ()
((auth-provider
:accessor auth-login-fields-auth-provider
:initarg :auth-provider)
(result)))

(defun authenticate (provider fields)
(let ((result (auth-provider-authenticate provider fields)))
(if result
(progn
(tbnl:log-message* "Successful authentication")
(setf (slot-value fields 'result) result)
(values t nil))
(progn
(tbnl:log-message* "Failed authentication: ~A" fields)
(values nil '((foo "Authentication failed")))))))

;;; Weblocks hooks
(defmethod weblocks:update-object-from-request :around ((fields auth-login-fields)
&rest args)
(multiple-value-bind (success failed-slots)
(call-next-method)
(if success
(authenticate (auth-login-fields-auth-provider fields) fields)
(values success failed-slots))))

(defmethod weblocks:render-form-controls ((obj auth-login-fields)
&rest keys
&key action
&allow-other-keys)
(with-html
(:div :class "submit"
(render-button *submit-control-name* :value "Login"))))


(defmethod weblocks:dataform-submit-action ((obj login-form) data &rest args)
(apply #'weblocks:update-object-from-request data :persist-object-p nil args))

;;; AUTH-PROVIDER GENERIC

(defgeneric auth-provider-authenticate (auth-provider fields)
(:documentation "Return a generalized boolean to indicate
whether the fields provided authenticate a user."))

(defgeneric auth-provider-make-fields (auth-provider)
(:documentation "Return the fields that auth-provider needs
to authenticate users. This is in the form of a new CLOS object instance.

The types of the fields should be specified to be one of the weblocks
types (see weblocks/src/types/*.lisp)"))

(defmacro def-auth-login-fields (name &body body)
"A macro used to define login fields."
`(defclass ,name (auth-login-fields)
,@body))