mes.c: less_p, greater_p, is_p: take multiple arguments.

This commit is contained in:
Jan Nieuwenhuizen 2016-07-24 15:26:49 +02:00
parent 675bc3dead
commit 87c52609ff
3 changed files with 56 additions and 26 deletions

View file

@ -1,10 +0,0 @@
(display (< 1 2 3))
(newline)
(display (<= 1 2 2))
(newline)
(display (= 1 1 1))
(newline)
(display (>= 3 2 1))
(newline)
(display (>= 2 2 1))
(newline)

52
mes.c
View file

@ -28,6 +28,7 @@
#define _GNU_SOURCE #define _GNU_SOURCE
#include <assert.h> #include <assert.h>
#include <ctype.h> #include <ctype.h>
#include <limits.h>
#include <stdio.h> #include <stdio.h>
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
@ -1076,19 +1077,46 @@ readenv (scm *a)
} }
scm * scm *
greater_p (scm *a, scm *b) greater_p (scm *x/*...*/)
{ {
assert (a->type == NUMBER); int n = INT_MAX;
assert (b->type == NUMBER); while (x != &scm_nil)
return a->value > b->value ? &scm_t : &scm_f; {
assert (x->car->type == NUMBER);
if (x->car->value >= n) return &scm_f;
n = x->car->value;
x = cdr (x);
}
return &scm_t;
} }
scm * scm *
less_p (scm *a, scm *b) less_p (scm *x/*...*/)
{ {
assert (a->type == NUMBER); int n = INT_MIN;
assert (b->type == NUMBER); while (x != &scm_nil)
return a->value < b->value ? &scm_t : &scm_f; {
assert (x->car->type == NUMBER);
if (x->car->value <= n) return &scm_f;
n = x->car->value;
x = cdr (x);
}
return &scm_t;
}
scm *
is_p (scm *x/*...*/)
{
if (x == &scm_nil) return &scm_t;
assert (x->car->type == NUMBER);
int n = x->car->value;
x = cdr (x);
while (x != &scm_nil)
{
if (x->car->value != n) return &scm_f;
x = cdr (x);
}
return &scm_t;
} }
scm * scm *
@ -1153,14 +1181,6 @@ multiply (scm *x/*...*/)
return make_number (n); return make_number (n);
} }
scm *
is_p (scm *a, scm *b)
{
assert (a->type == NUMBER);
assert (b->type == NUMBER);
return a->value == b->value ? &scm_t : &scm_f;
}
scm *add_environment (scm *a, char *name, scm *x); scm *add_environment (scm *a, char *name, scm *x);
scm * scm *

View file

@ -251,6 +251,26 @@
(pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1))) (pass-if "apply identity 2" (sequal? (apply identity '((0 1))) '(0 1)))
(pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4))) (pass-if "apply append" (sequal? (apply append '((1 2) (3 4))) '(1 2 3 4)))
(pass-if "=" (seq? (=) #t))
(pass-if "= 1" (seq? (= 0) #t))
(pass-if "= 2" (seq? (= 0 0) #t))
(pass-if "= 3" (seq? (= 0 0) #t))
(pass-if "= 4" (seq? (= 0 1 0) #f))
(pass-if "<" (seq? (<) #t))
(pass-if "< 1" (seq? (< 0) #t))
(pass-if "< 2" (seq? (< 0 1) #t))
(pass-if "< 3" (seq? (< 1 0) #f))
(pass-if "< 4" (seq? (< 0 1 2) #t))
(pass-if "< 5" (seq? (< 0 2 1) #f))
(pass-if ">" (seq? (>) #t))
(pass-if "> 1" (seq? (> 0) #t))
(pass-if "> 2" (seq? (> 1 0) #t))
(pass-if "> 3" (seq? (> 0 1) #f))
(pass-if "> 4" (seq? (> 2 1 0) #t))
(pass-if "> 5" (seq? (> 1 2 0) #f))
(newline) (newline)
(display "passed: ") (display (car (result))) (newline) (display "passed: ") (display (car (result))) (newline)
(display "failed: ") (display (cadr (result))) (newline) (display "failed: ") (display (cadr (result))) (newline)