-
Notifications
You must be signed in to change notification settings - Fork 2
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Added sequence tests #27
Merged
Merged
Changes from 3 commits
Commits
Show all changes
11 commits
Select commit
Hold shift + click to select a range
52a2a9e
Added sequence tests
ericlesaquiles d2991d3
Return to percentage sign
ericlesaquiles 1a55dc0
Shadows peek-char to accept peek-type
ericlesaquiles decf007
Make a few functions work
ericlesaquiles e2d3391
Restored commented out bitvector-related
ericlesaquiles fc39354
Fix mismatch
Affonso-Gui 96956a8
Fix substitute
Affonso-Gui 379a45f
Move character aux
Affonso-Gui eca69d2
Avoid crashes on search-aux when testing from apt
Affonso-Gui dc5f5f1
Merge pull request #1 from Affonso-Gui/test-seqs
ericlesaquiles b422050
Merge branch 'gsoc2018' into sequences
Affonso-Gui File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,84 @@ | ||
| ; (in-package "COMMON_LISP") | ||
| ; (export '(char-equal equalp)) | ||
|
|
||
| (defun char-equal (character &rest more-characters) | ||
| "Returns T if all of its arguments are the same character. | ||
| Case is ignored." | ||
| (do ((clist more-characters (cdr clist))) | ||
| ((atom clist) T) | ||
| (unless (= (car clist) character) | ||
| (return nil)))) | ||
|
|
||
|
|
||
| ;;; EQUALP -- public. | ||
| ;; | ||
| (defun equalp (x y) | ||
| "Just like EQUAL, but more liberal in several respects. | ||
| Numbers may be of different types, as long as the values are identical | ||
| after coercion. Characters may differ in alphabetic case. Vectors and | ||
| arrays must have identical dimensions and EQUALP elements, but may differ | ||
| in their type restriction." | ||
| (cond ((eq x y) t) | ||
| ((characterp x) (and (characterp y) (char-equal x y))) | ||
| ((numberp x) (and (numberp y) (= x y))) | ||
| ((consp x) | ||
| (and (consp y) | ||
| (equalp (car x) (car y)) | ||
| (equalp (cdr x) (cdr y)))) | ||
| ((pathnamep x) | ||
| ;; (and (pathnamep y) (pathname= x y))) | ||
| (error "pathname is not yet supported here. Sorry.")) | ||
| ((hash-table-p x) | ||
| (error "hash table is not yet supported here. Sorry.")) | ||
| ;; (and (hash-table-p y) | ||
| ;; (eql (hash-table-count x) (hash-table-count y)) | ||
| ;; (eql (hash-table-test x) (hash-table-test y)) | ||
| ;; (with-hash-table-iterator (next x) | ||
| ;; (loop | ||
| ;; (multiple-value-bind (more x-key x-value) | ||
| ;; (next) | ||
| ;; (cond (more | ||
| ;; (multiple-value-bind (y-value foundp) | ||
| ;; (gethash x-key y) | ||
| ;; (unless (and foundp (equalp x-value y-value)) | ||
| ;; (return nil)))) | ||
| ;; (t | ||
| ;; (return t)))))))) | ||
| ;; ((%instancep x) | ||
| ;; (let* ((layout-x (%instance-layout x)) | ||
| ;; (len (layout-length layout-x))) | ||
| ;; (and (%instancep y) | ||
| ;; (eq layout-x (%instance-layout y)) | ||
| ;; (structure-class-p (layout-class layout-x)) | ||
| ;; (do ((i 1 (1+ i))) | ||
| ;; ((= i len) t) | ||
| ;; (declare (fixnum i)) | ||
| ;; (let ((x-el (%instance-ref x i)) | ||
| ;; (y-el (%instance-ref y i))) | ||
| ;; (unless (or (eq x-el y-el) | ||
| ;; (equalp x-el y-el)) | ||
| ;; (return nil))))))) | ||
| ((vectorp x) | ||
| (let ((length (length x))) | ||
| (and (vectorp y) | ||
| (= length (length y)) | ||
| (dotimes (i length t) | ||
| (let ((x-el (aref x i)) | ||
| (y-el (aref y i))) | ||
| (unless (or (eq x-el y-el) | ||
| (equalp x-el y-el)) | ||
| (return nil))))))) | ||
| ((arrayp x) | ||
| (and (arrayp y) | ||
| (= (array-rank x) (array-rank y)) | ||
| (dotimes (axis (array-rank x) t) | ||
| (unless (= (array-dimension x axis) | ||
| (array-dimension y axis)) | ||
| (return nil))) | ||
| (dotimes (index (array-total-size x) t) | ||
| (let ((x-el (row-major-aref x index)) | ||
| (y-el (row-major-aref y index))) | ||
| (unless (or (eq x-el y-el) | ||
| (equalp x-el y-el)) | ||
| (return nil)))))) | ||
| (t nil))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,133 @@ | ||
| ;; Shadows a few substitute functions | ||
| ;; - substitute should accept a from-end keyword | ||
| ;; - count = nil should default to count = 10^6 (due to hacky reasons) | ||
|
|
||
| (in-package :lisp) | ||
|
|
||
|
|
||
| (defun substitute (newitem olditem seq &key (start 0) | ||
| (end (length seq)) | ||
| (test #'eq) | ||
| (test-not nil) | ||
| (count 1000000) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-substitute newitem olditem (reverse seq) test test-not key nil nil start end count)) | ||
| (system::raw-substitute newitem olditem seq test test-not key nil nil start end count)))) | ||
|
|
||
| (defun substitute-if (newitem pred seq &key (start 0) | ||
| (end (length seq)) | ||
| (count 1000000) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-substitute newitem nil (reverse seq) nil nil key pred nil start end count)) | ||
| (system::raw-substitute newitem nil seq nil nil key pred nil start end count)))) | ||
|
|
||
| (defun substitute-if-not (newitem pred seq &key (start 0) | ||
| (end (length seq)) | ||
| (count 1000000) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-substitute newitem nil (reverse seq) nil nil key nil pred start end count)) | ||
| (system::raw-substitute newitem nil seq nil nil key nil pred start end count)))) | ||
|
|
||
|
|
||
| (defun nsubstitute (newitem olditem seq &key (start 0) | ||
| (end (length seq)) | ||
| (test #'eq) | ||
| (test-not nil) | ||
| (count 1000000) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-nsubstitute newitem olditem (reverse seq) test test-not key nil nil start end count)) | ||
| (system::raw-nsubstitute newitem olditem seq test test-not key nil nil start end count)))) | ||
|
|
||
| (defun nsubstitute-if (newitem pred seq &key (start 0) | ||
| (end (length seq)) | ||
| (nil) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-nsubstitute newitem nil (reverse seq) nil nil key pred nil start end count)) | ||
| (system::raw-nsubstitute newitem nil seq nil nil key pred nil start end count)))) | ||
|
|
||
| (defun nsubstitute-if-not (newitem pred seq &key (start 0) | ||
| (end (length seq)) | ||
| (count 1000000) | ||
| (key #'identity) | ||
| (from-end nil)) | ||
| (let ((count (or (and count (< 0 count) 0) count 1000000))) | ||
| (if from-end | ||
| (reverse (system::raw-nsubstitute newitem nil (reverse seq) nil nil key nil pred start end count)) | ||
| (system::raw-nsubstitute newitem nil seq nil nil key nil pred start end count)))) | ||
|
|
||
| ;; ;; Shadows replace function | ||
| ;; ;; - replace should default nil to entire string | ||
|
|
||
| (defun replace (dest src &key (start1 0) (end1 nil) | ||
| (start2 0) (end2 nil)) | ||
| (let ((end1 (or end1 (length dest))) | ||
| (end2 (or end2 (length src)))) | ||
| (let ((result dest) (count (min (- end1 start1) (- end2 start2)))) | ||
| (cond ((listp dest) | ||
| (setq dest (nthcdr start1 dest)) | ||
| (cond ((listp src) | ||
| (setq src (nthcdr start2 src)) | ||
| (dotimes (c count) | ||
| (setq (dest . car) (pop src)) | ||
| (pop dest))) | ||
| (t | ||
| (dotimes (c count) | ||
| (setq (dest . car) (aref src start2)) | ||
| (inc start2) (pop dest))))) | ||
| ((listp src) ; list --> vector | ||
| (setq src (nthcdr start2 src)) | ||
| (dotimes (c count) | ||
| (aset dest start1 (pop src)) | ||
| (inc start1))) | ||
| (t (system::vector-replace dest src start1 end1 start2 end2))) | ||
| result))) | ||
|
|
||
|
|
||
| ;; Add mismatch function | ||
|
|
||
| (defun mismatch (seq1 seq2 &key (from-end nil) | ||
| (test #'eql) | ||
| (start1 0) | ||
| (start2 0) | ||
| (end1 nil) | ||
| (end2 nil)) | ||
| (let ((end1 (or end1 (length seq1))) | ||
| (end2 (or end2 (length seq2))) | ||
| (seq1 (or (and from-end (reverse seq1)) seq1)) | ||
| (seq2 (or (and from-end (reverse seq2)) seq2))) | ||
| (progn | ||
| (loop | ||
| for index1 from start1 to (- end1 1) | ||
| for index2 from start2 to (- end2 1) | ||
| do | ||
| (when (not (funcall test (elt seq1 index1) (elt seq2 index2))) | ||
| (return-from mismatch index1)) | ||
| ) | ||
| (if (> (- end1 start1) (- end2 start2)) | ||
| end1 | ||
| nil)))) | ||
|
|
||
|
|
||
| ;; Shadows peek-char to accept peek-type, and ignore it for now | ||
| (defun peek-char (&optional (peek-type nil) (stream *standard-input*) | ||
| (eof-errorp t) eof-value recursive-p) | ||
| (if (streamp peek-type) | ||
| (peek-char peek-type stream eof-errorp) | ||
| (peek-char stream eof-errorp eof-value))) | ||
|
|
||
| (export 'mismatch) | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
It shouldn't work.. I've accidentally pushed the wrong update, but will push the correct one as soon as I can (I'm without my computer right now)..