diff options
| author | Mistivia <i@mistivia.com> | 2025-06-22 16:17:20 +0800 |
|---|---|---|
| committer | Mistivia <i@mistivia.com> | 2025-06-22 16:17:20 +0800 |
| commit | 5c0eddbed7f838daac17e0b9d9c2a23f17da4660 (patch) | |
| tree | 583026ff5f0614d6e6672e6bbb7879c24c701236 /src | |
| parent | b19a0b2ea246be5610812bf7dd4088e0c4a70952 (diff) | |
min, max
Diffstat (limited to 'src')
| -rw-r--r-- | src/builtins.c | 82 | ||||
| -rw-r--r-- | src/builtins.h | 2 | ||||
| -rw-r--r-- | src/interp.c | 2 | ||||
| -rw-r--r-- | src/interp.h | 1 | ||||
| -rw-r--r-- | src/prelude.c | 2 | ||||
| -rw-r--r-- | src/prelude.lisp | 2 |
6 files changed, 90 insertions, 1 deletions
diff --git a/src/builtins.c b/src/builtins.c index 198f80d..fbf5855 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -2,6 +2,88 @@ #include "interp.h" #include "sexp.h" #include <algds/str.h> +#include <stdint.h> +#include <float.h> + +SExpRef builtin_min(Interp *interp, SExpRef args) { + if (LENGTH(args) < 1) return new_error(interp, "min: wrong arg number.\n"); + bool hasReal = false; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kRealSExp) hasReal = true; + if (VALTYPE(x) != kRealSExp && VALTYPE(x) != kIntegerSExp) { + return new_error(interp, "min: wrong type.\n"); + } + } + if (hasReal) { + double min = DBL_MAX; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kIntegerSExp) { + if (REF(x)->integer < min) { + min = REF(x)->integer; + } + } + if (VALTYPE(x) == kRealSExp) { + if (REF(x)->real < min) { + min = REF(x)->real; + } + } + } + return new_integer(interp, min); + } else { + int64_t min = INT64_MAX; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kIntegerSExp) { + if (REF(x)->integer < min) { + min = REF(x)->integer; + } + } + } + return new_integer(interp, min); + } +} + +SExpRef builtin_max(Interp *interp, SExpRef args) { + if (LENGTH(args) < 1) return new_error(interp, "min: wrong arg number.\n"); + bool hasReal = false; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kRealSExp) hasReal = true; + if (VALTYPE(x) != kRealSExp && VALTYPE(x) != kIntegerSExp) { + return new_error(interp, "min: wrong type.\n"); + } + } + if (hasReal) { + double max = -DBL_MAX; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kIntegerSExp) { + if (REF(x)->integer > max) { + max = REF(x)->integer; + } + } + if (VALTYPE(x) == kRealSExp) { + if (REF(x)->real > max) { + max = REF(x)->real; + } + } + } + return new_real(interp, max); + } else { + int64_t max = INT64_MIN; + FOREACH(iter, args) { + SExpRef x = CAR(iter); + if (VALTYPE(x) == kIntegerSExp) { + if (REF(x)->integer > max) { + max = REF(x)->integer; + } + } + } + return new_integer(interp, max); + } +} static bool equal_impl(Interp *interp, SExpRef x, SExpRef y) { if (VALTYPE(x) != VALTYPE(y)) return false; diff --git a/src/builtins.h b/src/builtins.h index b5a0979..abcd7a0 100644 --- a/src/builtins.h +++ b/src/builtins.h @@ -3,6 +3,8 @@ #include "interp.h" +SExpRef builtin_min(Interp *interp, SExpRef sexp); +SExpRef builtin_max(Interp *interp, SExpRef sexp); SExpRef builtin_equal(Interp *interp, SExpRef sexp); SExpRef builtin_eq(Interp *interp, SExpRef sexp); SExpRef builtin_format(Interp *interp, SExpRef sexp); diff --git a/src/interp.c b/src/interp.c index d7e06ed..8813d37 100644 --- a/src/interp.c +++ b/src/interp.c @@ -86,6 +86,8 @@ void Interp_init(Interp *self) { Interp_add_primitive(self, "assert-error", primitive_assert_error); Interp_add_primitive(self, "load", primitive_load); + Interp_add_userfunc(self, "min", builtin_min); + Interp_add_userfunc(self, "max", builtin_max); Interp_add_userfunc(self, "eq", builtin_eq); Interp_add_userfunc(self, "equal", builtin_equal); Interp_add_userfunc(self, "format", builtin_format); diff --git a/src/interp.h b/src/interp.h index 74bb0dd..36fd1e0 100644 --- a/src/interp.h +++ b/src/interp.h @@ -53,6 +53,7 @@ SExpRef Interp_load_file(Interp *interp, const char *filename); #define EVAL(_x) (lisp_eval(interp, (_x), false)) #define EVALTAIL(_x) (lisp_eval(interp, (_x), true)) #define TRUEP(_x) (lisp_truep(interp, (_x))) +#define FOREACH(_x, _lst) for (SExpRef _x = _lst; !NILP(_x); _x = CDR(_x)) // control flow #define CTL_FL(_x) \ (REF((_x))->type == kErrSignal \ diff --git a/src/prelude.c b/src/prelude.c index 1389f28..3d1a971 100644 --- a/src/prelude.c +++ b/src/prelude.c @@ -1,6 +1,6 @@ #include "prelude.h" -const char *bamboo_lisp_prelude = "(defvar nil \'())\n\n(defvar pi 3.1415926)\n\n(defmacro incq (i)\n `(setq ,i (+ ,i 1)))\n\n(defmacro decq (i)\n `(setq ,i (- ,i 1)))\n\n(defun zerop (x) (= x 0))\n\n(defmacro when (pred . body)\n `(if ,pred\n (progn ,@body)\n nil))\n\n(defmacro unless (pred . body)\n `(if ,pred\n nil\n (progn ,@body)))\n"; +const char *bamboo_lisp_prelude = "(defvar nil \'())\n\n(defvar pi 3.1415926)\n\n(defmacro incq (i)\n `(setq ,i (+ ,i 1)))\n\n(defmacro decq (i)\n `(setq ,i (- ,i 1)))\n\n(defun zerop (x) (= x 0))\n(defun plusp (x) (> x 0))\n(defun minusp (x) (< x 0))\n\n(defmacro when (pred . body)\n `(if ,pred\n (progn ,@body)\n nil))\n\n(defmacro unless (pred . body)\n `(if ,pred\n nil\n (progn ,@body)))\n"; diff --git a/src/prelude.lisp b/src/prelude.lisp index 7b49977..df85a9b 100644 --- a/src/prelude.lisp +++ b/src/prelude.lisp @@ -9,6 +9,8 @@ `(setq ,i (- ,i 1))) (defun zerop (x) (= x 0)) +(defun plusp (x) (> x 0)) +(defun minusp (x) (< x 0)) (defmacro when (pred . body) `(if ,pred |
