[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/gFUCaHuY    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Sep 26:
; growable arrays

(define (get arr sub)
  (cond ((null? arr) (error 'get "array out of bounds"))
        ((= sub 1) (car arr))
        ((even? sub) (get (cadr arr) (quotient sub 2)))
        (else (get (caddr arr) (quotient sub 2)))))

(define (put arr sub val)
  (cond ((null? arr)
          (if (= sub 1)
              (list val '() '())
              (error 'put "array out of bounds")))
        ((= sub 1)
          (list val '() '()))
        ((even? sub)
          (list (car arr)
                (put (cadr arr) (quotient sub 2) val)
                (caddr arr)))
        (else (list (car arr) (cadr arr)
                    (put (caddr arr) (quotient sub 2) val)))))

(define (hirem arr sub)
  (cond ((null? arr) (error 'hirem "array out of bounds"))
        ((= sub 1) '())
        ((even? sub)
          (list (car arr)
                (hirem (cadr arr) (quotient sub 2))
                (caddr arr)))
        (else (list (car arr) (cadr arr)
                    (hirem (caddr arr) (quotient sub 2))))))

(define x (list 0))
(set! x (cons (+ (car x) 1) (put (cdr x) 1 "alfa")))
(set! x (cons (+ (car x) 1) (put (cdr x) 2 "bravo")))
(set! x (cons (+ (car x) 1) (put (cdr x) 3 "charlie")))
(set! x (cons (+ (car x) 1) (put (cdr x) 4 "delta")))
(set! x (cons (+ (car x) 1) (put (cdr x) 5 "echo")))
(set! x (cons (+ (car x) 1) (put (cdr x) 6 "foxtrot")))
(set! x (cons (+ (car x) 1) (put (cdr x) 7 "golf")))
(display x) (newline)
(display (get (cdr x) 7)) (newline)
(display (get (cdr x) 12)) (newline)
(set! x (cons (- (car x) 1) (hirem (cdr x) (car x))))
(display (get (cdr x) 7)) (newline)


Output:
1
2
3
(7 alfa (bravo (delta () ()) (foxtrot () ())) (charlie (echo () ()) (golf () ())))
golf
get: array out of bounds


Create a new paste based on this one


Comments: