Skip to content

Sort fixes #28

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.

Sign up for GitHub

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

Merged
merged 3 commits into from
Dec 5, 2021
Merged

Sort fixes #28

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
a65f813
add test for subvector bug
justinmeiners Dec 5, 2021
38aea50
fix char comparison and add it to sort test
justinmeiners Dec 5, 2021
5fb8c3e
add other string comparison variants
justinmeiners Dec 5, 2021
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
44 changes: 28 additions & 16 deletions lisp.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3342,24 +3342,20 @@ static Lisp sch_divide(Lisp args, LispError* e, LispContext ctx)

static Lisp sch_less(Lisp args, LispError* e, LispContext ctx)
{
Lisp accum = lisp_car(args);
Lisp a = lisp_car(args);
args = lisp_cdr(args);
int result = 0;
Lisp b = lisp_car(args);

if (lisp_type(accum) == LISP_INT)
{
result = lisp_int(accum) < lisp_int(lisp_car(args));
}
else if (lisp_type(accum) == LISP_REAL)
{
result = lisp_real(accum) < lisp_real(lisp_car(args));
}
else
switch (lisp_type(a))
{
*e = LISP_ERROR_BAD_ARG;
return lisp_make_null();
case LISP_INT:
return lisp_make_bool(lisp_int(a) < lisp_int(b));
case LISP_REAL:
return lisp_make_bool(lisp_real(a) < lisp_real(b));
default:
*e = LISP_ERROR_BAD_ARG;
return lisp_make_null();
}
return lisp_make_bool(result);
}

static Lisp sch_to_exact(Lisp args, LispError* e, LispContext ctx)
Expand Down Expand Up @@ -3612,6 +3608,14 @@ static Lisp sch_list_to_string(Lisp args, LispError* e, LispContext ctx)
return result;
}

static Lisp sch_char_less(Lisp args, LispError* e, LispContext ctx)
{
Lisp a = lisp_car(args);
args = lisp_cdr(args);
Lisp b = lisp_car(args);
return lisp_make_bool(lisp_char(a) < lisp_char(b));
}

static Lisp sch_is_char(Lisp args, LispError* e, LispContext ctx)
{
return lisp_make_bool(lisp_type(lisp_car(args)) == LISP_CHAR);
Expand Down Expand Up @@ -4158,7 +4162,7 @@ static const LispFuncDef lib_cfunc_defs[] = {
// Characters https://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Characters.html#Characters
{ "CHAR?", sch_is_char },
{ "CHAR=?", sch_equals },
{ "CHAR<?", sch_less },
{ "CHAR<?", sch_char_less },
{ "CHAR-UPCASE", sch_char_upcase },
{ "CHAR-DOWNCASE", sch_char_downcase },
{ "CHAR-WHITESPACE?", sch_char_is_white },
Expand Down Expand Up @@ -4400,7 +4404,15 @@ static const char* lib_code1 = " \
\
(define (>= a b) (not (< a b))) \
(define (> a b) (< b a)) \
(define (<= a b) (not (> a b))) \
(define (<= a b) (not (< b a))) \
\
(define (char>=? a b) (not (char<? a b))) \
(define (char>? a b) (char<? b a)) \
(define (char<=? a b) (not (char<? b a))) \
\
(define (string>=? a b) (not (string<? a b))) \
(define (string>? a b) (string<? b a)) \
(define (string<=? a b) (not (string<? b a))) \
\
(define (last-pair x) \
(if (pair? (cdr x)) \
Expand Down
12 changes: 11 additions & 1 deletion tests/bugs.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,11 @@

; add a test for every bug that is incountered
; to avoid recreating it in the future

(define-macro =>
(lambda (test expected)
`(assert (equal? ,test (quote ,expected))) ))

; test basic vector creation and operations
(define v #(1 2 3 4 5 6 7 8 9 10))

Expand All @@ -21,8 +26,8 @@
(define big-v #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200))

(display (vector-length big-v))
(assert (= (vector-length big-v) 200))

(=> (vector-length big-v) 200)

; procedures with no arguments don't expand properly

Expand All @@ -48,3 +53,8 @@
(* 5 11)))



(=> (subvector #(1 2 3 4) 1 4) #(2 3 4))
(=> (subvector #(1 2 3 4) 0 2) #(1 2))
(=> (subvector #(A 1 A 1 A 1 A 1) 1 3) #(1 A))

38 changes: 21 additions & 17 deletions tests/vector_sort.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,22 +5,26 @@
(vec-sorted? (vector-tail v 1) op))))

; First make sure our sorted checker works
(assert (vec-sorted? (list->vector '(1 2 2 4 5 6)) <=))
(assert (vec-sorted? (list->vector '(1)) <=))
(assert (vec-sorted? (list->vector '(1 2)) <=))
(assert (vec-sorted? (list->vector '(7 6 5 4 3 2 1)) >=))
(assert (not (vec-sorted? (list->vector '(2 1)) <=)))
(assert (not (vec-sorted? (list->vector '(1 2 3 4 4 3)) <=)))
(assert (not (vec-sorted? (list->vector '(1 2 3 2 4 5)) <=)))
(assert (vec-sorted? #(1 2 2 4 5 6) <=))
(assert (vec-sorted? #(1) <=))
(assert (vec-sorted? #(1 2) <=))
(assert (vec-sorted? #(7 6 5 4 3 2 1) >=))
(assert (not (vec-sorted? #(2 1) <=)))
(assert (not (vec-sorted? #(1 2 3 4 4 3) <=)))
(assert (not (vec-sorted? #(1 2 3 2 4 5) <=)))

; Now test the sort function
(assert (vec-sorted? (sort! (list->vector '(1)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(2 1)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(1 2 3)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(3 8 1 7 2 9 4 5)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(1 2 3 4 5 6 7 8)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(3 8 1 7 2 9 4 5)) >) >=))
(assert (vec-sorted? (sort! (list->vector '(1 2 3 4 5 6 7 8)) >) >=))
(assert (vec-sorted? (sort! (list->vector '(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43)) >) >=))
(assert (vec-sorted? (sort! (list->vector '(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43)) <) <=))
(assert (vec-sorted? (sort! (list->vector '(3 8 1 7 2 9 4 5)) <=) <=))
(assert (vec-sorted? (sort! #(1) <) <=))
(assert (vec-sorted? (sort! #(2 1) <) <=))
(assert (vec-sorted? (sort! #(1 2 3) <) <=))
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) <) <=))
(assert (vec-sorted? (sort! #(1 2 3 4 5 6 7 8) <) <=))
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) >) >=))
(assert (vec-sorted? (sort! #(1 2 3 4 5 6 7 8) >) >=))
(assert (vec-sorted? (sort! #(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43) >) >=))
(assert (vec-sorted? (sort! #(92 59 30 57 74 78 43 33 77 10 78 83 76 49 42 94 82 70 15 11 90 86 44 70 39 64 69 30 59 95 15 79 13 54 98 82 42 96 79 17 56 93 20 1 84 72 75 19 74 43) <) <=))
(assert (vec-sorted? (sort! #(3 8 1 7 2 9 4 5) <=) <=))

; Try other data types
(assert (vec-sorted? (sort! #(#\C #\B #\A #\D) char<?) char<=?))