: ) wonderful world ( :

the metasyntactic variable

Archive for the ‘lisp’ Category

granting a loan; simplified

without comments

Based on the net present value term, in case of regular $R incomes and rate as discount rate:

      years - 1
      ---------
      \
       \        R
NPV =   )       -------------
       /                    i
      /         /          \
      --------- | 1 + rate |
        i = 0   \          /

 

Due to identical cash flows this is the sum of a geometric series, so can be rewritten into a closed form:

                        years
            /          \
            | 1        |
        1 - | -------- |
            | 1 + rate |
            \          /
NPV = R ---------------------
            1
        1 - --------
            1 + rate

 

Or identically:

            1
        1 - --------
            1 + rate
R = NPV ---------------------
                        years
            /          \
            | 1        |
        1 - | -------- |
            | 1 + rate |
            \          /

 

In case duration of the loan tends to infinity then the required yearly income converges to:

    /              \
    |     1        |
NPV | 1 - -------- |
    |     1 + rate |
    \              /

 

which is

    rate
NPV --------
    1 + rate

 

and this means that there’s no loan of USD NPV regarding rate as discount rate, where the required yearly pay back is less then this number, e.g. (NPV = $1000000, rate = 0.03):

% ./lx86cl
Welcome to Clozure Common Lisp Version 1.4-r13119  (LinuxX8632)!
? (defun limit (npv rate) (* npv (/ rate (+ 1 rate))))
LIMIT
? (limit 1000000 0.03)
29126.213
? (defun r (npv rate years)
(* npv (/ (- 1 (/ 1 (+ 1 rate))) (- 1 (expt (/ 1 (+ 1 rate)) years)))))
R
? (loop as i from 1 upto 50 collect (r 1000000 0.03 i))
(1000000.0 507389.3 343233.47 261191.42 211994.77 179220.95 155831.47 138307.22 124693.086
113816.05 104929.58 97536.03 91290.83 85947.914 81326.79 77292.09 73740.32 70590.97 67780.47
65257.973 62982.297 60919.8 59042.617 57327.58 55755.207 54309.016 52974.95 51740.992 50596.758
49533.246 48542.637 47618.066 46753.5 45943.64 45183.758 44469.687 43797.676 43164.387 42566.824
42002.29 41468.336 40962.766 40483.58 40028.957 39597.234 39186.906 38796.586 38425.0 38070.984
37733.465)
? (with-open-file (s #P"r.dat" :direction :output :if-exists :supersede)
(loop as val in * do (format s "~A~%" val)))
NIL
? (quit)
% echo set term png \; plot \'r.dat\' with lines | gnuplot > r.png
r

r.png

Written by grault

November 8, 2009 - 1:36 pm at November 8, 2009 - 1:36 pm

Posted in lisp, math

rebuild cffi foreign bindings

without comments

C:\grault>type lib-foo.c
int getone ()
{
   return 1;
}

C:\grault>gcc -shared -o lib-foo.dll lib-foo.c

C:\grault>clisp -q -norc -i ..\.clisprc
;; Loading file ..\.clisprc ...
[1]> (setf *load-verbose* nil)
NIL
[2]> (asdf:oos 'asdf:load-op :cffi :verbose nil)
#<ASDF:LOAD-OP (:VERBOSE NIL) #x19C29B55>
[3]> (cffi:load-foreign-library "lib-foo")
#<CFFI::FOREIGN-LIBRARY #x19CCE065>
[4]> (cffi:defcfun  "getone" :int)
GETONE
[5]> (getone)
1
[6]> (ext:saveinitmem "foo.mem" :norc t)

Bytes permanently allocated:             92,512
Bytes currently in use:               3,409,664
Bytes available until next GC:          852,166
3409664 ;
852166 ;
92512 ;
38 ;
20303572 ;
2808018
[7]> (quit)

C:\grault>dir/b
foo.mem
lib-foo.c
lib-foo.dll

C:\grault>clisp -q -M foo.mem
[1]> (getone)
WARNING: FFI::FIND-FOREIGN-FUNCTION: no dynamic object named "getone" in library :DEFAULT
*** - FUNCALL: undefined function NIL
The following restarts are available:
USE-VALUE      :R1      Input a value to be used instead of (FDEFINITION 'NIL).
RETRY          :R2      Retry
STORE-VALUE    :R3      Input a new value for (FDEFINITION 'NIL).
ABORT          :R4      Abort main loop
Break 1 [2]> :r4
[3]> (cffi:use-foreign-library "lib-foo")
#<CFFI::FOREIGN-LIBRARY #x19FB66AD>
[4]> (getone)
1
[5]> (quit)

C:\grault>

Written by grault

November 3, 2009 - 1:29 pm at November 3, 2009 - 1:29 pm

Posted in lisp, session, windowns

common lisp GUI-application shipment&delivery on windows

without comments

First of all, here’s the lisp I’ve used:

% clisp --version | grep -v ^Machine
GNU CLISP 2.48 (2009-07-28) (built on stnt067 [192.168.0.1])
Software: GNU C 3.4.5 (mingw-vista special r3)
gcc -mno-cygwin -O2 -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-ty
pe -Wmissing-declarations -Wno-sign-compare -Wno-format-nonliteral -O2 -fexpensi
ve-optimizations -falign-functions=4 -D_WIN32 -DUNICODE -DDYNAMIC_FFI -I.  -lint
l -lreadline -ltermcap -lavcall -lcallback -luser32 -lws2_32 -lole32 -loleaut32
-luuid -liconv -lsigsegv
SAFETY=0 HEAPCODES STANDARD_HEAPCODES GENERATIONAL_GC SPVW_BLOCKS SPVW_MIXED TRI
VIALMAP_MEMORY
libsigsegv 2.6
libiconv 1.11
libreadline 5.2
Features:
(READLINE REGEXP SYSCALLS I18N LOOP COMPILER CLOS MOP CLISP ANSI-CL COMMON-LISP
LISP=CL INTERPRETER SOCKETS GENERIC-STREAMS
 LOGICAL-PATHNAMES SCREEN FFI GETTEXT UNICODE BASE-CHAR=CHARACTER PC386 WIN32)
C Modules: (clisp i18n syscalls regexp readline)
Installation directory: C:\Program Files\clisp-2.48\
User language: ENGLISH

%

 

I have also MingW (5.1.6) and MSYS (1.0.1) installed, Witchs Hat icon downloaded, CLisp dlls copied from the base subdirectory under the installation path. This is the development tree in clean form:

% find
.
./bootstrapper.cc
./bootstrapper.rc
./clisp-dlls
./clisp-dlls/libiconv-2.dll
./clisp-dlls/libintl-8.dll
./clisp-dlls/readline5.dll
./Makefile
./message.lisp
./witchs-hat.ico
%

 

Under clisp-dlls, there are the mentioned dlls of CLisp. The file message.lisp contains the program you’d like to run (or ship or whatever). Finally, the bootstrapper files are up to provide an exe with company info, icon, copyright, etc. as an entry to the lisp program. The important bit here is that you don’t want a command prompt window popping up before startup.
Let’s see the files:

% cat message.lisp
(use-package "FFI")
(def-call-out messagebox
  (:name "MessageBoxA") (:library "user32.dll")
  (:arguments (hwnd int) (text c-string) (capt c-string) (type uint))
  (:return-type int)
  (:language :stdc))

(defun main ()
  (messagebox 0 "Your hacking starts... NOW!" "Demo MsgBox" 0)
  (quit))
% cat -A Makefile
all:^Imsgbox-app.exe msgbox-app.img$
^Imkdir -p shipment$
^Icp msgbox-app.exe shipment$
^Icp msgbox-app.img shipment$
^Icp clisp-dlls/* shipment$
$
msgbox-app.img:^Imsgbox-app.img.exe$
^Icp $< $@$
$
msgbox-app.img.exe:^Imessage.lisp$
^Iclisp -q -norc -x \$
"(load \"message.lisp\") \$
(ext:saveinitmem #P\"./msgbox-app.img.exe\" \$
                 :executable t \$
                 :norc t \$
                 :init-function #'main)"$
$
bootstrapper.res:^Ibootstrapper.rc witchs-hat.ico$
^Iwindres $< -O coff -o $@$
^I$
msgbox-app.exe:^Ibootstrapper.cc bootstrapper.res$
^Ig++ -mwindows $^ -o $@$
$
clean:$
^Irm -rf msgbox-app.exe bootstrapper.res \$
^Imsgbox-app.img msgbox-app.img.exe shipment$
% cat bootstrapper.rc
ID ICON "witchs-hat.ico"
1 VERSIONINFO
FILEVERSION     1,0,0,0
PRODUCTVERSION  1,0,0,0
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "080904E4"
    BEGIN
      VALUE "CompanyName", "MsgBox Products"
      VALUE "FileDescription", "Demo MsgBox"
      VALUE "FileVersion", "1.0"
      VALUE "InternalName", "msgbox-app"
      VALUE "LegalCopyright", "Grault"
      VALUE "OriginalFilename", "msgbox-app.exe"
      VALUE "ProductName", "Demo MsgBox"
      VALUE "ProductVersion", "1.0"
    END
  END

  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x809, 1252
  END
END
% cat bootstrapper.cc
#include <windows.h>

int WinMain(HINSTANCE a0, HINSTANCE a1, LPSTR a2, int a3)
{
  STARTUPINFO si;
  PROCESS_INFORMATION pi;
  ZeroMemory(&si,sizeof(STARTUPINFO));
  si.cb = sizeof(STARTUPINFO);
  CreateProcess("msgbox-app.img", "",
     NULL,NULL,TRUE,CREATE_NO_WINDOW,NULL,
     NULL,&si,&pi);
  // version and company details are in the bootstrapper exe
  // it's kinda better to show these e.g. in process explorer
  // and image file as a subprocess
  // feel free to comment the following line to leave img only
  WaitForSingleObject(pi.hProcess, INFINITE);
  return 0;
}
%

 

These are the files, and here are the results of a make:

% make
windres bootstrapper.rc -O coff -o bootstrapper.res
g++ -mwindows bootstrapper.cc bootstrapper.res -o msgbox-app.exe
clisp -q -norc -x \
"(load \"message.lisp\") \
(ext:saveinitmem #P\"./msgbox-app.img.exe\" \
                 :executable t \
                 :norc t \
                 :init-function #'main)"
;; Loading file message.lisp ...
;; Loaded file message.lisp
T
;; Wrote the memory image into .\msgbox-app.img.exe (5,088,157 bytes)
Bytes permanently allocated:             92,512
Bytes currently in use:               2,188,704
Bytes available until next GC:          544,546
2188704 ;
544546 ;
92512 ;
1 ;
52160 ;
156001
cp msgbox-app.img.exe msgbox-app.img
mkdir -p shipment
cp msgbox-app.exe shipment
cp msgbox-app.img shipment
cp clisp-dlls/* shipment
% find
.
./bootstrapper.cc
./bootstrapper.rc
./bootstrapper.res
./clisp-dlls
./clisp-dlls/libiconv-2.dll
./clisp-dlls/libintl-8.dll
./clisp-dlls/readline5.dll
./Makefile
./message.lisp
./msgbox-app.exe
./msgbox-app.img
./msgbox-app.img.exe
./shipment
./shipment/libiconv-2.dll
./shipment/libintl-8.dll
./shipment/msgbox-app.exe
./shipment/msgbox-app.img
./shipment/readline5.dll
./witchs-hat.ico

 

Here’s a picture how this all looks like on a Windows Server 2003 Standard Edition without any kind of lisp installed. And the entries in Process Explorer.

shipped

Some sort of shipment : )


shipped-pe

show up in Process Explorer

Obviously one can develop a much more sophisticated bootstrapper. This one represents only the possibility of releasing software written in Lisp. Assembling these output files together into an installer could be the next step : ))

 

And finally, you can get either the binaries or the source files by sending a mail to:

% echo gra.rtebsrpehbf.ferfh@gyhnet | rev | tr '[a-z]' '[n-za-m]'

Written by grault

October 30, 2009 - 5:38 pm at October 30, 2009 - 5:38 pm

moving from ucw to wui (& cl-dwim)

without comments

As per the UCW repository the project seems to be abandoned a bit. There’s a new upcoming lisp based web development framework called cl-dwim with it’s own demo site.

WUI (a subproject of cl-dwim) has numerous asdf dependencies, so collecting the right version of these can be a bit time consuming, but AFAIK there will be some kind of boxset version as for UCW. I was able to start up the server and write some sort of hello world program with it, screencast is coming soon.

Written by grault

September 21, 2009 - 10:29 am at September 21, 2009 - 10:29 am

Posted in lisp

url shortening APIs into cl-twitter

without comments

Some hacks with cl-twitter:

$ darcs whatsnew
hunk ./twitter.lisp 81
-(defun send-tweet (text &rest args &key (tiny-url-p t) &allow-other-keys)
-  (let ((newtext (if tiny-url-p (convert-to-tinyurl text) text)))
+(defun send-tweet (text &rest args &key (tiny-url-p t)
+		   (shortener #'get-tinyurl) &allow-other-keys)
+  (let ((newtext (if tiny-url-p
+		     (convert-to-short-url text :shortener shortener) text)))
hunk ./twitter.lisp 87
-			    (rem-keywords args '(:tiny-url-p)))))
+			    (rem-keywords args '(:tiny-url-p :shortener)))))
hunk ./twitter.lisp 148
+(defparameter *cligs-url* "http://cli.gs/api/v1/cligs/create")
+(defparameter *bit-ly-url* "http://api.bit.ly/shorten")
hunk ./twitter.lisp 165
-(defun convert-to-tinyurl (text)
+(defun get-cligs-url (url)
+  "Get a Cligs for the given URL. Uses the Cligs API service.
+   (c) by ... via cl-twit"
+  (multiple-value-bind (body status-code)
+      (http-request *cligs-url*
+		    :parameters `(("url" . ,url)))
+    (if (= status-code +http-ok+)
+        body
+        (error 'http-error
+               :status-code status-code
+               :url url
+               :body body))))
+
+(defun bit-ly-shortener-of (login api-key)
+  (lambda (url)
+    "Get a bit.ly for the given URL. Uses the bit.ly API service.
+   (c) by ... via cl-twit"
+    (multiple-value-bind (body status-code)
+	(http-request *bit-ly-url*
+		      :parameters `(("version" . "2.0.1")
+				    ("longUrl" . ,url)
+				    ("login" . ,login)
+				    ("apiKey" . ,api-key)))
+      (if (= status-code +http-ok+)
+	  (third
+	   (ppcre:split
+	    "\\\""
+	    (car (ppcre:all-matches-as-strings
+		  "shortUrl\\\": \\\"[^\\s\\)\\]\\'\\\"]+" body))))
+	  (error 'http-error
+		 :status-code status-code
+		 :url url
+		 :body body)))))
+
+(defun convert-to-short-url (text &key (shortener #'get-tinyurl))
hunk ./twitter.lisp 206
-		      (get-tinyurl (subseq result start end))))))))
+		      (funcall shortener (subseq result start end))))))))
+
$

Written by grault

September 3, 2009 - 9:45 pm at September 3, 2009 - 9:45 pm

Posted in lisp

static executables with lisp

without comments

In case you’re planning to write desktop applications in lisp (for example SBCL) and provide installers or create debian or rpm packages with your product, this solution can come handy.

$ sbcl --noinform
* (defun main () (progn (format t "HELLO~%") 0))

MAIN
* (main)
HELLO
0
* (sb-ext:save-lisp-and-die #P"test.img" :toplevel #'main :executable t)
[undoing binding stack and other enclosing state... done]
[saving current Lisp image into /home/grault/test.img:
writing 3432 bytes from the read-only space at 0x01000000
writing 2256 bytes from the static space at 0x01100000
writing 25616384 bytes from the dynamic space at 0x09000000
done]
$ ls -Fs test.img
25624 test.img*
$ ./test.img
HELLO
$

Written by grault

August 30, 2009 - 2:03 pm at August 30, 2009 - 2:03 pm

Posted in lisp

dispatch-macro-characters

without comments

(set-macro-character #\] (get-macro-character #\]) nil)

(defun separated-to-simple-integer (list)
  (loop
     as num in list
     as val = num then (+ num (* val 1000))
     finally (return val)))

(defun separated-integer-reader (stream subchar arg)
  (declare (ignore subchar arg))
  (funcall #'separated-to-simple-integer
	   (read-delimited-list #\] stream t)))

(set-dispatch-macro-character #\# #\[ #'separated-integer-reader)

 

CL-USER> #[12 345 678]
12345678
CL-USER> (* #[12 345 678] 2)
24691356
CL-USER>

Written by grault

August 29, 2009 - 9:03 pm at August 29, 2009 - 9:03 pm

Posted in lisp

multiconnection download with scsh

without comments

There’s a server (of a radio) I download audio files from. The thing is, that the bandwidth for a connection is limited to ~24Kb/sec nowdays (several years ago there wasn’t any limit). By getting the file with multiple connections and concurrently solves the problem somewhat. Unfortunately the number of connections from a given IP address is also limited to ~15. Anyway, let’s say ~240Kb/sec (when using 10 connections) is much more than 24Kb/sec.

Parts of a file can be obtained by Curl. I decided to use The Scheme Shell to implement my idea due to its thread support and strong relationship with command line tools (as being a shell).

The solution is a fast hack. Let’s see..

$ ls
getItFast.scm  getItFast.scm~
$ ./getItFast.scm http://someserver/2200.mp3
$ ls
2200.mp3.00  2200.mp3.08  2200.mp3.16  2200.mp3.24  2200.mp3.32  2200.mp3.40
2200.mp3.01  2200.mp3.09  2200.mp3.17  2200.mp3.25  2200.mp3.33  2200.mp3.41
2200.mp3.02  2200.mp3.10  2200.mp3.18  2200.mp3.26  2200.mp3.34  2200.mp3.42
2200.mp3.03  2200.mp3.11  2200.mp3.19  2200.mp3.27  2200.mp3.35  getItFast.scm
2200.mp3.04  2200.mp3.12  2200.mp3.20  2200.mp3.28  2200.mp3.36  getItFast.scm~
2200.mp3.05  2200.mp3.13  2200.mp3.21  2200.mp3.29  2200.mp3.37
2200.mp3.06  2200.mp3.14  2200.mp3.22  2200.mp3.30  2200.mp3.38
2200.mp3.07  2200.mp3.15  2200.mp3.23  2200.mp3.31  2200.mp3.39
$ cat 2200.mp3.* > 2200.mp3
$ rm 2200.mp3.*
$ ls
2200.mp3  getItFast.scm  getItFast.scm~
$ cat getItFast.scm
#!/usr/bin/scsh \
-o placeholders -o threads -o locks -s
!#

; this many thread will be started,
; each of'em represents a connection
(define POOL-SIZE 10)

; the length of a chunk in bytes
; (downloaded with one connection)
(define STEP 1000000)

(define URL (argv 1))
(define FNAME (file-name-nondirectory URL))

(define url-content-length
  (lambda (url)
    (string->number
     (cadr ((infix-splitter (rx (+ white)))
            (run/string
             (| (curl -s -S -I ,url)
                (grep "Content-Length"))))))))

(define LENGTH (url-content-length URL))

(define make-queue
  (lambda (data-list)
    (let ((lock (make-lock)))
      (lambda ()
        (let ((re '()))
          (obtain-lock lock)
          (if (null? data-list)
              (set! re '())
              (begin
                (set! re (car data-list))
                (set! data-list (cdr data-list))))
          (release-lock lock)
          re)))))

(define range-string
  (lambda (beg end)
    (let ((begs (number->string beg))
          (ends (number->string end)))
      (string-append begs "-" ends))))

(define get-part
  (lambda (beg end fn)
    (run (curl -o ,fn -s -S -r
               ,(range-string beg end) ,URL))))

; this long is the number field
; in the filenames of parts
(define PADLEN
  (string-length
   (number->string
    (ceiling
     (/ LENGTH STEP)))))

(define file-counter-string
  (lambda (i)
    (let loop ((s (number->string i)))
      (if (<= PADLEN (string-length s))
          s
          (loop (string-append "0" s))))))

(define counted-file-name
  (lambda (i)
    (string-append FNAME
                   "."
                   (file-counter-string i))))

; this contains the works to do
; (work ~ download a specific chunk)
; e.g. ((0 999999 "foo.mp3.00") (1000000 1999999 "foo.mp3.01") ... )
(define QUEUE
  (make-queue
   (let loop ((work-list '()) (low 0) (upp (- STEP 1)) (counter 0))
     (if (> low LENGTH)
         work-list
         (loop (cons (list low upp (counted-file-name counter)) work-list)
               (+ upp 1)
               (min LENGTH (+ upp STEP))
               (+ counter 1))))))

(define signal-thread-finish
  (lambda (waiter)
    (placeholder-set! waiter #f)))

(define start-worker
  (lambda ()
    (let ((waiter (make-placeholder)))
      (spawn
       (lambda ()
         (let loop ()
           (let ((work (QUEUE)))
             (if (null? work)
                 (signal-thread-finish waiter)
                 (begin
                   (apply get-part work)
                   (loop)))))))
      waiter)))

(let loop ((i POOL-SIZE) (waiters '()))
  (if (= i 0)
      (map placeholder-value waiters)
      (loop (- i 1) (cons (start-worker) waiters))))
$

 

Useful links:

Written by grault

August 5, 2009 - 11:41 am at August 5, 2009 - 11:41 am

Posted in linux, lisp

hacking .NET assemblies

without comments

I’ve used grep and ed unix tools which are installed here as part of a cygwin, but you don’t need these tools. Grep is used only for looking into a source file and ed is used to edit that file which also can be done with your favourite editor.

The story is about changing the behaviour of a .NET executable file with .NET SDK tools but without access to the source by knowing how intermediate language (IL) instructions look like. Find relevant part here, Partition III, p. 73. (p. 397. in PDF).

In case of class library dlls the process works only if the user of these libraries don’t refer them by strong name. Strong named assemblies has a hash and/or a signature by which you cannot change the binary dll in such a way that the hash/signature remains the same.

C:\test>dir/b
sample.cs

C:\test>type sample.cs
public class Bar
{
  public static void Main (string[] baz)
  {
    System.Console.WriteLine (1);
  }
}
C:\test>csc sample.cs
Microsoft (R) Visual C# 2005 Compiler version 8.00.50727.3053
for Microsoft (R) Windows (R) 2005 Framework version 2.0.50727
Copyright (C) Microsoft Corporation 2001-2005. All rights reserved.

C:\test>del sample.cs

C:\test>dir/b
sample.exe

C:\test>sample.exe
1

C:\test>ildasm/out:sample.il sample.exe

C:\test>dir/b
sample.exe
sample.il
sample.res

C:\test>grep -A8 "static.*void.*Main" sample.il
  .method public hidebysig static void  Main(string[] baz) cil managed
  {
    .entrypoint
    // Code size       9 (0x9)
    .maxstack  8
    IL_0000:  nop
    IL_0001:  ldc.i4.1
    IL_0002:  call       void [mscorlib]System.Console::WriteLine(int32)
    IL_0007:  nop

C:\test>ed sample.il
2075
/static.*void.*Main/
  .method public hidebysig static void  Main(string[] baz) cil managed
/WriteLine/
    IL_0002:  call       void [mscorlib]System.Console::WriteLine(int32)
?ldc.i4?
    IL_0001:  ldc.i4.1
s/i4.1/i4.0/
w
2075
.
    IL_0001:  ldc.i4.0
q

C:\test>del sample.exe

C:\test>dir/b
sample.il
sample.res

C:\test>ilasm/quiet sample.il

C:\test>dir/b
sample.exe
sample.il
sample.res

C:\test>del sample.il

C:\test>del sample.res

C:\test>dir/b
sample.exe

C:\test>sample.exe
0

C:\test>

Written by grault

July 31, 2009 - 11:14 am at July 31, 2009 - 11:14 am

Posted in lisp

cl-perec tutorial, lisp clos persistency

without comments

cl-perec is an RDBMS based CLOS persistency library. Consider these about a fresh install of a postgresql server before starting. Socket connections are refused by default. Then create a database for storing the instances:

$ sudo -u postgres psql
[sudo] password for grault:
Welcome to psql 8.3.7, the PostgreSQL interactive terminal.

Type:  \copyright for distribution terms
       \h for help with SQL commands
       \? for help with psql commands
       \g or terminate with semicolon to execute query
       \q to quit

postgres=# create database perec_db1;
CREATE DATABASE
postgres=# create user perec_user with password 'perec999pass';
CREATE ROLE
postgres=# grant all on database perec_db1 to perec_user;
GRANT
postgres=# \q
$

 

and then load the following forms:

(asdf:oos 'asdf:load-op :cl-perec)

(cl-def:def defclass-star:class* myconn
  (cl-perec:database-mixin cl-rdbms:postgresql-postmodern) ())

(setf cl-perec:*database*
      (make-instance 'myconn
		     :generated-transaction-class-name 'transaction
		     :default-result-type 'vector
		     :muffle-warnings t
		     :connection-specification '(:host "localhost"
						 :port 5433
						 :database "perec_db1"
						 :user-name "perec_user"
						 :password "perec999pass")))

(cl-rdbms:start-sql-recording)

(cl-perec:defpclass c1 ()
  ((s1 :type string :initform "foo" :initarg :s1 :accessor s1-of)))

 

Finally issue some make-instance:

CL-USER> (cl-perec:with-transaction
  (make-instance 'c1 :s1 "hello"))

; BEGIN
; SELECT relname FROM pg_class WHERE relkind = 'r'
; CREATE TABLE _c1 (_oid BIGINT NOT NULL PRIMARY KEY, _s1 TEXT)
; DROP VIEW IF EXISTS _c1_di
; CREATE VIEW _c1_di AS SELECT _oid FROM _c1
; DROP VIEW IF EXISTS _c1_dp
; CREATE VIEW _c1_dp AS SELECT _oid, _c1._s1 FROM _c1
; DROP VIEW IF EXISTS _c1_dd
; CREATE VIEW _c1_dd AS SELECT _oid, _c1._s1 FROM _c1
; DROP VIEW IF EXISTS _c1_ai
; CREATE VIEW _c1_ai AS SELECT _oid FROM _c1
; DROP VIEW IF EXISTS _c1_ap
; CREATE VIEW _c1_ap AS SELECT _oid, _c1._s1 FROM _c1
; DROP VIEW IF EXISTS _c1_ad
; CREATE VIEW _c1_ad AS SELECT _oid, _c1._s1 FROM _c1
; COMMIT
; BEGIN
; SELECT relname FROM pg_class WHERE relkind = 'S'
; CREATE SEQUENCE _instance_id
; SELECT NEXTVAL('_instance_id')
; $1 = 121174 as BIGINT, $2 = hello as TEXT
; INSERT INTO _c1 (_oid, _s1) VALUES ($1::BIGINT, $2::TEXT)
; COMMIT
#<C1 :persistent #t 1>
CL-USER> (cl-perec:with-transaction
  (make-instance 'c1 :s1 "hello2"))

; BEGIN
; SELECT NEXTVAL('_instance_id')
; $1 = 186710 as BIGINT, $2 = hello2 as TEXT
; INSERT INTO _c1 (_oid, _s1) VALUES ($1::BIGINT, $2::TEXT)
; COMMIT
#<C1 :persistent #t 2>
CL-USER>

Written by grault

July 27, 2009 - 9:51 pm at July 27, 2009 - 9:51 pm

Posted in lisp