liamoc.net
the hito embeddable programming language
1#include "bitset.h"
2#include "builtins.h"
3#include "error.h"
4#include "eval.h"
5#include "intern.h"
6#include "lexer.h"
7#include "scope.h"
8#include "source.h"
9#include "stdio.h"
10#include "syntax.h"
11#include "error.h"
12#include "value.h"
13#include <string.h>
14#define generate_comp_binop(op_name, op_expr) \
15value_t * op_name(gc_t *gc, value_t **args, size_t num_args) { \
16 if (num_args != 2) \
17 return NULL; \
18 if (args[0] == NULL || args[1] == NULL) return NULL; \
19 if (args[0]->tag == VALUE_INT && args[1]->tag == VALUE_INT) { \
20 long lhs = args[0]->as.integer; \
21 long rhs = args[1]->as.integer; \
22 int result = op_expr; \
23 return(value_alloc_bool(gc,result)); \
24 } else if ( (args[0]->tag == VALUE_FLOAT || args[0]->tag == VALUE_INT) \
25 && (args[1]->tag == VALUE_FLOAT || args[1]->tag == VALUE_INT) ) { \
26 double lhs = (args[0]->tag == VALUE_FLOAT) ? args[0]->as.floating : (double)args[0]->as.integer; \
27 double rhs = (args[0]->tag == VALUE_FLOAT) ? args[1]->as.floating : (double)args[1]->as.integer; \
28 int result = op_expr; \
29 return(value_alloc_bool(gc,result)); \
30 } else return NULL; \
31}
32bool primop_eq_impl(value_t *arg0, value_t *arg1) {
33 if (arg0 == NULL || arg1 == NULL) return true;
34 if (arg0->tag == VALUE_INT && arg1->tag == VALUE_INT) {
35 return (arg0->as.integer == arg1->as.integer);
36 } else if ( (arg0->tag == VALUE_FLOAT || arg0->tag == VALUE_INT)
37 && (arg1->tag == VALUE_FLOAT || arg1->tag == VALUE_INT) ) {
38 double lhs = (arg0->tag == VALUE_FLOAT) ? arg0->as.floating : (double)arg0->as.integer;
39 double rhs = (arg0->tag == VALUE_FLOAT) ? arg1->as.floating : (double)arg1->as.integer;
40 return (lhs==rhs);
41 } else if ( arg0->tag == VALUE_STRING && arg1->tag == VALUE_STRING) {
42 return (strcmp(arg0->as.string.string, arg1->as.string.string) == 0);
43 } else if ( arg0->tag == VALUE_BUILTIN && arg1->tag == VALUE_BUILTIN) {
44 return (arg0->as.builtin == arg1->as.builtin);
45 } else if ( arg0->tag == VALUE_CLOSURE && arg1->tag == VALUE_CLOSURE) {
46 return (arg0 == arg1);
47 } else if ( arg0->tag == VALUE_CONSTRUCTOR && arg1->tag == VALUE_CONSTRUCTOR) {
48 if (arg0->as.constructor.name == arg1->as.constructor.name
49 && arg0->as.constructor.num_args == arg1->as.constructor.num_args) {
50 for (int i = 0; i < arg0->as.constructor.num_args; i++) {
51 if (!primop_eq_impl(arg0->as.constructor.args[i],arg1->as.constructor.args[i]))
52 return false;
53 }
54 return true;
55 }
56 }
57}
58value_t * primop_eq(gc_t *gc, value_t **args, size_t num_args) {
59 if (num_args != 2)
60 return NULL;
61 return value_alloc_bool(gc, primop_eq_impl(args[0], args[1]));
62}
63value_t * primop_noteq(gc_t *gc, value_t **args, size_t num_args) {
64 if (num_args != 2)
65 return NULL;
66 return value_alloc_bool(gc, !primop_eq_impl(args[0], args[1]));
67}
68#define generate_arith_binop(op_name, op_expr) \
69 value_t * op_name(gc_t *gc, value_t **args, size_t num_args) { \
70 if (num_args != 2) \
71 return NULL; \
72 if (args[0] == NULL || args[1] == NULL) return NULL; \
73 if (args[0]->tag == VALUE_INT && args[1]->tag == VALUE_INT) { \
74 long lhs = args[0]->as.integer; \
75 long rhs = args[1]->as.integer; \
76 long result = op_expr; \
77 return value_alloc_int(gc, result); \
78 } else if ( (args[0]->tag == VALUE_FLOAT || args[0]->tag == VALUE_INT) \
79 && (args[1]->tag == VALUE_FLOAT || args[1]->tag == VALUE_INT) ) { \
80 double lhs = (args[0]->tag == VALUE_FLOAT) ? args[0]->as.floating : (double)args[0]->as.integer; \
81 double rhs = (args[0]->tag == VALUE_FLOAT) ? args[1]->as.floating : (double)args[1]->as.integer; \
82 return value_alloc_float(gc, op_expr); \
83 } else return NULL; \
84 }
85generate_arith_binop(primop_plus, lhs + rhs)
86generate_arith_binop(primop_minus, lhs - rhs)
87generate_arith_binop(primop_mult, lhs * rhs)
88generate_arith_binop(primop_div, lhs / rhs)
89generate_arith_binop(primop_mod, (long)lhs % (long)rhs)
90generate_arith_binop(primop_idiv, (long)lhs / (long)rhs)
91
92generate_comp_binop(primop_greater, lhs > rhs)
93generate_comp_binop(primop_lesser, lhs < rhs)
94generate_comp_binop(primop_greatereq, lhs >= rhs)
95generate_comp_binop(primop_lessereq, lhs <= rhs)
96
97
98int main(int argc, char**argv) {
99 source_t *source = source_alloc_from_file("test.hito");
100 lexer_t *lexer = lexer_alloc(source);
101 token_t tok;
102 intern_table_t *table = intern_table_alloc();
103 builtins_t *builtins = builtins_alloc();
104 builtins_add(builtins, intern(table,"+"),primop_plus);
105 builtins_add(builtins, intern(table,"-"),primop_minus);
106 builtins_add(builtins, intern(table,"mod"),primop_mod);
107 builtins_add(builtins, intern(table,"/"),primop_div);
108 builtins_add(builtins, intern(table,"div"),primop_idiv);
109 builtins_add(builtins, intern(table,"*"),primop_mult);
110
111 builtins_add(builtins, intern(table,">"),primop_greater);
112 builtins_add(builtins, intern(table,"<"),primop_lesser);
113 builtins_add(builtins, intern(table,">="),primop_greatereq);
114 builtins_add(builtins, intern(table,"<="),primop_lessereq);
115 builtins_add(builtins, intern(table,"="),primop_eq);
116 builtins_add(builtins, intern(table,"/="),primop_noteq);
117 expr_t *expr = syntax_parse_expr(lexer, builtins, table);
118 printf("%p\n", expr);
119 if (expr == NULL) return 1;
120 syntax_dump_expr(expr);
121 printf("\n");
122 gc_t *gc = gc_alloc();
123 value_t *v = eval(expr, gc);
124 value_debug_dump(v);
125 printf("\n");
126}