From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Israelsson Tampe Newsgroups: gmane.lisp.guile.devel Subject: c-code hacking made fun Date: Sat, 18 Jun 2011 00:18:37 +0200 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/alternative; boundary=00151773e98c65cccb04a5efc48c X-Trace: dough.gmane.org 1308349152 20579 80.91.229.12 (17 Jun 2011 22:19:12 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 17 Jun 2011 22:19:12 +0000 (UTC) To: guile-devel Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Jun 18 00:19:06 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QXhNa-0001a7-AP for guile-devel@m.gmane.org; Sat, 18 Jun 2011 00:19:06 +0200 Original-Received: from localhost ([::1]:60997 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QXhNZ-0000my-9I for guile-devel@m.gmane.org; Fri, 17 Jun 2011 18:19:05 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:36661) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QXhNA-0000mb-Jj for guile-devel@gnu.org; Fri, 17 Jun 2011 18:18:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QXhN8-00087Q-SP for guile-devel@gnu.org; Fri, 17 Jun 2011 18:18:40 -0400 Original-Received: from mail-iy0-f169.google.com ([209.85.210.169]:37609) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QXhN8-00087K-KR for guile-devel@gnu.org; Fri, 17 Jun 2011 18:18:38 -0400 Original-Received: by iyl8 with SMTP id 8so3159037iyl.0 for ; Fri, 17 Jun 2011 15:18:37 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:mime-version:date:message-id:subject:from:to :content-type; bh=YwgzWvjqwtdKLVjO860ir1jq9/3lbilwWdyG1Bmd/TE=; b=DGBjULlb9HImnwF2K7d8xC4Pb0E822F20Io6VxmzZPpINHS5pBWwHgLaH0sFuuAzJy u0/Dgnka0CJ0/T9h7nQQgfGcmLBC1DdvLGuNqN9vyeTQs7QcGn5EC+u4V38aYoSFdcDF GZgBEzCvj8uScQdC8bYmI01Y6oAMVuzTjvEDc= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=mime-version:date:message-id:subject:from:to:content-type; b=g49Cc9nb1JCiMuA0HEc4vd3DWKH3WQh2njtMkVLUpSJ0nAnxJIni8D6CjNpZ0Qix3q /FrdE8qeuXF3Sjr0Iy4ftiXiBoFU064zKKzGhBdXmKuT8A4+NpxKFWW+7Flp0xazNN2d fyuYMXgRsyplLD/NJwicJPOoKH5+w2JuBT0d4= Original-Received: by 10.231.5.69 with SMTP id 5mr2276994ibu.127.1308349117615; Fri, 17 Jun 2011 15:18:37 -0700 (PDT) Original-Received: by 10.231.184.2 with HTTP; Fri, 17 Jun 2011 15:18:37 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 209.85.210.169 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:12580 Archived-At: --00151773e98c65cccb04a5efc48c Content-Type: text/plain; charset=ISO-8859-1 I followed a little tangent of c coding and tried to make it more fun to do. That is make it so I believed that I was coding in scheme but instead was taking on the old heavy weight machine gun in a glass house (C). using the guile library. So I want to be able to use scheme constants in an easy way and intermix C types and SCM in a controlled way in order to see what performances One can find. I took a small example implementing splay tree algorithms and you can find it in the end of the mail if you would like to see this. The timings show that calling c-functions are expensive. There is about a 10x speedup from calling a function in a loop in C in stead of calling it in a loop in scheme. The overhead of the call is about 0.08 mu for a working set of 10 elements and 0.15mu for 100 elements in the working set (for a splay tree lookup). To compare, it takes about 0.1 mu for the same call using hash-ref (a property list of 100 000 elements). A splay tree tries to move the working set towards the root in order to minimize the number of needed. What makes it nice is that one have the following features ( scm-value) ( `(alpha ,x ,@y)) Essentially let all list construction and scheme constants be enclosed bey ( . ) ( (a b) (((,a ,b) (,c . ,l) (begin code ...)) ...) E.g. a simple pmatch matcher to do safe list destruction Things returns a value, One can use for example us ( f ( ...)) A simple (let loop (...) code ...) eqvivalent is available although a little dangerous. As it looks this is just enough to make coding a lot nicer. Here is the example, (use-modules (language clambda clambda)) (use-modules (language clambda scm)) I call this clambda and the code is in the guile-unify repository right now Have fun #| Example code, splay tree using conses and guiles SCM system. Nodes are of the form (key val left right) and the head of the tree is in a cons cell. We assume that key are fixnums in order to get a speedy lookup code but this probably works on adresses as well. call (ins tree key val), to insert a key val pair call (del tree key) , to delete the key item call (get tree key) , to lookup the val of a key item, #f is returned at failure A splay tree is self organizing in that it will arrange the number of tree walks to be short for the working set. So if the usage pattern are similar and local then the tree will organize itself so that the hot set migrates quickly to the top of the tree. License: LGPL, Copyright: Stefan Israelsson Tampe |# (init-clambda-scm) (auto-defs) ;(clambda-add (cpp-include "header.h")) ;; Accessors (define-syntax get-tree (syntax-rules () ((_ tree) ( tree)))) (define-syntax mk-tree (syntax-rules () ((_ l) ( l ( '()))))) (define-syntax set-tree (syntax-rules () ((_ tree val) ( tree val)))) (define-syntax set-val (syntax-rules () ((_ x v) ( ( x) v)))) (define-syntax left (syntax-rules (get set) ((_ get x) ( ( ( x)))) ((_ set x val) ( ( ( x)) val)))) (define-syntax right (syntax-rules (get set) ((_ get x) ( ( ( ( x))))) ((_ set x val) ( ( ( ( x))) val)))) (define-syntax set-top (syntax-rules () ((_ me tree ippp ppp) ( ippp ( (<==> ippp ( -1)) (left set ppp me) (right set ppp me)) (set-tree tree me))))) ;; rotation patterns (define-syntax zig (syntax-rules () ((_ tree left right me p) ( (left set p (right get me)) (right set me p) (set-tree tree me))))) (define-syntax zig-zig (syntax-rules () ((_ tree left right me p pp ippp ppp) ( ( ((save-pr (right get p)) (save-mr (right get me))) (right set me p) (left set p save-mr) (right set p pp) (left set pp save-pr) (set-top me tree ippp ppp)))))) (define-syntax zig-zag (syntax-rules () ((_ tree left right me p pp ippp ppp) ( (left set pp (right get me)) (right set me pp) (right set p (left get me)) (left set me p) (set-top me tree ippp ppp))))) ;; the splay code (define-syntax splay (syntax-rules () ((_ ip ipp ippp me p pp ppp tree) ( ip ( ipp ( (<==> ipp ( -1)) ( (<==> ip ( -1)) (zig-zig tree left right me p pp ippp ppp) (zig-zag tree left right me p pp ippp ppp)) ( (<==> ip ( -1)) (zig-zag tree right left me p pp ippp ppp) (zig-zig tree right left me p pp ippp ppp))) ( (<==> ip ( -1)) (zig tree left right me p) (zig tree right left me p))))))) ( splay-lookup (tree key) ( loop ((SCM ppp ( #f)) (SCM pp ( #f)) (SCM p ( #f)) (SCM me (get-tree tree)) (int ippp ( 0)) (int ipp ( 0)) (int ip ( 0))) ( 1) ( (me) ((,k ,v . ,r) ( (<==> k key) ( (splay ip ipp ippp me p pp ppp tree) v) ( (r) ((,l ,r) ( (q< key k) (<> l ( loop pp p me l ipp ip ( -1)) ( #f)) (<> r ( loop pp p me r ipp ip ( 1)) ( #f)))) (_ ( ( "wrong tree format")))))) (_ ( ( "wrong tree format")))))) ( lookup (tree key) ( loop ((SCM me (get-tree tree))) ( (me) ((,k ,v . ,r) ( (<==> k key) v ( (r) ((,l ,r) ( (q< key k) (<> l ( loop l) ( #f)) (<> r ( loop r) ( #f)))) (_ ( ( "wrong tree format")))))) (_ ( ( "wrong tree format")))))) ( insert (tree key val) ( loop ((SCM me (get-tree tree))) ( (me) ((,k ,v . ,r) ( (<==> k key) (set-val me val) ( (r) ((,l ,r) ( (q< key k) (<> l ( loop l) (left set me ( `(,key ,val #f #f)))) (<> r ( loop r) (right set me ( `(,key ,val #f #f)))))) (_ ( ( "wrong tree format")))))) (_ (set-tree tree ( `(,key ,val #f #f))))))) ( ( new-tree () (mk-tree ( #f)))) ( splay-top (tree key) ( loop () ( (<==> key ( (get-tree tree))) ( #t) ( ( splay-lookup tree key) ( loop))))) ( int n ( 0)) ( int m ( 5)) ( ( get (tree key) (<++> n) ( (q<= m n) ( splay-lookup tree key) ( lookup tree key)))) ( ( ins (tree key val) ( insert tree key val) ( splay-top tree key))) ( get-leftmost-key (node) ( loop ((me node)) ( (me) ((,k _ ,l . _) (<> l ( loop l) k))))) ( get-rightmost-key (node) ( loop ((me node)) ( (me) ((,k _ _ ,r) (<> r ( loop r) k))))) ( ( del (tree key) (<> ( lookup tree key) ( ( splay-top tree key) ( ((get-tree tree)) ((_ _ ,l ,r) (<> l ( ((kl ( get-rightmost-key l)) (ll (mk-tree l))) ( splay-top ll kl) (right set (get-tree ll) r) (set-tree tree (get-tree ll))) (set-tree tree r)))) ( #t)) ( #f)))) ( ( mille (t n state) ( loop ((int i ( 0))) ( (<==> i ( 10000000)) ( #t) ( ( get t ( 'scm_random n state)) ( loop (<+> i ( 1)))))))) ( ( mille-hash (t n state) ( loop ((int i ( 0))) ( (<==> i ( 10000000)) ( #t) ( ( 'scm_hash_ref t ( 'scm_random n state) ( #f)) ( loop (<+> i ( 1)))))))) ( void init() (auto-inits)) (clambda->c "tree.c") --00151773e98c65cccb04a5efc48c Content-Type: text/html; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable I followed a little tangent of c coding and tried to make it more fun to do= . That is make it so I believed that
I was coding in scheme but instead = was taking on the old heavy weight machine gun in a glass house (C).
using the guile library.

So I want to be able to use scheme constant= s in an easy way and intermix C types and SCM in a controlled way
in ord= er to see what performances One can find.

I took a small example imp= lementing splay tree algorithms and you can find it in the end of the mail = if you would like to see
this.

The timings show that calling c-functions are expensive. There= is about a 10x speedup from calling a function in a loop in C
in stead = of calling it in a loop in scheme. The overhead of the call is about=A0=A0 = 0.08 mu for a working set of 10 elements and 0.15mu for 100 elements in the=
working set (for a splay tree lookup). To compare, it takes about 0.1 mu fo= r the same call using hash-ref=A0=A0 (a property list of 100 000 elements).=

A splay tree tries to move the working set towards the root in orde= r to minimize the number of needed.

What makes it nice is that one have the following features

(<= scm> scm-value)
(<scm> `(alpha ,x ,@y))

Essentially let = all list construction and scheme constants be enclosed bey (<scm> . )=

(<match> (a b) (((,a ,b) (,c . ,l)=A0 (begin code ...)) ...)
E= .g. a simple pmatch matcher to do safe list destruction

Things retur= ns a value, One can use for example us (<call> f (<match> ...))=

A simple (let loop (...) code ...) eqvivalent is available although a l= ittle dangerous.

As it looks this is just enough to make coding a lo= t nicer.

Here is the example,
(use-modules (language clambda clam= bda))
(use-modules (language clambda scm))

I call this clambda and the cod= e is in the guile-unify repository right now

Have fun
#|
=A0 E= xample code, splay tree using conses and guiles SCM system.
=A0 Nodes a= re of the form (key val left right) and the head of the
=A0 tree is in a cons cell. We assume that key are fixnums in order
=A0 = to get a speedy lookup code but this probably works on adresses
=A0 as = well.

=A0 call (ins=A0=A0=A0 tree key val), to insert a key val pair=
=A0 call (del=A0=A0=A0 tree key) , to delete the key item
=A0 call (get=A0=A0=A0 tree key) , to lookup the val of a key item, #f is r= eturned at failure

=A0 A splay tree is self organizing in that it wi= ll arrange the number of tree walks to be
=A0 short for the working set.= So if the usage pattern are similar and local then the tree
=A0 will organize itself so that the hot set migrates quickly to the top of= the tree.

=A0 License: LGPL, Copyright: Stefan Israelsson Tampe
= |#

(init-clambda-scm)

(auto-defs)

;(clambda-add (cpp-i= nclude "header.h"))

;; Accessors
(define-syntax get-tree
=A0 (syntax-rules ()
=A0= =A0=A0 ((_ tree) (<car> tree))))

(define-syntax mk-tree
=A0= (syntax-rules ()
=A0=A0=A0 ((_ l) (<cons> l (<scm> '())= ))))

(define-syntax set-tree
=A0 (syntax-rules ()
=A0=A0=A0 ((_ tree val) (<set-car> tree val))= ))

(define-syntax set-val
=A0 (syntax-rules ()
=A0=A0=A0 ((_ x= v) (<set-car> (<cdr> x) v))))

(define-syntax left
= =A0 (syntax-rules (get set)
=A0=A0=A0 ((_ get x)=A0=A0=A0=A0 (<car> (<cdr> (<cdr> x))= ))
=A0=A0=A0 ((_ set x val) (<set-car> (<cdr> (<cdr> x= )) val))))

(define-syntax right
=A0 (syntax-rules (get set)
= =A0=A0=A0 ((_ get x)=A0=A0=A0=A0 (<car> (<cdr> (<cdr> (&l= t;cdr> x)))))
=A0=A0=A0 ((_ set x val) (<set-car> (<cdr> (<cdr> (<cd= r> x))) val))))

(define-syntax set-top
=A0 (syntax-rules ()=A0=A0=A0 ((_ me tree ippp ppp)
=A0=A0=A0=A0 (<if> ippp
=A0=A0= =A0 =A0=A0 (<if> (<=3D=3D> ippp (<c> -1))
=A0=A0=A0 =A0=A0=A0 =A0(left=A0 set ppp me)
=A0=A0=A0 =A0=A0=A0 =A0(righ= t set ppp me))
=A0=A0=A0 =A0=A0 (set-tree tree me)))))

;; rotatio= n patterns
(define-syntax zig
=A0 (syntax-rules ()
=A0=A0=A0 ((_ t= ree left right me p)
=A0=A0=A0=A0 (<begin>
=A0=A0=A0=A0=A0 (left=A0 set p=A0 (right get me))
=A0=A0=A0=A0=A0 (right= set me p)
=A0=A0=A0=A0=A0 (set-tree tree me)))))

(define-syntax = zig-zig
=A0 (syntax-rules ()
=A0=A0=A0 ((_ tree left right me p pp ip= pp ppp)
=A0=A0=A0=A0 (<begin>
=A0=A0=A0=A0=A0 (<let*> ((s= ave-pr (right get p))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (save-mr (right get me)))
=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (right set me p)
=A0=A0=A0 =A0=A0= =A0=A0=A0 (left set p save-mr)
=A0=A0=A0 =A0=A0=A0=A0=A0 (right set p pp= )
=A0=A0=A0 =A0=A0=A0=A0=A0 (left set pp save-pr)=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0
=A0=A0=A0 =A0=A0=A0=A0=A0 (set-top me tree ippp ppp)= )))))

(define-syntax zig-zag
=A0 (syntax-rules ()
=A0=A0=A0 ((_ tree le= ft right me p pp ippp ppp)
=A0=A0=A0=A0 (<begin>
=A0=A0=A0=A0= =A0 (left set pp (right get me))
=A0=A0=A0=A0=A0 (right set me pp)
= =A0=A0=A0=A0=A0 (right set p (left get me))
=A0=A0=A0=A0=A0 (left set me p)
=A0=A0=A0=A0=A0 (set-top me tree ippp pp= p)))))


;; the splay code
(define-syntax splay
=A0 (syntax-= rules ()
=A0=A0=A0 ((_ ip ipp ippp me p pp ppp tree)
=A0=A0=A0=A0 (&l= t;if> ip
=A0=A0=A0 =A0=A0 (<if> ipp
=A0=A0=A0 =A0=A0=A0 =A0(<if> (<=3D=3D> ipp (<c> -1))
= =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<if> (<=3D=3D> ip (<= c> -1))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0 (zig-zig tree left= right me p pp ippp ppp)
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0 (zig= -zag tree left right me p pp ippp ppp))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<if> (<=3D=3D> ip (<= c> -1))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0 (zig-zag tree righ= t left me p pp ippp ppp)
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0 (zig-zig tree right left me p pp ippp ppp)))
=A0=A0=A0 =A0=A0= =A0 =A0(<if> (<=3D=3D> ip (<c> -1))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (zig tree left=A0 right me p)
=A0= =A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (zig tree right left=A0 me p)))))))
=

(<define> splay-lookup (tree key)
=A0=A0 (<recur> lo= op ((SCM ppp (<scm> #f))
=A0=A0=A0 =A0=A0=A0 =A0 (SCM pp=A0 (<s= cm> #f))
=A0=A0=A0 =A0=A0=A0 =A0 (SCM p=A0=A0 (<scm> #f))
=A0=A0=A0 =A0=A0= =A0 =A0 (SCM me=A0 (get-tree tree))
=A0=A0=A0 =A0=A0=A0 =A0 (int ippp (&= lt;c> 0))
=A0=A0=A0 =A0=A0=A0 =A0 (int ipp=A0 (<c> 0))
=A0= =A0=A0 =A0=A0=A0 =A0 (int ip=A0=A0 (<c> 0)))
=A0=A0=A0=A0 (<scm= > 1)
=A0=A0=A0=A0 (<match> (me)
=A0=A0=A0=A0=A0=A0 ((,k ,v . ,r)
=A0=A0=A0 (<if> (<=3D=3D> k= key)
=A0=A0=A0 =A0=A0=A0=A0=A0 (<begin> (splay ip ipp ippp me p p= p ppp tree)
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 v)
=A0=A0=A0 =A0= =A0=A0=A0=A0 (<match> (r)
=A0=A0=A0 =A0=A0=A0 ((,l ,r)
=A0=A0= =A0 =A0=A0=A0 =A0(<if> (q< key k)
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<<if>> l
=A0=A0=A0 = =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<next> loop pp p me l ipp ip = (<c> -1))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<sc= m> #f))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<<if>> r<= br>=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<next> loop pp p= me r ipp ip (<c> 1))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<scm> #f))))
=A0= =A0=A0 =A0=A0=A0 (_ (<error> (<scm> "wrong tree format&quo= t;))))))
=A0=A0=A0=A0=A0=A0 (_=A0 (<error> (<scm> "wron= g tree format"))))))


(<define> lookup (tree key)
=A0=A0 (<recur> loop ((SCM me=A0 (get-tree tree)))
=A0=A0=A0=A0 (&= lt;match> (me)
=A0=A0=A0=A0=A0=A0 ((,k ,v . ,r)
=A0=A0=A0 (<if&= gt; (<=3D=3D> k key)
=A0=A0=A0 =A0=A0=A0=A0=A0 v
=A0=A0=A0 =A0= =A0=A0=A0=A0 (<match> (r)
=A0=A0=A0 =A0=A0=A0 ((,l ,r)
=A0=A0= =A0 =A0=A0=A0 =A0(<if> (q< key k)
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<<if>> l
=A0=A0=A0 = =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<next> loop l)
=A0=A0=A0 = =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0=A0 (<scm> #f))
=A0=A0=A0 =A0= =A0=A0 =A0=A0=A0=A0=A0=A0 (<<if>> r
=A0=A0=A0 =A0=A0=A0 =A0= =A0=A0 =A0=A0=A0=A0=A0=A0 (<next> loop r)
=A0=A0=A0 =A0=A0=A0 =A0= =A0=A0 =A0=A0=A0=A0=A0=A0 (<scm> #f))))
=A0=A0=A0 =A0=A0=A0 (_ (<error> (<scm> "wrong tree format&= quot;))))))
=A0=A0=A0=A0=A0=A0 (_=A0 (<error> (<scm> "w= rong tree format"))))))



(<define> insert (tree ke= y val)
=A0 (<recur> loop ((SCM me (get-tree tree)))
=A0=A0=A0 (<match> (me)
=A0=A0=A0=A0=A0 ((,k ,v . ,r)
=A0=A0=A0= =A0=A0=A0 (<if> (<=3D=3D> k key)
=A0=A0=A0 =A0=A0=A0=A0 (set= -val me val)
=A0=A0=A0 =A0=A0=A0=A0 (<match> (r)
=A0=A0=A0 =A0= =A0=A0=A0=A0=A0 ((,l ,r)
=A0=A0=A0 =A0=A0=A0 (<if> (q< key k)=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (<<if>> l
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (<next> loop l)
=A0= =A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (left set me (<scm> `(,key= ,val #f #f))))
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (<<if>> = r
=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (<next> loop r)=A0=A0=A0 =A0=A0=A0 =A0=A0=A0 =A0=A0=A0=A0=A0 (right set me (<scm> `= (,key ,val #f #f))))))
=A0=A0=A0 =A0=A0=A0=A0=A0=A0 (_ (<error> (<scm> "wrong tre= e format"))))))
=A0=A0=A0=A0=A0
=A0=A0=A0=A0=A0 (_
=A0=A0= =A0=A0=A0=A0 (set-tree tree (<scm> `(,key ,val #f #f)))))))

(&= lt;scm-ext>
=A0(<define> new-tree () (mk-tree (<scm> #f))= ))

(<define> splay-top (tree key)
=A0 (<recur> loop ()
= =A0=A0=A0 (<if> (<=3D=3D> key (<car> (get-tree tree)))=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<scm> #t)
=A0=A0=A0=A0=A0=A0=A0=A0= =A0 (<begin>
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<call> splay-lo= okup tree key)
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<next> loop)))))


(<glob= al> int n (<c> 0))
(<global> int m (<c> 5))

= (<scm-ext>
=A0 (<define> get (tree key)
=A0=A0=A0 (<+= +> n)
=A0=A0=A0 (<if> (q<=3D m n)
=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<call> splay-lookup tree key)
=A0=A0= =A0=A0=A0=A0=A0=A0=A0 (<call> lookup=A0=A0=A0=A0=A0=A0 tree key))))
(<scm-ext>
=A0(<define> ins (tree key val)
=A0=A0 (= <call> insert tree key val)
=A0=A0 (<call> splay-top=A0 tree= key)))

(<define> get-leftmost-key (node)
=A0 (<recur> loop ((me= node))
=A0=A0=A0 (<match> (me)
=A0=A0=A0=A0=A0 ((,k _ ,l . _)<= br>=A0=A0=A0=A0=A0=A0 (<<if>> l
=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0 (<next> loop l)
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0 k)))))

(<define> get-rightmost-key (node)
=A0 (<recur> loop ((m= e node))
=A0=A0=A0 (<match> (me)
=A0=A0=A0=A0=A0 ((,k _ _ ,r)=A0=A0=A0=A0=A0=A0 (<<if>> r
=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0 (<next> loop r)
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0 k)))))

(<scm-ext>
=A0(<define> del (tree key)
=A0=A0 (<&l= t;if>> (<call> lookup tree key)
=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0 (<begin>
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<call> splay= -top tree key)
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<match> ((get-tr= ee tree))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 ((_ _ ,l ,r)
=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0 (<<if>> l=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<let*>=A0 ((kl (<call> ge= t-rightmost-key l))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (ll (mk-tree l)))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0 (<call> splay-top ll kl)
=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (r= ight set (get-tree ll) r)
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (set-tree tree (get-tree l= l)))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 = (set-tree tree r))))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<scm> #t))
=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0 (<scm> #f))))

(<scm-ext>
=A0(<define&= gt; mille (t n state)
=A0=A0 (<recur> loop ((int i (<c> 0)))=
=A0=A0=A0=A0 (<if> (<=3D=3D> i (<c> 10000000))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<scm> #t)
=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0 (<begin>
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<call> ge= t t (<icall> 'scm_random n state))
=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0 (<next> loop (<+> i (<c> 1))))))))

(<scm= -ext>
=A0(<define> mille-hash (t n state)
=A0=A0 (<recur> loop ((i= nt i (<c> 0)))
=A0=A0=A0=A0 (<if> (<=3D=3D> i (<c&g= t; 10000000))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<scm> #t)
=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0 (<begin>
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0 (<icall> 'scm_hash_ref t (<icall> 'scm_random n sta= te) (<scm> #f))
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0 (<next> loop (<+> i (<c>= ; 1))))))))
=A0=A0
=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0= =A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0=A0
(<define> void init()
= =A0 (auto-inits))

(clambda->c "tree.c")



=
--00151773e98c65cccb04a5efc48c--