blob: 85221ea6a2e04062899f4bcdb0783c4da6ae520d [file] [log] [blame]
swissChilib3ca4fb2021-04-20 10:33:00 -07001#include "std.h"
swissChilif68671f2021-07-05 14:14:44 -07002#include "../plat/plat.h"
swissChilif3e7f182021-04-20 13:57:22 -07003#include <stdlib.h>
swissChilif68671f2021-07-05 14:14:44 -07004#include <string.h>
swissChilib3ca4fb2021-04-20 10:33:00 -07005
swissChili53472e82021-05-08 16:06:32 -07006value_t l_plus(value_t a, value_t b)
swissChilib3ca4fb2021-04-20 10:33:00 -07007{
swissChili53472e82021-05-08 16:06:32 -07008 if (!integerp(a) || !integerp(b))
swissChilib3ca4fb2021-04-20 10:33:00 -07009 return nil;
10
11 return (((a >> 2) + (b >> 2)) << 2) | INT_TAG;
12}
13
swissChili53472e82021-05-08 16:06:32 -070014value_t l_minus(value_t a, value_t b)
swissChili6aff2bb2021-04-20 15:02:53 -070015{
swissChili53472e82021-05-08 16:06:32 -070016 if (!integerp(a) || !integerp(b))
swissChili6aff2bb2021-04-20 15:02:53 -070017 return nil;
18
19 return (((a >> 2) - (b >> 2)) << 2) | INT_TAG;
20}
21
swissChili53472e82021-05-08 16:06:32 -070022value_t l_times(value_t a, value_t b)
swissChili6aff2bb2021-04-20 15:02:53 -070023{
swissChili53472e82021-05-08 16:06:32 -070024 if (!integerp(a) || !integerp(b))
swissChili6aff2bb2021-04-20 15:02:53 -070025 return nil;
26
27 return (((a >> 2) * (b >> 2)) << 2) | INT_TAG;
28}
29
swissChili53472e82021-05-08 16:06:32 -070030value_t l_divide(value_t a, value_t b)
swissChili6aff2bb2021-04-20 15:02:53 -070031{
swissChili53472e82021-05-08 16:06:32 -070032 if (!integerp(a) || !integerp(b))
swissChili6aff2bb2021-04-20 15:02:53 -070033 return nil;
34
35 return (((a >> 2) / (b >> 2)) << 2) | INT_TAG;
36}
37
swissChili53472e82021-05-08 16:06:32 -070038value_t l_printval(value_t val)
swissChili8fc5e2f2021-04-22 13:45:10 -070039{
swissChili53472e82021-05-08 16:06:32 -070040 printval(val, 0);
swissChili8fc5e2f2021-04-22 13:45:10 -070041 return nil;
42}
43
swissChiliddc97542021-07-04 11:47:42 -070044value_t l_apply(value_t func, value_t args)
45{
46 if (!closurep(func))
47 return nil;
48
49 if (!listp(args))
50 return nil;
51
52 return call_list_closure((struct closure *)(func ^ CLOSURE_TAG), args);
53}
54
swissChili15f1cae2021-07-05 19:08:47 -070055value_t l_nilp(value_t val)
56{
57 return nilp(val) ? t : nil;
58}
59
60void add_function(struct environment *env, char *name, void *func, struct args *args, enum namespace ns)
swissChilib3ca4fb2021-04-20 10:33:00 -070061{
swissChili53472e82021-05-08 16:06:32 -070062 struct function *last, *new = malloc(sizeof(struct function));
swissChilib3ca4fb2021-04-20 10:33:00 -070063
64 last = env->first;
65 new->prev = last;
66 new->name = name;
swissChili15f1cae2021-07-05 19:08:47 -070067 new->args = args;
swissChilib3ca4fb2021-04-20 10:33:00 -070068 new->code_ptr = func;
swissChili2999dd12021-07-02 14:19:53 -070069 new->namespace = ns;
swissChilib3ca4fb2021-04-20 10:33:00 -070070
swissChilif3e7f182021-04-20 13:57:22 -070071 env->first = new;
swissChilib3ca4fb2021-04-20 10:33:00 -070072}
73
swissChili15f1cae2021-07-05 19:08:47 -070074void add_c_function(struct environment *env, char *name, void *func, int nargs)
75{
76 struct args *args = new_args();
77 args->num_required = nargs;
78
79 add_function(env, name, func, args, NS_FUNCTION);
80}
81
82value_t l_elt(value_t seq, value_t i)
83{
84 if (!listp(seq) || !integerp(i))
85 return nil;
86
87 return elt(seq, i >> 2);
88}
89
swissChili7e1393c2021-07-07 12:59:12 -070090value_t l_read_stdin()
91{
92 char *string = read_input_line("lisp> ");
93 if (!string)
94 return nil;
95
96 struct istream *is = new_stristream_nt(string);
97
98 value_t val = nil;
99 read1(is, &val);
100
101 del_stristream(is);
102 free(string);
103
104 return val;
105}
106
swissChili53e7cd12021-08-02 21:55:53 -0700107value_t l_num_eq(value_t a, value_t b)
108{
109 if (!integerp(a) || !integerp(b))
110 {
111 return nil;
112 }
113
114 return (a >> 3) == (b >> 3) ? t : nil;
115}
116
swissChili53472e82021-05-08 16:06:32 -0700117void load_std(struct environment *env)
swissChilib3ca4fb2021-04-20 10:33:00 -0700118{
swissChili15f1cae2021-07-05 19:08:47 -0700119 add_c_function(env, "+", l_plus, 2);
120 add_c_function(env, "-", l_minus, 2);
121 add_c_function(env, "*", l_times, 2);
122 add_c_function(env, "/", l_divide, 2);
swissChili53e7cd12021-08-02 21:55:53 -0700123 add_c_function(env, "=", l_num_eq, 2);
swissChili8fc5e2f2021-04-22 13:45:10 -0700124
swissChili15f1cae2021-07-05 19:08:47 -0700125 add_c_function(env, "car", car, 1);
126 add_c_function(env, "cdr", cdr, 1);
127 add_c_function(env, "cons", cons, 2);
swissChili8fc5e2f2021-04-22 13:45:10 -0700128
swissChili15f1cae2021-07-05 19:08:47 -0700129 add_c_function(env, "print", l_printval, 1);
swissChili7e1393c2021-07-07 12:59:12 -0700130 add_c_function(env, "read-stdin", l_read_stdin, 0);
swissChili15f1cae2021-07-05 19:08:47 -0700131 add_c_function(env, "apply", l_apply, 2);
swissChiliddc97542021-07-04 11:47:42 -0700132
swissChili15f1cae2021-07-05 19:08:47 -0700133 add_c_function(env, "nilp", l_nilp, 1);
134 add_c_function(env, "elt", l_elt, 2);
swissChilif68671f2021-07-05 14:14:44 -0700135
136 if (!load_library(env, "std"))
137 {
138 err("Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
139 }
140}
141
142bool load_library(struct environment *env, char *name)
143{
144 char *lib_paths = getenv("LISP_LIBRARY_PATH");
145
146 if (!lib_paths)
147 lib_paths = "/lib/lisp";
148
149 for (char *p = strtok(lib_paths, ":"); p; p = strtok(NULL, ":"))
150 {
151 static char path[512];
152 snprintf(path, 512, "%s/%s.lisp", p, name);
153
154 if (file_exists(path))
155 {
156 return load(env, path);
157 }
158
159 snprintf(path, 512, "%s/%s/%s.lisp", p, name, name);
160
161 if (file_exists(path))
162 {
163 return load(env, path);
164 }
165 }
166
167 return false;
swissChilib3ca4fb2021-04-20 10:33:00 -0700168}