Hi Laurent, On 08/30/11 09:18, Laurent wrote: > Thank you very much for this nice intermediate solution, though I need > constant-time append, split, insert, remove, + pointers to items, etc. > Mutation does seem unavoidable, right.
I implemented a doubly-linked list, not so long ago, connected to a GUI that can insert and delete items and saw no way to make the list functional with multiple simultaneous editors in the GUI. The implementation is as a straightforward cyclical doubly-linked list. I toyed with the idea of having a separate handle object to represent the list versus just the nodes, and there are some rudiments of that left in the code, but in the end the user code uses a special 'top element to indicate where the cyclical list is supposed to start. Good luck, Marijn
(module dlist racket
(provide dlist dl-insert dl-insert-right dl-remove for/dlist)
(require (for-syntax racket))
(define (dl-print dl p write?)
(let ((print (if write? write display)))
(display #\( p)
(let loop ((l dl))
(print (_dl-val l) p)
(let ((right (_dl-right l)))
(if (eq? right dl)
(display #\) p)
(begin (display " " p) (loop right)) )))))
(define (dl-sequence l)
(if (dl-empty? l)
(make-do-sequence (lambda () (values #f #f #f (lambda (lk) #f) #f #f)))
(let ((last (_dl-left l)))
(make-do-sequence
(lambda () ; val next start last?
(values _dl-val _dl-right l #f #f (lambda (lk v) (not (eq? lk
last)))) )))))
;;; link
(define-struct _dl (left val right) #:mutable
#:property prop:custom-write dl-print
#:property prop:sequence dl-sequence
) ; end link
(define (dlh-print dlh p write?)
(dl-print (_dlh-link dlh) p write?))
(define (dlh-sequence l)
(let ((h (_dlh-link l)))
(make-do-sequence
(lambda () ; val next start last?
(values _dl-val _dl-right (_dl-right h) (lambda (lk) (not (eq? lk h)))
#f #f) ))))
;;; list handle
(struct _dlh (link) #:mutable
#:property prop:custom-write dlh-print
#:property prop:sequence dlh-sequence
) ; end handle
(define (dl-empty)
(_dl #f #f #f))
(define (dlh-empty)
(_dlh (dl-empty)))
(define (dl-empty? l)
(not (_dl-left l)))
(define (dl-one-element? l)
(eq? l (_dl-left l)))
(define (dlh-empty? l)
(dl-empty? (_dlh-link l)))
; (define (dlist a b c)
; (shared ((la (_dl #f a lb))
; (lb (_dl la b lc))
; (lc (_dl lb c #f)) )
; la))
(define-syntax (dlist stx)
(syntax-case stx ()
((_) #'(dl-empty))
((_ a b ...)
(let* ((temps (generate-temporaries #'(a b ...))) (links `(,(last temps)
,@temps ,(first temps))))
#`(shared
#,(let loop ((ret '()) (links links) (vals (syntax->list #'(a b
...))))
(if (empty? vals) (reverse ret)
(loop (cons #`(#,(cadr links) (make-_dl #,(car links)
#,(car vals) #,(caddr links))) ret)
(cdr links) (cdr vals) )))
#,(cadr links))))))
(define-syntax-rule (dlisth a b ...) (_dlh (dlist #f a b ...)))
(define-syntax-rule (_dl-insert val link link-next new-link set-link-next!
set-link-prev!)
(if (dl-empty? link) (dlist val)
(let* ((next (link-next link)) (new (new-link link val next)))
(set-link-next! link new)
(and next (set-link-prev! next new))
new)))
(define (dl-insert-right v l)
(_dl-insert v l _dl-right _dl set-_dl-right! set-_dl-left!))
(define (dl-insert v l)
(let-syntax ((dl (syntax-rules () ((_ r v l) (_dl l v r)))))
(_dl-insert v l _dl-left dl set-_dl-left! set-_dl-right!)))
(define-syntax-rule (_dlh-insert v l insert)
(let ((h (_dlh-link l)))
(if h
(insert v h)
(set-_dlh-link! l (dlist v)) )))
(define (dlh-insert-front v l)
(_dlh-insert v l dl-insert-right))
(define (dlh-insert-back v l)
(_dlh-insert v l dl-insert))
(define (dl-remove link (ret #f))
(if (or (dl-empty? link) (dl-one-element? link))
(dl-empty)
(let ((l (_dl-left link)) (r (_dl-right link)))
(set-_dl-right! l r)
(set-_dl-left! r l)
(if ret l r))))
(define (dl-reverse link)
(if (dl-empty? link) (dl-empty)
(let ((left (_dl-left link)) (right (_dl-right link)))
(set-_dl-right! link left)
(set-_dl-left! link right)
(let loop ((lft link) (lnk right))
(if (eq? lnk link) left
(let ((rght (_dl-right lnk)))
(set-_dl-right! lnk lft)
(set-_dl-left! lnk rght)
(loop lnk rght)))))))
; (define (dlh-reverse l)
(define-syntax-rule (for/dlist clauses body ... val)
(_dl-right (for/fold ((ret (dl-empty))) clauses (dl-insert-right val ret))))
) ; end module #lang racket/gui
;(require dlist)
(require "./dlist.rkt")
(define list-editor%
(class vertical-panel%
(init init-values parent)
(super-new (parent parent))
(define widget-list (dlist 'top))
(define (redisplay)
(send this change-children (lambda (l) (cdr (for/list ((w widget-list))
w)))))
(define (insert-item val link)
(let* ((v (new vertical-panel% (parent this)))
(lk (dl-insert v link))
(ins (new button% (parent v) (label "insert")
(callback (λ (b e)
(insert-item "1" lk) (redisplay) )) ) )
(h (new horizontal-pane% (parent v)))
(t (new text-field% (parent h) (label "") (init-value val)))
(del (new button% (parent h) (label "del")
(callback (λ (b e) (dl-remove lk) (send this
delete-child v))) )))
lk))
; (send this begin-container-sequence)
(for ((v init-values)) (insert-item v widget-list))
; (send this end-container-sequence)
(let* ((v (new vertical-panel% (parent this)))
(lk (dl-insert v widget-list)))
(new button% (parent v) (label "append")
(callback (λ (b e) (insert-item "1" lk) (redisplay))) ))
)) ; end define class
(define root (new frame% (label "List Editor") (stretchable-height #f)))
(new list-editor% (parent root) (init-values '("1" "2" "3")))
(send root show #t)
signature.asc
Description: OpenPGP digital signature
_________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/users
