[gambit-list] Idiomatic Scheme

Marijn hkBst at gentoo.org
Thu Jan 19 10:17:11 EST 2012


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

On 19-01-12 01:16, Roger Wilson wrote:
> Hi,

Hi Roger

> I'm still using Gambit Scheme from time to time and having a lot of
> fun with it.  I've a newbie question however, I'm trying to figure
> out the best way to structure code. With that in mind are there any
> comments on the following code?

This is often a good question, so since you asked I've spent some time
tearing your code apart, but also preparing an alternative answer, so
bear with me.

> I'm trying to create an 'object' that holds a list of names, can
> return a random one on request that can later be returned to it.

You mention a list here, but really that is not the right data
structure for random access, so don't take it literally.

> What's the proper Scheme way of doing this kind of thing?  Here's
> my stab, it returns a function that then accepts 'messages' as
> parameters....

My solution will follow you here although an alternative is to use an
object/class system depending on your scheme implementation so you
don't have to wire public methods manually.

> (define (make-name-list seed-names)
> 
> ;; The type the list is built from (define-type blob-name

Really dislike the name `blob-name' you chose here and it leads to
horrendously named accessors. Better just use `blob', `entry' or
`elt'. Also there is no reason this data structure need only contain
names; really any scheme value can be stored in it, so you should
choose more generic names based on that.

> name (random init: 0))     ; Used for sorting

Such as `item' and `key'.

> (let ((unused-name-list '()))

Why would you want to have an ``unused list'' in your data structure?
Surely it would be better if the data structure members are actually
put to good use? ;P

> (define (randomise-list) ; Assign each name a random number and
> then sort them (map (lambda (x) (blob-name-random-set! x
> (random-integer 65536))) unused-name-list)

> (sort! unused-name-list (lambda (x y) (if (< (blob-name-random x)
> (blob-name-random y)) #t #f))))
> 
> 
> ;; Put all the seed names in the list (map (lambda (x) (push
> (make-blob-name x) unused-name-list)) seed-names)

Try to limit the line-width you use (for email consumption).

> (lambda (message . arguments) (cond ((eq? message ':get-name!) (if
> (null? unused-name-list) "No names available" (begin (let ((name
> (blob-name-name (car unused-name-list)))) (set! unused-name-list
> (cdr unused-name-list)) name))))
> 
> ; Add a name to the list, used to return names once they're no
> longer needed

What do you mean no longer needed? These names WILL come back if you
':get-item! long enough.

> ((eq? message ':put-name!) (push (make-blob-name (car arguments))
> unused-name-list) (randomise-list))


> ; Debug, print the internal display ((eq? message ':display) 
> (display unused-name-list))
> 
> (else (error 'name-list "unrecognized message"))))))
> 
> 
> ;; Test drive code....... (define name-list (make-name-list (list
> "Albert" "Bruce" "Clive"))) (display (name-list ':get-name!)) 
> (name-list ':put-name! "David") (name-list ':put-name! "Edgar") 
> (name-list ':put-name! "Frederick")
> 
> (display (name-list ':display))

Excellent, we have test code!

> Some points:
> 
> In particular I'm unhappy with the way the message arguments are
> accessed as (car arguments) rather than by explicit name.  I can
> see that being a potential cause of bugs if the number of arguments
> grows and they vary with each message.

Really what you would like here is to be able to match the arguments
to a number of patterns which correspond to the different ways this
procedure can be validly called. Thinks of `match' as `case' on
steroids. Really BIG steroids. Steroids so big you can hide several
dozen cases of `case's in their shadow. `match' swallows these
steroids whole so you get the idea...
A quick search seems to indicate `no', but: Does gambit have `match'?

> I realise that the randomise-list function is probably called too
> often and maintaining a 'dirty bit' would allow it to be only
> called when necessary when getting a name.

It is an option, but you can do even better if you use a vector to
store your items.

> I've years of C/C++ programming behind me, which is probably
> readily apparent.

No comment? ;P
Seriously, you made that too easy.
More seriously, it can go either way and if you're aware of the
potential for bad influence (like you seem to be) then it should be
possible to use that experience to your advantage. For example when
estimating the cost of certain constructs.

> How can I improve the code?

I have prepared an alternative solution to your specification here. In
racket since that is what I am most familiar with atm. Really the only
racket-specific stuff seems to be the match-lambda*, although keyword
arguments probably work differently in gambit and I'm not sure gambit
has a vector->values which isn't essential to anything. And I don't
know about unit testing for gambit. Some expert gambitteer(?) should
be able to fill in the details of those differences.


#lang racket

(require rackunit)

(define (make-random-store #:capacity (capacity 99) . init-entries)
  (define size 0)
  (define store (make-vector capacity))

  (define (add-entries entries)
    (for-each (lambda (e) (add-entry e)) entries))

  (define (add-entry entry)
    (define (_add-entry)
      (vector-set! store size entry)
      (set! size (+ size 1)))

    (define capacity (vector-length store))

    (if (< size capacity)
        (_add-entry)
        (let ((new-store (make-vector (* 2 capacity))))
          (vector-copy! new-store 0 store)
          (set! store new-store)
          (_add-entry)))  )

  (define (remove-entry n)
    (cond ((< -1 n size)
           (set! size (- size 1))
           (define ret (vector-ref store n))
           (vector-set! store n (vector-ref store size))
           ret)
          (else (error "index out of range")) )  )

  (define (entries)
    (vector->values store 0 size))

  (add-entries init-entries)

  (match-lambda*
    ((list 'put! entries ...) (add-entries entries))
    ((list 'get!) (remove-entry (random size)))
    ((list 'size) size)
    ((list 'entries) (entries)) )  )

;; Test drive code.......
(define name-list (make-random-store "Albert" "Bruce" "Clive"))
(check-true
 (set=? (call-with-values (lambda () (name-list 'entries)) set)
        (set "Albert" "Bruce" "Clive")))
(define name1 (name-list 'get!))
(check-not-false (member name1 '("Albert" "Bruce" "Clive")))
(name-list 'put! "David" "Paul")
(name-list 'put! "Edgar")
(name-list 'put! "Frederick")
(define name2 (name-list 'get!))
(check-true
 (set=?
  (set-union
   (set name1 name2)
   (call-with-values (lambda () (name-list 'entries)) set))
  (set "Albert" "Bruce" "Clive" "David" "Paul" "Edgar" "Frederick") ))


I hope that was helpful,

Marijn
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.18 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/

iEYEARECAAYFAk8YM/cACgkQp/VmCx0OL2w66ACfQXj/PeGIf0Ibq3AdebTmVKiD
cwQAoJf/Uz9hRyK1ekPcjJfVbTGm09jS
=XdPT
-----END PGP SIGNATURE-----



More information about the Gambit-list mailing list