mes.c: less_p, greater_p, is_p: take multiple arguments.
This commit is contained in:
parent
675bc3dead
commit
87c52609ff
|
@ -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
52
mes.c
|
@ -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 *
|
||||||
|
|
20
test.mes
20
test.mes
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue