diff --git a/data-structures/lists.scm b/data-structures/lists.scm new file mode 100644 index 0000000..46dca47 --- /dev/null +++ b/data-structures/lists.scm @@ -0,0 +1,26 @@ +(define (rangeinc b e) + (cond + ((> b e) '()) + (#t (cons b (rangeinc (+ 1 b) e))))) + +(define (less-than l n) (cond ((null? l) #t) ((<= n 0) #f) (#t (less-than (cdr l) (- n 1))))) +(define (unit v) v) +(define (aget key alist) (cdr (assoc key alist))) +(define (aset key val alist) + (cond + ((null? alist) `((,key . ,val))) + ((eqv? (caar alist) key) (cons `(,key . ,val) (cdr alist))) ; found and updated + (#t (cons (car alist) (aset key val (cdr alist)))) ; continue to seek +)) + +(define (dedup l p c) + (cond + ((null? l) `(((str . ,p) (ctr . ,c)))) + ((string=? p (car l)) (dedup (cdr l) p (+ c 1))) + (#t (cons `((str . ,p) (ctr . ,c)) (dedup (cdr l) (car l) 1))) +)) + +(define (dedup<=? d1 d2) + (<= (aget 'ctr d1) (aget 'ctr d2))) + + diff --git a/data-structures/strings.scm b/data-structures/strings.scm new file mode 100644 index 0000000..e0f671e --- /dev/null +++ b/data-structures/strings.scm @@ -0,0 +1,18 @@ +;--- String manipulation + +(define (string-suffix? src suffix) + (let [(src-len (string-length src)) (suf-len (string-length suffix))] + (and + (>= src-len suf-len) + (string=? suffix (substring src (- src-len suf-len) src-len)) +))) + +(define (string-prefix? src prefix) + (let [(src-len (string-length src)) (pref-len (string-length prefix))] + (and + (>= src-len pref-len) + (string=? prefix (substring src 0 pref-len)) +))) + +(define (string-contains? src elem) ; we use port logic to implement this one + (seek-until (open-input-string src) elem)) diff --git a/io/filesystem.scm b/io/filesystem.scm new file mode 100644 index 0000000..c4e8fa1 --- /dev/null +++ b/io/filesystem.scm @@ -0,0 +1,13 @@ +(define (build-path p1 p2) + (format "~a~a~a" p1 (directory-separator) p2)) + +(define (walk-rec path subpath) + (cond + ((null? subpath) '()) + (#t (append (walk (build-path path (car subpath))) (walk-rec path (cdr subpath)))) +)) + +(define (walk path) + (cond + ((file-directory? path) (walk-rec path (directory-list path))) + (#t (list path)))) diff --git a/io/ports.scm b/io/ports.scm new file mode 100644 index 0000000..c8ed0ff --- /dev/null +++ b/io/ports.scm @@ -0,0 +1,34 @@ +(define (marker-finder step not-found found port marker remaining) + (let [(r (get-char port))] + (cond + ((eof-object? r) (not-found)) + ((char=? r (car remaining)) + (step + r + (cond + ((null? (cdr remaining)) (found)) + (#t (marker-finder step not-found found port marker (cdr remaining)))))) + (#t (step r (marker-finder step not-found found port marker marker))) +))) + +(define (read-until port marker) + (list->string + (marker-finder + (lambda (e r) (cons e r)) + (lambda () '()) + (lambda () '()) + port + (string->list marker) + (string->list marker) +))) + +(define (seek-until port marker) + (marker-finder + (lambda (e r) r) + (lambda () #f) + (lambda () #t) + port + (string->list marker) + (string->list marker) +)) +