Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
54 changes: 54 additions & 0 deletions goldfish/liii/list.scm
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,8 @@
flat-map
list-null? list-not-null? not-null-list?
length=? length>? length>=? flatten
; Scala-style take/drop with boundary tolerance
list-take list-drop list-take-right list-drop-right
) ;export
(import (srfi srfi-1)
(srfi srfi-13)
Expand Down Expand Up @@ -86,6 +88,58 @@

(define flat-map append-map)

(define (list-take lst n)
(unless (list? lst)
(type-error "list-take: first argument must be a list" lst)
) ;unless
(unless (integer? n)
(type-error "list-take: second argument must be an integer" n)
) ;unless
(cond ((< n 0) '())
((>= n (length lst)) lst)
(else (take lst n))
) ;cond
) ;define

(define (list-drop lst n)
(unless (list? lst)
(type-error "list-drop: first argument must be a list" lst)
) ;unless
(unless (integer? n)
(type-error "list-drop: second argument must be an integer" n)
) ;unless
(cond ((< n 0) lst)
((>= n (length lst)) '())
(else (drop lst n))
) ;cond
) ;define

(define (list-take-right lst n)
(unless (list? lst)
(type-error "list-take-right: first argument must be a list" lst)
) ;unless
(unless (integer? n)
(type-error "list-take-right: second argument must be an integer" n)
) ;unless
(cond ((< n 0) '())
((>= n (length lst)) lst)
(else (take-right lst n))
) ;cond
) ;define

(define (list-drop-right lst n)
(unless (list? lst)
(type-error "list-drop-right: first argument must be a list" lst)
) ;unless
(unless (integer? n)
(type-error "list-drop-right: second argument must be an integer" n)
) ;unless
(cond ((< n 0) lst)
((>= n (length lst)) '())
(else (drop-right lst n))
) ;cond
) ;define

(define (not-null-list? l)
(cond ((pair? l)
(or (null? (cdr l)) (pair? (cdr l))))
Expand Down
104 changes: 4 additions & 100 deletions goldfish/liii/rich-list.scm
Original file line number Diff line number Diff line change
Expand Up @@ -224,121 +224,25 @@

(define (%take x . args)
(chain-apply args
(begin
(define (scala-take data n)
(unless (list? data)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-take '(data n) 'data "list" (object->string data)
) ;format
) ;type-error
) ;unless
(unless (integer? n)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-take '(data n) 'n "integer" (object->string n)
) ;format
) ;type-error
) ;unless

(cond ((< n 0) '())
((>= n (length data)) data)
(else (take data n))
) ;cond
) ;define

(rich-list (scala-take data x))
) ;begin
(rich-list (list-take data x))
) ;chain-apply
) ;define

(define (%drop x . args)
(chain-apply args
(begin
(define (scala-drop data n)
(unless (list? data)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-drop '(data n) 'data "list" (object->string data)
) ;format
) ;type-error
) ;unless
(unless (integer? n)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-drop '(data n) 'n "integer" (object->string n)
) ;format
) ;type-error
) ;unless

(cond ((< n 0) data)
((>= n (length data)) '())
(else (drop data n))
) ;cond
) ;define

(rich-list (scala-drop data x))
) ;begin
(rich-list (list-drop data x))
) ;chain-apply
) ;define

(define (%take-right x . args)
(chain-apply args
(begin
(define (scala-take-right data n)
(unless (list? data)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-take-right '(data n) 'data "list" (object->string data)
) ;format
) ;type-error
) ;unless
(unless (integer? n)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-take-right '(data n) 'n "integer" (object->string n)
) ;format
) ;type-error
) ;unless

(cond ((< n 0) '())
((>= n (length data)) data)
(else (take-right data n))
) ;cond
) ;define

(rich-list (scala-take-right data x))
) ;begin
(rich-list (list-take-right data x))
) ;chain-apply
) ;define

(define (%drop-right x . args)
(chain-apply args
(begin
(define (scala-drop-right data n)
(unless (list? data)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-drop-right '(data n) 'data "list" (object->string data)
) ;format
) ;type-error
) ;unless
(unless (integer? n)
(type-error
(format #f "In funtion #<~a ~a>: argument *~a* must be *~a*! **Got ~a**"
scala-drop-right '(data n) 'n "integer" (object->string n)
) ;format
) ;type-error
) ;unless

(cond ((< n 0) data)
((>= n (length data)) '())
(else (drop-right data n))
) ;cond
) ;define

(rich-list (scala-drop-right data x))
) ;begin
(rich-list (list-drop-right data x))
) ;chain-apply
) ;define

Expand Down
59 changes: 6 additions & 53 deletions goldfish/liii/rich-vector.scm
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,8 @@

(define-library (liii rich-vector)
(import (liii string) (liii hash-table) (liii sort) (liii list) (liii vector) (liii oop) (srfi srfi-8)
(rename (liii rich-option) (rich-option option)))
(rename (liii rich-option) (rich-option option))
) ;import
(export rich-vector)
(begin

Expand Down Expand Up @@ -219,74 +220,26 @@
) ;define

(define (%take n . args)
(define (scala-take data n)
(cond
((< n 0) (vector))
((>= n (vector-length data)) data)
(else
(let ((new-vec (make-vector n)))
(do ((i 0 (+ i 1)))
((>= i n) new-vec)
(vector-set! new-vec i (vector-ref data i))
) ;do
) ;let
) ;else
) ;cond
) ;define

(chain-apply args
(rich-vector (scala-take data n))
(rich-vector (vector-take data n))
) ;chain-apply
) ;define

(define (%take-right n . args)
(define (scala-take-right data n)
(let ((len (vector-length data)))
(cond
((< n 0) (vector))
((>= n len) data)
(else
(let ((new-vec (make-vector n)))
(do ((i (- len n) (+ i 1))
(j 0 (+ j 1)))
((>= j n) new-vec)
(vector-set! new-vec j (vector-ref data i))
) ;do
) ;let
) ;else
) ;cond
) ;let
) ;define

(chain-apply args
(rich-vector (scala-take-right data n))
(rich-vector (vector-take-right data n))
) ;chain-apply
) ;define

(define (%drop n . args)
(define (scala-drop data n)
(cond
((< n 0) data)
((>= n (vector-length data)) (vector))
(else (vector-copy data n))
) ;cond
) ;define
(chain-apply args
(rich-vector (scala-drop data n))
(rich-vector (vector-drop data n))
) ;chain-apply
) ;define

(define (%drop-right n . args)
(define (scala-drop-right data n)
(cond
((< n 0) data)
((>= n (vector-length data)) (vector))
(else (vector-copy data 0 (- (vector-length data) n)))
) ;cond
) ;define

(chain-apply args
(rich-vector (scala-drop-right data n))
(rich-vector (vector-drop-right data n))
) ;chain-apply
) ;define

Expand Down
63 changes: 62 additions & 1 deletion goldfish/liii/vector.scm
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,9 @@
vector-swap! vector-reverse! vector-cumulate reverse-list->vector
vector= vector-contains?
; Liii Extras
vector-filter
vector-filter vector-contains?
; Scala-style take/drop with boundary tolerance
vector-take vector-drop vector-take-right vector-drop-right
) ;export
(begin

Expand Down Expand Up @@ -66,6 +68,65 @@
) ;let
) ;define

(define (vector-take vec n)
(unless (vector? vec)
(type-error "vector-take: first argument must be a vector" vec)
) ;unless
(unless (integer? n)
(type-error "vector-take: second argument must be an integer" n)
) ;unless
(let ((len (vector-length vec)))
(cond ((< n 0) (vector))
((>= n len) vec)
(else (vector-copy vec 0 n))
) ;cond
) ;let
) ;define

(define (vector-drop vec n)
(unless (vector? vec)
(type-error "vector-drop: first argument must be a vector" vec)
) ;unless
(unless (integer? n)
(type-error "vector-drop: second argument must be an integer" n)
) ;unless
(let ((len (vector-length vec)))
(cond ((< n 0) vec)
((>= n len) (vector))
(else (vector-copy vec n))
) ;cond
) ;let
) ;define

(define (vector-take-right vec n)
(unless (vector? vec)
(type-error "vector-take-right: first argument must be a vector" vec)
) ;unless
(unless (integer? n)
(type-error "vector-take-right: second argument must be an integer" n)
) ;unless
(let ((len (vector-length vec)))
(cond ((< n 0) (vector))
((>= n len) vec)
(else (vector-copy vec (- len n)))
) ;cond
) ;let
) ;define

(define (vector-drop-right vec n)
(unless (vector? vec)
(type-error "vector-drop-right: first argument must be a vector" vec)
) ;unless
(unless (integer? n)
(type-error "vector-drop-right: second argument must be an integer" n)
) ;unless
(let ((len (vector-length vec)))
(cond ((< n 0) vec)
((>= n len) (vector))
(else (vector-copy vec 0 (- len n)))
) ;cond
) ;let
) ;define

) ;begin
) ;define-library
Expand Down
Loading
Loading