diff options
| author | 2024-12-28 13:29:42 -0500 | |
|---|---|---|
| committer | 2024-12-28 13:29:42 -0500 | |
| commit | 0852fa10ffe3f2ef821986b7842004b156d0f018 (patch) | |
| tree | 92444c7c6d54699b9e8c7e28e3e7cec5cab0b185 | |
| parent | convert to chicken (diff) | |
refactor tests, add working code for list
| -rw-r--r-- | mcgoron.iterator.exceptions.sld | 12 | ||||
| -rw-r--r-- | mcgoron.iterator.list.scm | 87 | ||||
| -rw-r--r-- | mcgoron.iterator.list.sld | 22 | ||||
| -rw-r--r-- | tests/list.scm | 32 | ||||
| -rw-r--r-- | tests/run.scm | 37 | ||||
| -rw-r--r-- | tests/string.scm | 51 |
6 files changed, 205 insertions, 36 deletions
diff --git a/mcgoron.iterator.exceptions.sld b/mcgoron.iterator.exceptions.sld index b989a6c..ce1b8db 100644 --- a/mcgoron.iterator.exceptions.sld +++ b/mcgoron.iterator.exceptions.sld @@ -21,7 +21,10 @@ non-integer-movement-exception non-integer-movement-exception? non-integer-movement-exception:spaces negative-movement-exception negative-movement-exception? - negative-movement-exception:spaces) + negative-movement-exception:spaces + improper-list-exception improper-list-exception? + improper-list-exception:idx + improper-list-exception:cdr) (begin (define-record-type <field-not-found-exception> (field-not-found-exception field iterator) @@ -35,5 +38,10 @@ (define-record-type <negative-movement-exception> (negative-movement-exception spaces) negative-movement-exception? - (spaces negative-movement-exception:spaces)))) + (spaces negative-movement-exception:spaces)) + (define-record-type <improper-list-exception> + (improper-list-exception idx cdr) + improper-list-exception? + (idx improper-list-exception:idx) + (cdr improper-list-exception:cdr)))) diff --git a/mcgoron.iterator.list.scm b/mcgoron.iterator.list.scm new file mode 100644 index 0000000..3638614 --- /dev/null +++ b/mcgoron.iterator.list.scm @@ -0,0 +1,87 @@ +#| Copyright 2024 Peter McGoron + | + | Licensed under the Apache License, Version 2.0 (the "License"); + | you may not use this file except in compliance with the License. + | You may obtain a copy of the License at + | + | http://www.apache.org/licenses/LICENSE-2.0 + | + | Unless required by applicable law or agreed to in writing, software + | distributed under the License is distributed on an "AS IS" BASIS, + | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + | See the License for the specific language governing permissions and + | limitations under the License. + |------------------------------------------------------------------------- + | This is a list iterator that allows for mutation of the list. + | + | The list iterator is made up of + | * the `signifier`: the head of the list. + | * the `previous` values, which is a list of all cons cells prior to the + | current cons cell, in reverse. + | * the index, which is the index of the current element in the list. This + | is updated internally but not used internally, so the root index does + | not have to be 0. + | * the `next` list, which is either empty or has as it's car the current + | item. + |# + +(define (make-list-iterator signifier previous idx rest) + (when (not (or (pair? rest) (null? rest))) + (raise (improper-list-exception idx rest))) + (make-iterator + (lambda () (null? previous)) + (lambda () (null? rest)) + (lambda (num) + (cond + ((not (integer?)) + (raise (non-integer-movement-exception spaces))) + ((negative? num) + (let loop ((cntr (- num)) + (previous previous) + (rest rest)) + (cond + ((= num 0) (make-list-iterator signifier + previous + (+ total num) + rest)) + ((null? previous) #f) + (else (loop (- cntr 1) + (cdr previous) + (car previous)))))) + (else + (let loop ((cntr num) + (previous previous) + (rest rest)) + (cond + ((= num 0) (make-list-iterator signifier + previous + (+ total num) + rest)) + ((null? rest) #f) + (else (loop (- 1 num) + (cons rest previous) + (cdr rest)))))))) + (lambda () + (if (null? rest) + (error "cannot ref end of list" previous rest) + (car rest))) + (lambda (predicate? other-iterators) + (let ((cmp (make-default-comparator))) + (iteratively-apply-predicate + (lambda (x y) + (predicate? cmp (get-private x) (get-private y))) + idx + other-iterators))) + idx)) + +(define (list-iterator-start rest) + (make-list-iterator rest '() 0 rest)) + +(define (list-iterator-to-end itr) + (if (iterator-end? itr) + itr + (list-iterator-to-end (iterator-advance itr 1)))) + +(define (list-iterator-end lst) + (list-iterator-to-end (list-iterator-start lst))) + diff --git a/mcgoron.iterator.list.sld b/mcgoron.iterator.list.sld new file mode 100644 index 0000000..e3e5da8 --- /dev/null +++ b/mcgoron.iterator.list.sld @@ -0,0 +1,22 @@ +#| Copyright 2024 Peter McGoron + | + | Licensed under the Apache License, Version 2.0 (the "License"); + | you may not use this file except in compliance with the License. + | You may obtain a copy of the License at + | + | http://www.apache.org/licenses/LICENSE-2.0 + | + | Unless required by applicable law or agreed to in writing, software + | distributed under the License is distributed on an "AS IS" BASIS, + | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + | See the License for the specific language governing permissions and + | limitations under the License. + |# + +(define-library (mcgoron iterator list) + (import (scheme base) (srfi 128) + (mcgoron iterator base) (mcgoron iterator exceptions)) + (export list-iterator-start list-iterator-end + make-list-iterator) + (include "mcgoron.iterator.list.scm")) + diff --git a/tests/list.scm b/tests/list.scm new file mode 100644 index 0000000..02a0c52 --- /dev/null +++ b/tests/list.scm @@ -0,0 +1,32 @@ +#| Copyright 2024 Peter McGoron + | + | Licensed under the Apache License, Version 2.0 (the "License"); + | you may not use this file except in compliance with the License. + | You may obtain a copy of the License at + | + | http://www.apache.org/licenses/LICENSE-2.0 + | + | Unless required by applicable law or agreed to in writing, software + | distributed under the License is distributed on an "AS IS" BASIS, + | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + | See the License for the specific language governing permissions and + | limitations under the License. + |# +(import (mcgoron iterator list)) + +(let ((itr (list-iterator-start '()))) + (test-begin "empty list") + (test-assert "iterator-at-start?" (iterator-at-start? itr)) + (test-assert "iterator-at-end?" (iterator-at-end? itr)) + (test-assert "iterator-advance 1" (not (iterator-advance itr 1))) + (test-assert "iterator-advance -1" (not (iterator-advance itr -1))) + (test "iterator->index" 0 (iterator->index itr)) + (test-assert "iterator=?" (iterator=? itr (list-iterator-end '()))) + (test-error "iterator-ref" (iterator-ref itr)) + (test-end "empty list")) + +(let* ((lst '(1 2)) + (itr (list-iterator-start lst))) + () + ) + diff --git a/tests/run.scm b/tests/run.scm index 6d7abfe..f62c232 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -19,40 +19,9 @@ ;;; TODO: Make a custom SRFI-64 test runner that emulates CHICKEN test. -(import (mcgoron iterator string) (mcgoron iterator base)) +(import (mcgoron iterator base)) -(let* ((str "") - (itr (string-iterator-start str))) - (test-group "empty-string" - (test-assert "iterator-at-start?" (iterator-at-start? itr)) - (test-assert "iterator-at-end?" (iterator-at-end? itr)) - (test-assert "iterator-advance 1" (not (iterator-advance itr 1))) - (test-assert "iterator-advance -1" (not (iterator-advance itr -1))) - (test "iterator->index" 0 (iterator->index itr)) - (test-assert "iterator=?" (iterator=? itr (string-iterator-end str))) - (test-error "iterator-ref" (iterator-ref itr)))) +(include "string.scm") +#;(include "list.scm") -(let* ((str "a") - (itr (string-iterator-start str)) - (itr-from-itr (string-iterator-start itr))) - (test-group "non empty string" - (test-assert "iterator-at-start?" (iterator-at-start? itr)) - (test-assert "iterator-at-end?" (not (iterator-at-end? itr))) - (test-assert (iterator=? itr itr-from-itr)) - (test "iterator-ref 0" #\a (iterator-ref itr)) - (test-assert "iterator-advance start -1" (not (iterator-advance itr -1))) - (let ((next-itr (iterator-advance itr 1))) - (test-assert "iterator? advanced" (iterator? next-itr)) - (test-assert "iterator-at-end? advanced" (iterator-at-end? next-itr)) - (test-assert "iterator=? end advanced" - (iterator=? next-itr (string-iterator-end str))) - (test-assert "iterator=? itr next-itr" - (not (iterator=? itr next-itr))) - (test-assert "iterator<? itr next-itr" - (iterator<? itr next-itr)) - (test-assert "iterator=? itr previous" - (iterator=? itr (iterator-advance next-itr -1))) - (test "iterator->index next-itr" 1 - (iterator->index next-itr)) - (test-error "iterator-ref next-itr" (iterator-ref next-itr))))) (test-exit) diff --git a/tests/string.scm b/tests/string.scm new file mode 100644 index 0000000..bf89662 --- /dev/null +++ b/tests/string.scm @@ -0,0 +1,51 @@ +#| Copyright 2024 Peter McGoron + | + | Licensed under the Apache License, Version 2.0 (the "License"); + | you may not use this file except in compliance with the License. + | You may obtain a copy of the License at + | + | http://www.apache.org/licenses/LICENSE-2.0 + | + | Unless required by applicable law or agreed to in writing, software + | distributed under the License is distributed on an "AS IS" BASIS, + | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + | See the License for the specific language governing permissions and + | limitations under the License. + |# +(import (mcgoron iterator string)) + +(let* ((str "") + (itr (string-iterator-start str))) + (test-group "empty-string" + (test-assert "iterator-at-start?" (iterator-at-start? itr)) + (test-assert "iterator-at-end?" (iterator-at-end? itr)) + (test-assert "iterator-advance 1" (not (iterator-advance itr 1))) + (test-assert "iterator-advance -1" (not (iterator-advance itr -1))) + (test "iterator->index" 0 (iterator->index itr)) + (test-assert "iterator=?" (iterator=? itr (string-iterator-end str))) + (test-error "iterator-ref" (iterator-ref itr)))) + +(let* ((str "a") + (itr (string-iterator-start str)) + (itr-from-itr (string-iterator-start itr))) + (test-group "non empty string" + (test-assert "iterator-at-start?" (iterator-at-start? itr)) + (test-assert "iterator-at-end?" (not (iterator-at-end? itr))) + (test-assert (iterator=? itr itr-from-itr)) + (test "iterator-ref 0" #\a (iterator-ref itr)) + (test-assert "iterator-advance start -1" (not (iterator-advance itr -1))) + (let ((next-itr (iterator-advance itr 1))) + (test-assert "iterator? advanced" (iterator? next-itr)) + (test-assert "iterator-at-end? advanced" (iterator-at-end? next-itr)) + (test-assert "iterator=? end advanced" + (iterator=? next-itr (string-iterator-end str))) + (test-assert "iterator=? itr next-itr" + (not (iterator=? itr next-itr))) + (test-assert "iterator<? itr next-itr" + (iterator<? itr next-itr)) + (test-assert "iterator=? itr previous" + (iterator=? itr (iterator-advance next-itr -1))) + (test "iterator->index next-itr" 1 + (iterator->index next-itr)) + (test-error "iterator-ref next-itr" (iterator-ref next-itr))))) + |
