aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGES.md1
-rw-r--r--Makefile2
-rw-r--r--src/ast.c3
-rw-r--r--src/ast.h5
-rw-r--r--src/compile.c19
-rw-r--r--src/environment.c51
-rw-r--r--src/parse.c38
-rw-r--r--src/stdlib/datatypes.h4
-rw-r--r--src/stdlib/decimals.c264
-rw-r--r--src/stdlib/decimals.h63
-rw-r--r--src/stdlib/stdlib.c41
-rw-r--r--src/stdlib/tomo.h1
-rw-r--r--src/tomo.c2
-rw-r--r--src/typecheck.c7
-rw-r--r--src/types.c13
-rw-r--r--src/types.h3
-rw-r--r--test/decimals.tm49
17 files changed, 537 insertions, 29 deletions
diff --git a/CHANGES.md b/CHANGES.md
index 40749904..42b02cad 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,7 @@
## v0.3
+- Added `Dec` type for decimal floating point numbers (literal `$12.34`)
- Added a versioning system based on `CHANGES.md` files and `modules.ini`
configuration for module aliases.
- When attempting to run a program with a module that is not installed, Tomo
diff --git a/Makefile b/Makefile
index c00d9bf4..a80525e5 100644
--- a/Makefile
+++ b/Makefile
@@ -73,7 +73,7 @@ CFLAGS=$(CCONFIG) $(INCLUDE_DIRS) $(EXTRA) $(CWARN) $(G) $(O) $(OSFLAGS) $(LTO)
-DTOMO_PREFIX='"$(PREFIX)"' -DSUDO='"$(SUDO)"' -DDEFAULT_C_COMPILER='"$(DEFAULT_C_COMPILER)"' \
-DTOMO_VERSION='"$(TOMO_VERSION)"' -DGIT_VERSION='"$(GIT_VERSION)"'
CFLAGS_PLACEHOLDER="$$(printf '\033[2m<flags...>\033[m\n')"
-LDLIBS=-lgc -lcord -lm -lunistring -lgmp -ldl
+LDLIBS=-lgc -lcord -lm -lunistring -lgmp -ldl -lmpdec
LIBTOMO_FLAGS=-shared
DEFINE_AS_OWNER=as_owner() { \
diff --git a/src/ast.c b/src/ast.c
index 5d8b2021..192aba0b 100644
--- a/src/ast.c
+++ b/src/ast.c
@@ -147,6 +147,7 @@ CORD ast_to_sexp(ast_t *ast)
T(Bool, "(Bool ", data.b ? "yes" : "no", ")")
T(Var, "(Var ", CORD_quoted(data.name), ")")
T(Int, "(Int ", CORD_quoted(ast_source(ast)), ")")
+ T(Dec, "(Dec ", CORD_quoted(ast_source(ast)), ")")
T(Num, "(Num ", CORD_quoted(ast_source(ast)), ")")
T(TextLiteral, CORD_quoted(data.cord))
T(TextJoin, "(Text", data.lang ? CORD_all(" :lang ", CORD_quoted(data.lang)) : CORD_EMPTY, ast_list_to_sexp(data.children), ")")
@@ -230,7 +231,7 @@ const char *ast_source(ast_t *ast)
PUREFUNC bool is_idempotent(ast_t *ast)
{
switch (ast->tag) {
- case Int: case Bool: case Num: case Var: case None: case TextLiteral: return true;
+ case Int: case Bool: case Dec: case Num: case Var: case None: case TextLiteral: return true;
case Index: {
DeclareMatch(index, ast, Index);
return is_idempotent(index->indexed) && index->index != NULL && is_idempotent(index->index);
diff --git a/src/ast.h b/src/ast.h
index 486b5818..a1137bf3 100644
--- a/src/ast.h
+++ b/src/ast.h
@@ -125,7 +125,7 @@ struct type_ast_s {
typedef enum {
Unknown = 0,
None, Bool, Var,
- Int, Num,
+ Int, Dec, Num,
TextLiteral, TextJoin,
Path,
Declare, Assign,
@@ -176,6 +176,9 @@ struct ast_s {
double n;
} Num;
struct {
+ const char *str;
+ } Dec;
+ struct {
CORD cord;
} TextLiteral;
struct {
diff --git a/src/compile.c b/src/compile.c
index 8671592e..2b73c95f 100644
--- a/src/compile.c
+++ b/src/compile.c
@@ -802,6 +802,7 @@ CORD compile_type(type_t *t)
case ByteType: return "Byte_t";
case CStringType: return "const char*";
case BigIntType: return "Int_t";
+ case DecType: return "Dec_t";
case IntType: return CORD_all("Int", String(Match(t, IntType)->bits), "_t");
case NumType: return Match(t, NumType)->bits == TYPE_NBITS64 ? "Num_t" : CORD_all("Num", String(Match(t, NumType)->bits), "_t");
case TextType: {
@@ -844,7 +845,7 @@ CORD compile_type(type_t *t)
return compile_type(nonnull);
case TextType:
return Match(nonnull, TextType)->lang ? compile_type(nonnull) : "OptionalText_t";
- case IntType: case BigIntType: case NumType: case BoolType: case ByteType:
+ case IntType: case BigIntType: case DecType: case NumType: case BoolType: case ByteType:
case ListType: case TableType: case SetType:
return CORD_all("Optional", compile_type(nonnull));
case StructType: {
@@ -2039,7 +2040,7 @@ CORD expr_as_text(CORD expr, type_t *t, CORD color)
// NOTE: this cannot use stack(), since bools may actually be bit fields:
return CORD_all("Bool$as_text((Bool_t[1]){", expr, "}, ", color, ", &Bool$info)");
case CStringType: return CORD_all("CString$as_text(stack(", expr, "), ", color, ", &CString$info)");
- case BigIntType: case IntType: case ByteType: case NumType: {
+ case BigIntType: case DecType: case IntType: case ByteType: case NumType: {
CORD name = type_to_cord(t);
return CORD_all(name, "$as_text(stack(", expr, "), ", color, ", &", name, "$info)");
}
@@ -2374,6 +2375,9 @@ CORD compile_int_to_type(env_t *env, ast_t *ast, type_t *target)
if (target->tag == BigIntType)
return compile(env, ast);
+ if (target->tag == DecType)
+ return compile(env, WrapAST(ast, Dec, .str=Match(ast, Int)->str));
+
if (target->tag == OptionalType && Match(target, OptionalType)->type)
return compile_int_to_type(env, ast, Match(target, OptionalType)->type);
@@ -2589,6 +2593,7 @@ CORD compile_none(type_t *t)
switch (t->tag) {
case BigIntType: return "NONE_INT";
+ case DecType: return "NONE_DEC";
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS8: return "NONE_INT8";
@@ -2632,6 +2637,7 @@ CORD compile_empty(type_t *t)
switch (t->tag) {
case BigIntType: return "I(0)";
+ case DecType: return "Dec$from_int(0)";
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS8: return "I8(0)";
@@ -2761,6 +2767,9 @@ CORD compile(env_t *env, ast_t *ast)
case Num: {
return String(hex_double(Match(ast, Num)->n));
}
+ case Dec: {
+ return CORD_all("Dec$from_str(\"", Match(ast, Dec)->str, "\")");
+ }
case Not: {
ast_t *value = Match(ast, Not)->value;
type_t *t = get_type(env, value);
@@ -2852,6 +2861,8 @@ CORD compile(env_t *env, ast_t *ast)
switch (operand_t->tag) {
case BigIntType:
return CORD_all(ast->tag == Equals ? CORD_EMPTY : "!", "Int$equal_value(", lhs, ", ", rhs, ")");
+ case DecType:
+ return CORD_all(ast->tag == Equals ? CORD_EMPTY : "!", "Dec$equal_value(", lhs, ", ", rhs, ")");
case BoolType: case ByteType: case IntType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, ast->tag == Equals ? " == " : " != ", rhs, ")");
default:
@@ -2888,6 +2899,8 @@ CORD compile(env_t *env, ast_t *ast)
switch (operand_t->tag) {
case BigIntType:
return CORD_all("(Int$compare_value(", lhs, ", ", rhs, ") ", op, " 0)");
+ case DecType:
+ return CORD_all("(Dec$compare_value(", lhs, ", ", rhs, ") ", op, " 0)");
case BoolType: case ByteType: case IntType: case NumType: case PointerType: case FunctionType:
return CORD_all("(", lhs, " ", op, " ", rhs, ")");
default:
@@ -3976,7 +3989,7 @@ CORD compile_type_info(type_t *t)
else if (t == PATH_TYPE_TYPE) return "&PathType$info";
switch (t->tag) {
- case BoolType: case ByteType: case IntType: case BigIntType: case NumType: case CStringType:
+ case BoolType: case ByteType: case IntType: case BigIntType: case DecType: case NumType: case CStringType:
return CORD_all("&", type_to_cord(t), "$info");
case TextType: {
DeclareMatch(text, t, TextType);
diff --git a/src/environment.c b/src/environment.c
index db17da94..6446ed89 100644
--- a/src/environment.c
+++ b/src/environment.c
@@ -67,6 +67,7 @@ env_t *global_env(bool source_mapping)
TEXT_TYPE = bind_type(env, "Text", Type(TextType, .lang="Text", .env=namespace_env(env, "Text")));
(void)bind_type(env, "Int", Type(BigIntType));
(void)bind_type(env, "Int32", Type(IntType, .bits=TYPE_IBITS32));
+ (void)bind_type(env, "Dec", Type(DecType));
(void)bind_type(env, "Memory", Type(MemoryType));
PATH_TYPE_TYPE = declare_type(env, "enum PathType(Relative, Absolute, Home)");
PATH_TYPE = declare_type(env, "struct Path(type:PathType, components:[Text])");
@@ -242,6 +243,17 @@ env_t *global_env(bool source_mapping)
F_opt(tan), F(tanh), F_opt(tgamma), F(trunc), F_opt(y0), F_opt(y1),
F2(atan2), F2(copysign), F2(fdim), F2(hypot), F2(nextafter),
)},
+ {"Dec", Type(DecType), "Dec_t", "Dec$info", TypedList(ns_entry_t,
+ {"divided_by", "Dec$divided_by", "func(x,y:Dec -> Dec)"},
+ {"minus", "Dec$minus", "func(x,y:Dec -> Dec)"},
+ {"modulo", "Dec$modulo", "func(x,y:Dec -> Dec)"},
+ {"modulo1", "Dec$modulo1", "func(x,y:Dec -> Dec)"},
+ {"negative", "Dec$negative", "func(x:Dec -> Dec)"},
+ {"plus", "Dec$plus", "func(x,y:Dec -> Dec)"},
+ {"power", "Dec$power", "func(base,exponent:Dec -> Dec)"},
+ {"round", "Dec$round", "func(d:Dec, digits:Int=0 -> Dec)"},
+ {"times", "Dec$times", "func(x,y:Dec -> Dec)"},
+ )},
#undef F2
#undef F_opt
#undef F
@@ -426,14 +438,16 @@ env_t *global_env(bool source_mapping)
{"Bool$from_int16", "func(i:Int16 -> Bool)"},
{"Bool$from_int32", "func(i:Int32 -> Bool)"},
{"Bool$from_int64", "func(i:Int64 -> Bool)"},
- {"Bool$from_int", "func(i:Int -> Bool)"});
+ {"Bool$from_int", "func(i:Int -> Bool)"},
+ {"Dec$as_bool", "func(d:Dec -> Bool)"});
ADD_CONSTRUCTORS("Byte",
{"Byte$from_bool", "func(b:Bool -> Byte)"},
{"Byte$from_int8", "func(i:Int8 -> Byte)"},
{"Byte$from_int16", "func(i:Int16, truncate=no -> Byte)"},
{"Byte$from_int32", "func(i:Int32, truncate=no -> Byte)"},
{"Byte$from_int64", "func(i:Int64, truncate=no -> Byte)"},
- {"Byte$from_int", "func(i:Int, truncate=no -> Byte)"});
+ {"Byte$from_int", "func(i:Int, truncate=no -> Byte)"},
+ {"Dec$as_byte", "func(d:Dec, truncate=no -> Byte)"});
ADD_CONSTRUCTORS("Int",
{"Int$from_bool", "func(b:Bool -> Int)"},
{"Int$from_byte", "func(b:Byte -> Int)"},
@@ -442,7 +456,8 @@ env_t *global_env(bool source_mapping)
{"Int$from_int32", "func(i:Int32 -> Int)"},
{"Int$from_int64", "func(i:Int64 -> Int)"},
{"Int$from_num", "func(n:Num, truncate=no -> Int)"},
- {"Int$from_num32", "func(n:Num32, truncate=no -> Int)"});
+ {"Int$from_num32", "func(n:Num32, truncate=no -> Int)"},
+ {"Dec$as_int", "func(d:Dec, truncate=no -> Int)"});
ADD_CONSTRUCTORS("Int64",
{"Int64$from_bool", "func(b:Bool -> Int64)"},
{"Int64$from_byte", "func(b:Byte -> Int64)"},
@@ -451,7 +466,8 @@ env_t *global_env(bool source_mapping)
{"Int64$from_int32", "func(i:Int32 -> Int64)"},
{"Int64$from_int", "func(i:Int, truncate=no -> Int64)"},
{"Int64$from_num", "func(n:Num, truncate=no -> Int64)"},
- {"Int64$from_num32", "func(n:Num32, truncate=no -> Int64)"});
+ {"Int64$from_num32", "func(n:Num32, truncate=no -> Int64)"},
+ {"Dec$as_int64", "func(d:Dec, truncate=no -> Int64)"});
ADD_CONSTRUCTORS("Int32",
{"Int32$from_bool", "func(b:Bool -> Int32)"},
{"Int32$from_byte", "func(b:Byte -> Int32)"},
@@ -460,7 +476,8 @@ env_t *global_env(bool source_mapping)
{"Int32$from_int64", "func(i:Int64, truncate=no -> Int32)"},
{"Int32$from_int", "func(i:Int, truncate=no -> Int32)"},
{"Int32$from_num", "func(n:Num, truncate=no -> Int32)"},
- {"Int32$from_num32", "func(n:Num32, truncate=no -> Int32)"});
+ {"Int32$from_num32", "func(n:Num32, truncate=no -> Int32)"},
+ {"Dec$as_int32", "func(d:Dec, truncate=no -> Int32)"});
ADD_CONSTRUCTORS("Int16",
{"Int16$from_bool", "func(b:Bool -> Int16)"},
{"Int16$from_byte", "func(b:Byte -> Int16)"},
@@ -469,7 +486,8 @@ env_t *global_env(bool source_mapping)
{"Int16$from_int64", "func(i:Int64, truncate=no -> Int16)"},
{"Int16$from_int", "func(i:Int, truncate=no -> Int16)"},
{"Int16$from_num", "func(n:Num, truncate=no -> Int16)"},
- {"Int16$from_num32", "func(n:Num32, truncate=no -> Int16)"});
+ {"Int16$from_num32", "func(n:Num32, truncate=no -> Int16)"},
+ {"Dec$as_int16", "func(d:Dec, truncate=no -> Int16)"});
ADD_CONSTRUCTORS("Int8",
{"Int8$from_bool", "func(b:Bool -> Int8)"},
{"Int8$from_byte", "func(b:Byte -> Int8)"},
@@ -478,7 +496,8 @@ env_t *global_env(bool source_mapping)
{"Int8$from_int64", "func(i:Int64, truncate=no -> Int8)"},
{"Int8$from_int", "func(i:Int, truncate=no -> Int8)"},
{"Int8$from_num", "func(n:Num, truncate=no -> Int8)"},
- {"Int8$from_num32", "func(n:Num32, truncate=no -> Int8)"});
+ {"Int8$from_num32", "func(n:Num32, truncate=no -> Int8)"},
+ {"Dec$as_int8", "func(d:Dec, truncate=no -> Int8)"});
ADD_CONSTRUCTORS("Num",
{"Num$from_bool", "func(b:Bool -> Num)"},
{"Num$from_byte", "func(b:Byte -> Num)"},
@@ -487,7 +506,8 @@ env_t *global_env(bool source_mapping)
{"Num$from_int32", "func(i:Int32 -> Num)"},
{"Num$from_int64", "func(i:Int64, truncate=no -> Num)"},
{"Num$from_int", "func(i:Int, truncate=no -> Num)"},
- {"Num$from_num32", "func(n:Num32 -> Num)"});
+ {"Num$from_num32", "func(n:Num32 -> Num)"},
+ {"Dec$as_num", "func(d:Dec -> Num)"});
ADD_CONSTRUCTORS("Num32",
{"Num32$from_bool", "func(b:Bool -> Num32)"},
{"Num32$from_byte", "func(b:Byte -> Num32)"},
@@ -496,7 +516,18 @@ env_t *global_env(bool source_mapping)
{"Num32$from_int32", "func(i:Int32, truncate=no -> Num32)"},
{"Num32$from_int64", "func(i:Int64, truncate=no -> Num32)"},
{"Num32$from_int", "func(i:Int, truncate=no -> Num32)"},
- {"Num32$from_num", "func(n:Num -> Num32)"});
+ {"Num32$from_num", "func(n:Num -> Num32)"},
+ {"Dec$as_num32", "func(d:Dec -> Num32)"});
+ ADD_CONSTRUCTORS("Dec",
+ {"Dec$from_bool", "func(b:Bool -> Dec)"},
+ {"Dec$from_byte", "func(b:Byte -> Dec)"},
+ {"Dec$from_int8", "func(i:Int8 -> Dec)"},
+ {"Dec$from_int16", "func(i:Int16 -> Dec)"},
+ {"Dec$from_int32", "func(i:Int32 -> Dec)"},
+ {"Dec$from_int64", "func(i:Int64 -> Dec)"},
+ {"Dec$from_num", "func(n:Num -> Dec)"},
+ {"Dec$from_num32", "func(n:Num32 -> Dec)"},
+ {"Dec$from_int", "func(i:Int -> Dec)"});
ADD_CONSTRUCTORS("Path",
{"Path$escape_text", "func(text:Text -> Path)"},
{"Path$escape_path", "func(path:Path -> Path)"},
@@ -690,7 +721,7 @@ env_t *get_namespace_by_type(env_t *env, type_t *t)
case ListType: return NULL;
case TableType: return NULL;
case CStringType:
- case BoolType: case IntType: case BigIntType: case NumType: case ByteType: {
+ case BoolType: case IntType: case BigIntType: case DecType: case NumType: case ByteType: {
binding_t *b = get_binding(env, CORD_to_const_char_star(type_to_cord(t)));
assert(b);
return Match(b->type, TypeInfoType)->env;
diff --git a/src/parse.c b/src/parse.c
index e2f267c1..be1642cf 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -103,6 +103,7 @@ static PARSER(parse_assignment);
static PARSER(parse_block);
static PARSER(parse_bool);
static PARSER(parse_convert_def);
+static PARSER(parse_dec);
static PARSER(parse_declaration);
static PARSER(parse_defer);
static PARSER(parse_do);
@@ -656,6 +657,36 @@ type_ast_t *parse_type(parse_ctx_t *ctx, const char *pos) {
return type;
}
+PARSER(parse_dec) {
+ const char *start = pos;
+ bool negative = false;
+ if (match(&pos, "-$"))
+ negative = true;
+ else if (!match(&pos, "$"))
+ return NULL;
+
+ if (!isdigit(*pos) && *pos != '.') return NULL;
+ else if (*pos == '.' && !isdigit(pos[1])) return NULL;
+
+ size_t len = strspn(pos, "0123456789_");
+ if (strncmp(pos+len, "..", 2) == 0)
+ return NULL;
+ else if (pos[len] == '.')
+ len += 1 + strspn(pos + len + 1, "0123456789_");
+
+ char *buf = GC_MALLOC_ATOMIC(negative + len + 1);
+ memset(buf, 0, len+1);
+ char *dest = buf;
+ if (negative) *(dest++) = '-';
+ for (char *src = (char*)pos; src < pos+len; ++src) {
+ if (*src != '_') *(dest++) = *src;
+ }
+ *(dest++) = '\0';
+ pos += len;
+
+ return NewAST(ctx->file, start, pos, Dec, .str=buf);
+}
+
PARSER(parse_num) {
const char *start = pos;
bool negative = match(&pos, "-");
@@ -666,7 +697,7 @@ PARSER(parse_num) {
if (strncmp(pos+len, "..", 2) == 0)
return NULL;
else if (pos[len] == '.')
- len += 1 + strspn(pos + len + 1, "0123456789");
+ len += 1 + strspn(pos + len + 1, "0123456789_");
else if (pos[len] != 'e' && pos[len] != 'f' && pos[len] != '%')
return NULL;
if (pos[len] == 'e') {
@@ -838,7 +869,7 @@ ast_t *parse_field_suffix(parse_ctx_t *ctx, ast_t *lhs) {
if (*pos == '.') return NULL;
whitespace(&pos);
bool dollar = match(&pos, "$");
- const char* field = get_id(&pos);
+ const char *field = get_id(&pos);
if (!field) return NULL;
if (dollar) field = String("$", field);
return NewAST(ctx->file, lhs->start, pos, FieldAccess, .fielded=lhs, .field=field);
@@ -1296,6 +1327,8 @@ PARSER(parse_text) {
} else if (match(&pos, "'")) { // Single quote
open_quote = '\'', close_quote = '\'', open_interp = '$';
} else if (match(&pos, "$")) { // Customized strings
+ if (isdigit(*pos))
+ return NULL;
lang = get_id(&pos);
// $"..." or $@"...."
static const char *interp_chars = "~!@#$%^&*+=\\?";
@@ -1464,6 +1497,7 @@ PARSER(parse_term_no_suffix) {
(void)(
false
|| (term=parse_none(ctx, pos))
+ || (term=parse_dec(ctx, pos)) // Must come before int
|| (term=parse_num(ctx, pos)) // Must come before int
|| (term=parse_int(ctx, pos))
|| (term=parse_negative(ctx, pos)) // Must come after num/int
diff --git a/src/stdlib/datatypes.h b/src/stdlib/datatypes.h
index 77c09ddb..c06f7a42 100644
--- a/src/stdlib/datatypes.h
+++ b/src/stdlib/datatypes.h
@@ -3,6 +3,7 @@
// Common datastructures (lists, tables, closures)
#include <gmp.h>
+#include <mpdecimal.h>
#include <stdbool.h>
#include <stdint.h>
#include <time.h>
@@ -21,6 +22,9 @@
#define Num_t double
#define Num32_t float
+#define Dec_t mpd_t*
+#define OptionalDec_t mpd_t*
+
#define Int64_t int64_t
#define Int32_t int32_t
#define Int16_t int16_t
diff --git a/src/stdlib/decimals.c b/src/stdlib/decimals.c
new file mode 100644
index 00000000..8bdc2907
--- /dev/null
+++ b/src/stdlib/decimals.c
@@ -0,0 +1,264 @@
+// Integer type infos and methods
+#include <stdio.h> // Must be before gmp.h
+
+#include <ctype.h>
+#include <gc.h>
+#include <mpdecimal.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "bytes.h"
+#include "datatypes.h"
+#include "decimals.h"
+#include "integers.h"
+#include "lists.h"
+#include "nums.h"
+#include "optionals.h"
+#include "print.h"
+#include "siphash.h"
+#include "text.h"
+#include "types.h"
+
+static mpd_context_t ctx = {
+ .prec=30,
+ .emax=25,
+ .emin=-25,
+ .traps=MPD_Division_by_zero | MPD_Overflow | MPD_Subnormal | MPD_Underflow,
+ .status=0,
+ .newtrap=0,
+ .round=MPD_ROUND_HALF_EVEN,
+ .clamp=1,
+ .allcr=1,
+};
+
+static inline char *Dec$as_str(Dec_t d) {
+ char *str = mpd_format(d, "f", &ctx);
+ char *point = strchr(str, '.');
+ if (point == NULL) return str;
+ char *p;
+ for (p = point + strlen(point)-1; p > point && *p == '0'; p--)
+ *p = '\0';
+ if (*p == '.') *p = '\0';
+ return str;
+}
+
+public int Dec$print(FILE *f, Dec_t d) {
+ return fputs(Dec$as_str(d), f);
+}
+
+public Text_t Dec$value_as_text(Dec_t d) {
+ return Text$from_str(Dec$as_str(d));
+}
+
+public Text_t Dec$as_text(const void *d, bool colorize, const TypeInfo_t *info) {
+ (void)info;
+ if (!d) return Text("Dec");
+ Text_t text = Text$from_str(Dec$as_str(*(Dec_t*)d));
+ if (colorize) text = Text$concat(Text("\x1b[35m"), text, Text("\x1b[m"));
+ return text;
+}
+
+static bool Dec$is_none(const void *d, const TypeInfo_t *info)
+{
+ (void)info;
+ return *(Dec_t*)d == NULL;
+}
+
+public PUREFUNC int32_t Dec$compare_value(const Dec_t x, const Dec_t y) {
+ return mpd_compare(D(0), x, y, &ctx);
+}
+
+public PUREFUNC int32_t Dec$compare(const void *x, const void *y, const TypeInfo_t *info) {
+ (void)info;
+ return mpd_compare(D(0), *(Dec_t*)x, *(Dec_t*)y, &ctx);
+}
+
+public PUREFUNC bool Dec$equal_value(const Dec_t x, const Dec_t y) {
+ return Dec$compare_value(x, y) == 0;
+}
+
+public PUREFUNC bool Dec$equal(const void *x, const void *y, const TypeInfo_t *info) {
+ (void)info;
+ return Dec$compare(x, y, info) == 0;
+}
+
+public PUREFUNC uint64_t Dec$hash(const void *vx, const TypeInfo_t *info) {
+ (void)info;
+ Dec_t d = *(Dec_t*)vx;
+ char *str = Dec$as_str(d);
+ return siphash24((void*)str, strlen(str));
+}
+
+public Dec_t Dec$plus(Dec_t x, Dec_t y) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_add(result, x, y, &ctx);
+ return result;
+}
+
+public Dec_t Dec$negative(Dec_t x) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_minus(result, x, &ctx);
+ return result;
+}
+
+public Dec_t Dec$minus(Dec_t x, Dec_t y) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_sub(result, x, y, &ctx);
+ return result;
+}
+
+public Dec_t Dec$times(Dec_t x, Dec_t y) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_mul(result, x, y, &ctx);
+ return result;
+}
+
+public Dec_t Dec$divided_by(Dec_t x, Dec_t y) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_div(result, x, y, &ctx);
+ return result;
+}
+
+public Dec_t Dec$modulo(Dec_t x, Dec_t modulus) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_rem(result, x, modulus, &ctx);
+ return result;
+}
+
+public Dec_t Dec$modulo1(Dec_t x, Dec_t modulus) {
+ return Dec$plus(Dec$modulo(Dec$minus(x, D(1)), modulus), D(1));
+}
+
+public Dec_t Dec$from_str(const char *str) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_set_string(result, str, &ctx);
+ return result;
+}
+
+public Dec_t Dec$from_int64(int64_t i) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_set_i64(result, i, &ctx);
+ return result;
+}
+
+public Dec_t Dec$from_int(Int_t i) {
+ if likely (i.small & 1L) {
+ return Dec$from_int64(i.small >> 2L);
+ }
+ Text_t text = Int$value_as_text(i);
+ const char *str = Text$as_c_string(text);
+ Dec_t result = mpd_new(&ctx);
+ mpd_set_string(result, str, &ctx);
+ return result;
+}
+
+public Dec_t Dec$from_num(double n) {
+ Text_t text = Num$as_text(&n, false, &Num$info);
+ const char *str = Text$as_c_string(text);
+ Dec_t result = mpd_new(&ctx);
+ mpd_set_string(result, str, &ctx);
+ return result;
+}
+
+public Int_t Dec$as_int(Dec_t d, bool truncate) {
+ char *str = Dec$as_str(d);
+ char *decimal = strchr(str, '.');
+ if (!truncate && decimal)
+ fail("Could not convert to an integer without truncation: ", str);
+ *decimal = '\0';
+ return Int$from_str(str);
+}
+
+public int64_t Dec$as_int64(Dec_t d, bool truncate) {
+ return Int64$from_int(Dec$as_int(d, truncate), truncate);
+}
+
+public int32_t Dec$as_int32(Dec_t d, bool truncate) {
+ return Int32$from_int(Dec$as_int(d, truncate), truncate);
+}
+
+public int16_t Dec$as_int16(Dec_t d, bool truncate) {
+ return Int16$from_int(Dec$as_int(d, truncate), truncate);
+}
+
+public int8_t Dec$as_int8(Dec_t d, bool truncate) {
+ return Int8$from_int(Dec$as_int(d, truncate), truncate);
+}
+
+public Byte_t Dec$as_byte(Dec_t d, bool truncate) {
+ return Byte$from_int(Dec$as_int(d, truncate), truncate);
+}
+
+public bool Dec$as_bool(Dec_t d) {
+ return !mpd_iszero(d);
+}
+
+public double Dec$as_num(Dec_t d) {
+ const char *str = Dec$as_str(d);
+ return strtod(str, NULL);
+}
+
+public Dec_t Dec$power(Dec_t base, Dec_t exponent) {
+ Dec_t result = mpd_new(&ctx);
+ mpd_pow(result, base, exponent, &ctx);
+ return result;
+}
+
+public Dec_t Dec$round(Dec_t d, Int_t digits) {
+ Dec_t result = mpd_new(&ctx);
+ if (digits.small != 1L)
+ d = Dec$times(d, Dec$power(D(10), Dec$from_int(digits)));
+ mpd_round_to_int(result, d, &ctx);
+ if (digits.small != 1L)
+ result = Dec$divided_by(result, Dec$power(D(10), Dec$from_int(digits)));
+ return result;
+}
+
+public OptionalDec_t Dec$parse(Text_t text) {
+ Dec_t result = mpd_new(&ctx);
+ uint32_t status = 0;
+ mpd_qset_string(result, Text$as_c_string(text), &ctx, &status);
+ return status == 0 ? result : NONE_DEC;
+}
+
+static void Dec$serialize(const void *obj, FILE *out, Table_t *pointers, const TypeInfo_t *info)
+{
+ (void)info;
+ Dec_t d = *(Dec_t*)obj;
+ char *str = Dec$as_str(d);
+ int64_t len = (int64_t)strlen(str);
+ Int64$serialize(&len, out, pointers, &Int64$info);
+ if (fwrite(str, sizeof(char), (size_t)len, out) != (size_t)len)
+ fail("Could not serialize Dec value!");
+}
+
+static void Dec$deserialize(FILE *in, void *obj, List_t *pointers, const TypeInfo_t *info)
+{
+ (void)info;
+ int64_t len = 0;
+ Int64$deserialize(in, &len, pointers, &Int64$info);
+ assert(len >= 0);
+ char buf[len];
+ if (fread(buf, sizeof(char), (size_t)len, in) != (size_t)len)
+ fail("Could not deserialize Dec value!");
+ Dec_t d = Dec$from_str(buf);
+ memcpy(obj, &d, sizeof(d));
+}
+
+public const TypeInfo_t Dec$info = {
+ .size=sizeof(Dec_t),
+ .align=__alignof__(Dec_t),
+ .metamethods={
+ .compare=Dec$compare,
+ .equal=Dec$equal,
+ .hash=Dec$hash,
+ .as_text=Dec$as_text,
+ .is_none=Dec$is_none,
+ .serialize=Dec$serialize,
+ .deserialize=Dec$deserialize,
+ },
+};
+
+// vim: ts=4 sw=0 et cino=L2,l1,(0,W4,m1,\:0
diff --git a/src/stdlib/decimals.h b/src/stdlib/decimals.h
new file mode 100644
index 00000000..83e69fce
--- /dev/null
+++ b/src/stdlib/decimals.h
@@ -0,0 +1,63 @@
+#pragma once
+
+// Integer type infos and methods
+
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdlib.h>
+#include <mpdecimal.h>
+
+#include "print.h"
+#include "datatypes.h"
+#include "stdlib.h"
+#include "types.h"
+#include "util.h"
+
+#define NONE_DEC ((mpd_t*)NULL)
+
+// #define D(i) Dec$from_int64(i)
+#define D(i) ((mpd_t[1]){MPD_STATIC|MPD_CONST_DATA, 0, 1, 1, 1, (mpd_uint_t[]){i}})
+
+int Dec$print(FILE *f, Dec_t d);
+Text_t Dec$value_as_text(Dec_t d);
+Text_t Dec$as_text(const void *d, bool colorize, const TypeInfo_t *info);
+PUREFUNC int32_t Dec$compare_value(const Dec_t x, const Dec_t y);
+PUREFUNC int32_t Dec$compare(const void *x, const void *y, const TypeInfo_t *info);
+PUREFUNC bool Dec$equal_value(const Dec_t x, const Dec_t y);
+PUREFUNC bool Dec$equal(const void *x, const void *y, const TypeInfo_t *info);
+PUREFUNC uint64_t Dec$hash(const void *vx, const TypeInfo_t *info);
+Dec_t Dec$round(Dec_t d, Int_t digits);
+Dec_t Dec$power(Dec_t base, Dec_t exponent);
+Dec_t Dec$plus(Dec_t x, Dec_t y);
+Dec_t Dec$negative(Dec_t x);
+Dec_t Dec$minus(Dec_t x, Dec_t y);
+Dec_t Dec$times(Dec_t x, Dec_t y);
+Dec_t Dec$divided_by(Dec_t x, Dec_t y);
+Dec_t Dec$modulo(Dec_t x, Dec_t modulus);
+Dec_t Dec$modulo1(Dec_t x, Dec_t modulus);
+Dec_t Dec$from_str(const char *str);
+OptionalDec_t Dec$parse(Text_t text);
+
+Dec_t Dec$from_int64(int64_t i);
+Dec_t Dec$from_int(Int_t i);
+Dec_t Dec$from_num(double n);
+#define Dec$from_num32(n) Dec$from_num((double)n)
+#define Dec$from_int32(i) Dec$from_int64((int64_t)i)
+#define Dec$from_int16(i) Dec$from_int64((int64_t)i)
+#define Dec$from_int8(i) Dec$from_int64((int64_t)i)
+#define Dec$from_byte(i) Dec$from_int64((int64_t)i)
+#define Dec$from_bool(i) Dec$from_int64((int64_t)i)
+
+Int_t Dec$as_int(Dec_t d, bool truncate);
+int64_t Dec$as_int64(Dec_t d, bool truncate);
+int32_t Dec$as_int32(Dec_t d, bool truncate);
+int16_t Dec$as_int16(Dec_t d, bool truncate);
+int8_t Dec$as_int8(Dec_t d, bool truncate);
+Byte_t Dec$as_byte(Dec_t d, bool truncate);
+bool Dec$as_bool(Dec_t d);
+double Dec$as_num(Dec_t d);
+#define Dec$as_num32(d) ((float)Dec$as_num(d))
+
+extern const TypeInfo_t Dec$info;
+
+// vim: ts=4 sw=0 et cino=L2,l1,(0,W4,m1,\:0
diff --git a/src/stdlib/stdlib.c b/src/stdlib/stdlib.c
index fa41cda6..472be526 100644
--- a/src/stdlib/stdlib.c
+++ b/src/stdlib/stdlib.c
@@ -5,6 +5,7 @@
#include <fcntl.h>
#include <gc.h>
#include <locale.h>
+#include <mpdecimal.h>
#include <signal.h>
#include <stdbool.h>
#include <stdint.h>
@@ -57,6 +58,25 @@ static _Noreturn void signal_handler(int sig, siginfo_t *info, void *userdata)
_exit(1);
}
+static _Noreturn void fpe_handler(int sig, siginfo_t *info, void *userdata)
+{
+ (void)info, (void)userdata;
+ assert(sig == SIGFPE);
+ fflush(stdout);
+ if (USE_COLOR) fputs("\x1b[31;7m ===== MATH EXCEPTION ===== \n\n\x1b[m", stderr);
+ else fputs("===== MATH EXCEPTION =====\n\n", stderr);
+ print_stacktrace(stderr, 3);
+ fflush(stderr);
+ raise(SIGABRT);
+ _exit(1);
+}
+
+
+static void *GC_calloc(size_t n, size_t size)
+{
+ return GC_malloc(n*size);
+}
+
public void tomo_init(void)
{
GC_INIT();
@@ -67,11 +87,22 @@ public void tomo_init(void)
setlocale(LC_ALL, "");
assert(getrandom(TOMO_HASH_KEY, sizeof(TOMO_HASH_KEY), 0) == sizeof(TOMO_HASH_KEY));
- struct sigaction sigact;
- sigact.sa_sigaction = signal_handler;
- sigemptyset(&sigact.sa_mask);
- sigact.sa_flags = 0;
- sigaction(SIGILL, &sigact, (struct sigaction *)NULL);
+ mpd_mallocfunc = GC_malloc;
+ mpd_callocfunc = GC_calloc;
+ mpd_reallocfunc = GC_realloc;
+ mpd_free = GC_free;
+
+ struct sigaction ill_sigaction;
+ ill_sigaction.sa_sigaction = signal_handler;
+ sigemptyset(&ill_sigaction.sa_mask);
+ ill_sigaction.sa_flags = 0;
+ sigaction(SIGILL, &ill_sigaction, (struct sigaction *)NULL);
+
+ struct sigaction fpe_sigaction;
+ fpe_sigaction.sa_sigaction = fpe_handler;
+ sigemptyset(&fpe_sigaction.sa_mask);
+ fpe_sigaction.sa_flags = 0;
+ sigaction(SIGFPE, &fpe_sigaction, (struct sigaction *)NULL);
}
static bool parse_single_arg(const TypeInfo_t *info, char *arg, void *dest)
diff --git a/src/stdlib/tomo.h b/src/stdlib/tomo.h
index 63abd2d6..62139ea4 100644
--- a/src/stdlib/tomo.h
+++ b/src/stdlib/tomo.h
@@ -11,6 +11,7 @@
#include "bytes.h"
#include "c_strings.h"
#include "datatypes.h"
+#include "decimals.h"
#include "enums.h"
#include "functiontype.h"
#include "integers.h"
diff --git a/src/tomo.c b/src/tomo.c
index b534c491..02891bef 100644
--- a/src/tomo.c
+++ b/src/tomo.c
@@ -84,7 +84,7 @@ static OptionalText_t
#endif
" -DGC_THREADS"
" -I'" TOMO_PREFIX "/include' -I'" TOMO_PREFIX "/share/tomo_"TOMO_VERSION"/installed' -I/usr/local/include"),
- ldlibs = Text("-lgc -lm -lgmp -lunistring -ltomo_"TOMO_VERSION),
+ ldlibs = Text("-lgc -lm -lgmp -lmpdec -lunistring -ltomo_"TOMO_VERSION),
ldflags = Text("-Wl,-rpath,'"TOMO_PREFIX"/lib',-rpath,/usr/local/lib"
" -L/usr/local/lib"),
optimization = Text("2"),
diff --git a/src/typecheck.c b/src/typecheck.c
index 6fdfb1d8..6d23efce 100644
--- a/src/typecheck.c
+++ b/src/typecheck.c
@@ -638,6 +638,9 @@ type_t *get_type(env_t *env, ast_t *ast)
case Num: {
return Type(NumType, .bits=TYPE_NBITS64);
}
+ case Dec: {
+ return Type(DecType);
+ }
case HeapAllocate: {
type_t *pointed = get_type(env, Match(ast, HeapAllocate)->value);
if (has_stack_memory(pointed))
@@ -880,8 +883,8 @@ type_t *get_type(env_t *env, ast_t *ast)
binding_t *constructor = get_constructor(env, t, call->args);
if (constructor)
return t;
- else if (t->tag == StructType || t->tag == IntType || t->tag == BigIntType || t->tag == NumType
- || t->tag == ByteType || t->tag == TextType || t->tag == CStringType)
+ else if (t->tag == StructType || t->tag == IntType || t->tag == BigIntType || t->tag == DecType || t->tag == NumType
+ || t->tag == DecType || t->tag == ByteType || t->tag == TextType || t->tag == CStringType)
return t; // Constructor
code_err(call->fn, "This is not a type that has a constructor");
}
diff --git a/src/types.c b/src/types.c
index 1a2405d4..391f71ed 100644
--- a/src/types.c
+++ b/src/types.c
@@ -2,6 +2,7 @@
#include <gc/cord.h>
#include <limits.h>
#include <math.h>
+#include <mpdecimal.h>
#include <signal.h>
#include <stdint.h>
#include <sys/param.h>
@@ -32,6 +33,7 @@ CORD type_to_cord(type_t *t) {
case CStringType: return "CString";
case TextType: return Match(t, TextType)->lang ? Match(t, TextType)->lang : "Text";
case BigIntType: return "Int";
+ case DecType: return "Dec";
case IntType: return String("Int", Match(t, IntType)->bits);
case NumType: return Match(t, NumType)->bits == TYPE_NBITS32 ? "Num32" : "Num";
case ListType: {
@@ -181,6 +183,7 @@ static PUREFUNC INLINE double type_min_magnitude(type_t *t)
case BoolType: return (double)false;
case ByteType: return 0;
case BigIntType: return -1./0.;
+ case DecType: return -1./0.;
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS8: return (double)INT8_MIN;
@@ -201,6 +204,7 @@ static PUREFUNC INLINE double type_max_magnitude(type_t *t)
case BoolType: return (double)true;
case ByteType: return (double)UINT8_MAX;
case BigIntType: return 1./0.;
+ case DecType: return 1./0.;
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS8: return (double)INT8_MAX;
@@ -247,6 +251,7 @@ PUREFUNC bool has_heap_memory(type_t *t)
case PointerType: return true;
case OptionalType: return has_heap_memory(Match(t, OptionalType)->type);
case BigIntType: return true;
+ case DecType: return true;
case StructType: {
for (arg_t *field = Match(t, StructType)->fields; field; field = field->next) {
if (has_heap_memory(field->type))
@@ -306,10 +311,10 @@ PUREFUNC bool can_promote(type_t *actual, type_t *needed)
if (actual->tag == NumType && needed->tag == IntType)
return false;
- if (actual->tag == IntType && (needed->tag == NumType || needed->tag == BigIntType))
+ if (actual->tag == IntType && (needed->tag == NumType || needed->tag == BigIntType || needed->tag == DecType))
return true;
- if (actual->tag == BigIntType && needed->tag == NumType)
+ if (actual->tag == BigIntType && (needed->tag == DecType || needed->tag == NumType))
return true;
if (actual->tag == IntType && needed->tag == IntType) {
@@ -426,7 +431,7 @@ PUREFUNC bool is_int_type(type_t *t)
PUREFUNC bool is_numeric_type(type_t *t)
{
- return t->tag == IntType || t->tag == BigIntType || t->tag == NumType || t->tag == ByteType;
+ return t->tag == IntType || t->tag == BigIntType || t->tag == DecType || t->tag == NumType || t->tag == ByteType;
}
PUREFUNC bool is_packed_data(type_t *t)
@@ -498,6 +503,7 @@ PUREFUNC size_t type_size(type_t *t)
case ByteType: return sizeof(uint8_t);
case CStringType: return sizeof(char*);
case BigIntType: return sizeof(Int_t);
+ case DecType: return sizeof(Dec_t);
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS64: return sizeof(int64_t);
@@ -589,6 +595,7 @@ PUREFUNC size_t type_align(type_t *t)
case ByteType: return __alignof__(uint8_t);
case CStringType: return __alignof__(char*);
case BigIntType: return __alignof__(Int_t);
+ case DecType: return __alignof__(Dec_t);
case IntType: {
switch (Match(t, IntType)->bits) {
case TYPE_IBITS64: return __alignof__(int64_t);
diff --git a/src/types.h b/src/types.h
index 3b789560..c29c1bb7 100644
--- a/src/types.h
+++ b/src/types.h
@@ -44,6 +44,7 @@ struct type_s {
ByteType,
BigIntType,
IntType,
+ DecType,
NumType,
CStringType,
TextType,
@@ -67,6 +68,7 @@ struct type_s {
type_t *ret;
} ReturnType;
struct {} BigIntType;
+ struct {} DecType;
struct {
enum { TYPE_IBITS8=8, TYPE_IBITS16=16, TYPE_IBITS32=32, TYPE_IBITS64=64 } bits;
} IntType;
@@ -129,6 +131,7 @@ struct type_s {
#define Type(typetag, ...) new(type_t, .tag=typetag, .__data.typetag={__VA_ARGS__})
#define INT_TYPE Type(BigIntType)
+#define DEC_TYPE Type(DecType)
#define NUM_TYPE Type(NumType, .bits=TYPE_NBITS64)
#define NewFunctionType(ret, ...) _make_function_type(ret, sizeof((arg_t[]){__VA_ARGS__})/sizeof(arg_t), (arg_t[]){__VA_ARGS__})
diff --git a/test/decimals.tm b/test/decimals.tm
new file mode 100644
index 00000000..db7b3526
--- /dev/null
+++ b/test/decimals.tm
@@ -0,0 +1,49 @@
+# Tests for decimal numbers
+
+func square(n:Dec -> Dec)
+ return n * n
+
+func main()
+ >> one_third := $1/$3
+ = $0.333333333333333333333333333333
+ >> two_thirds := $2/$3
+ = $0.666666666666666666666666666667
+ >> one_third + two_thirds == $1
+ = yes
+
+ >> square(5) # Promotion
+ = $25
+
+ >> square(Dec(1.5))
+ = $2.25
+
+ # Round-to-even:
+ >> $1.5.round()
+ = $2
+ >> $2.5.round()
+ = $2
+
+ >> $2 + $3
+ = $5
+
+ >> $2 - $3
+ = -$1
+
+ >> $2 * $3
+ = $6
+
+ >> $3 ^ $2
+ = $9
+
+ >> $10.1 mod 3
+ >> $1.1
+
+ >> $10 mod1 5
+ >> $5
+
+ >> $1 + 2
+ = $3
+
+ >> $1 + Int64(2)
+ = $3
+
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-01 04:57:22 +0000