learning-sicp

My embarrassing half assed SICP run.
Log | Files | Refs

doubly-linked-list.scm (2215B)

      1 (define-library (sicp solutions 3_23 doubly-linked-list)
      2   (import (scheme base))
      3   (import (scheme write))
      4 
      5   (import (ice-9 pretty-print))
      6 
      7   (export
      8    delete-front!
      9    delete-rear!
     10    doubly-linked-list->list
     11    list->doubly-linked-list
     12    link-front
     13    link-item
     14    link-rear
     15    link-up-front-to-rear!
     16    make-link
     17    )
     18 
     19   (begin
     20     (define (make-link item)
     21       (cons item
     22             (cons '() '())))
     23 
     24     (define (list->doubly-linked-list l)
     25       (cond
     26        ((null? l)
     27         '())
     28        (else
     29         (let* ([item (car l)]
     30                [new-link (make-link item)]
     31                [rest-of-list (cdr l)]
     32                [rest-of-doubly-linked-list (list->doubly-linked-list rest-of-list)])
     33           (link-up-left-to-right! new-link
     34                     rest-of-doubly-linked-list)))))
     35 
     36     (define (link-item link)
     37       "Returns LINK's item."
     38       (car link))
     39 
     40     (define (link-front link)
     41       "Returns the link at the front of LINK."
     42       (cadr link))
     43 
     44     (define (link-rear link)
     45       "Returns the link at the rear of LINK."
     46       (cddr link))
     47 
     48     (define (set-front-pointer! link object)
     49       "Set the front pointer of LINK to point at OBJECT."
     50       (set-car! (cdr link)
     51                 object))
     52 
     53     (define (set-rear-pointer! link object)
     54       "Set the rear pointer of LINK to point at OBJECT."
     55       (set-cdr! (cdr link)
     56                 object))
     57 
     58     (define (link-up-front-to-rear! link-1 link-2)
     59       "Set the rear pointer of LINK-1 to point at LINK-2 and the front pointer of LINK-2 to point at LINK-1. Returns LINK-1."
     60       (when (not (null? link-1))
     61         (set-rear-pointer! link-1
     62                            link-2))
     63       (when (not (null? link-2))
     64         (set-front-pointer! link-2
     65                             link-1))
     66       link-1)
     67 
     68     (define (delete-front! link)
     69       "Set the front pointer of LINK to be '()."
     70       (set-front-pointer! link '()))
     71 
     72     (define (delete-rear! link)
     73       "Set the rear pointer of LINK to be '()."
     74       (set-rear-pointer! link '()))
     75 
     76 
     77     (define (doubly-linked-list->list link)
     78       (cond
     79        ((null? link)
     80         '())
     81        (else
     82         (cons (link-item link)
     83               (doubly-linked-list->list (link-rear link))))))))