Refactoring functions out of common.scm

This commit is contained in:
Justin Ethier 2015-07-01 22:19:30 -04:00
parent cb55609c19
commit a6da96ba57
4 changed files with 30 additions and 28 deletions

View file

@ -6,7 +6,6 @@
; TODO: need filter for the next two. also, they really belong in SRFI-1, not here ; TODO: need filter for the next two. also, they really belong in SRFI-1, not here
;delete ;delete
;delete-duplicates ;delete-duplicates
list-insert-at!
call-with-current-continuation call-with-current-continuation
call/cc call/cc
call-with-values call-with-values

View file

@ -33,30 +33,3 @@
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define *features* '(cyclone)) (define *features* '(cyclone))
;; Based off corresponding SRFI-1 definition
(define (delete x lis)
(filter (lambda (y) (not (equal? x y))) lis))
;; Inefficient version based off code from SRFI-1
(define (delete-duplicates lis)
(define (recur lis) ; ((lis lis))
(if (null? lis) lis
(let* ((x (car lis))
(tail (cdr lis))
(new-tail (recur (delete x tail))))
(if (eq? tail new-tail) lis (cons x new-tail)))))
(recur lis))
;; Insert obj at index k of list, increasing length of list by one.
(define (list-insert-at! lis obj k)
(cond
((null? lis) (error "list-insert-at!, lis cannot be null"))
((and (> k 0) (null? (cdr lis)))
(set-cdr! lis (cons obj '())))
((zero? k)
(let ((old-car (car lis)))
(set-car! lis obj)
(set-cdr! lis (cons old-car (cdr lis)))))
(else
(list-insert-at! (cdr lis) obj (- k 1)))))

View file

@ -12,6 +12,9 @@
mangle mangle
mangle-global mangle-global
;; Scheme library functions ;; Scheme library functions
delete
delete-duplicates
list-insert-at!
any any
every every
filter) filter)

View file

@ -48,6 +48,33 @@
(recur tail))))))) (recur tail)))))))
(recur lis))) (recur lis)))
;; Based off corresponding SRFI-1 definition
(define (delete x lis)
(filter (lambda (y) (not (equal? x y))) lis))
;; Inefficient version based off code from SRFI-1
(define (delete-duplicates lis)
(define (recur lis) ; ((lis lis))
(if (null? lis) lis
(let* ((x (car lis))
(tail (cdr lis))
(new-tail (recur (delete x tail))))
(if (eq? tail new-tail) lis (cons x new-tail)))))
(recur lis))
;; Insert obj at index k of list, increasing length of list by one.
(define (list-insert-at! lis obj k)
(cond
((null? lis) (error "list-insert-at!, lis cannot be null"))
((and (> k 0) (null? (cdr lis)))
(set-cdr! lis (cons obj '())))
((zero? k)
(let ((old-car (car lis)))
(set-car! lis obj)
(set-cdr! lis (cons old-car (cdr lis)))))
(else
(list-insert-at! (cdr lis) obj (- k 1)))))
;; Name-mangling. ;; Name-mangling.