return newenv;
}
+
+
+char* lookup_builtin(Sexpr* b) {
+ // uh yeah i guess
+ // needs to be updated manually i suppose
+ uint64_t prefix = b->value.b.opcode >> 8;
+ uint64_t suffix = b->value.b.opcode & 0xff;
+ switch(prefix) {
+ case CORE_PREFIX:
+ switch(suffix) {
+ case CORE_QUOTE:
+ return CORE_QUOTE_STR;
+ case CORE_CONS:
+ return CORE_CONS_STR;
+ case CORE_CAR:
+ return CORE_CAR_STR;
+ case CORE_CDR:
+ return CORE_CDR_STR;
+ case CORE_IF:
+ return CORE_IF_STR;
+ case CORE_EQ:
+ return CORE_EQ_STR;
+ case CORE_NOT:
+ return CORE_NOT_STR;
+ case CORE_ATOM:
+ return CORE_ATOM_STR;
+ case CORE_DEF:
+ return CORE_DEF_STR;
+ case CORE_EXIT:
+ return CORE_EXIT_STR;
+ default:
+ return "NOT FOUND (CORE)";
+ }
+ case ARITH_PREFIX:
+ switch(suffix) {
+ case ARITH_ADD:
+ return ARITH_ADD_STR;
+ case ARITH_SUB:
+ return ARITH_SUB_STR;
+ case ARITH_MUL:
+ return ARITH_MUL_STR;
+ case ARITH_DIV:
+ return ARITH_DIV_STR;
+ case ARITH_MOD:
+ return ARITH_MOD_STR;
+ default:
+ return "NOT FOUND (ARITH)";
+ }
+ case COMB_PREFIX:
+ switch(suffix) {
+ case COMB_I:
+ return COMB_I_STR;
+ case COMB_S:
+ return COMB_S_STR;
+ case COMB_K:
+ return COMB_K_STR;
+ case COMB_B:
+ return COMB_B_STR;
+ case COMB_C:
+ return COMB_C_STR;
+ case COMB_W:
+ return COMB_W_STR;
+ case COMB_PHI:
+ return COMB_PHI_STR;
+ case COMB_PSI:
+ return COMB_PSI_STR;
+ case COMB_Z:
+ return COMB_Z_STR;
+ default:
+ return "NOT FOUND (COMB)";
+ }
+ case IO_PREFIX:
+ switch(suffix) {
+ case IO_PRINT:
+ return IO_PRINT_STR;
+ case IO_BPA:
+ return IO_BPA_STR;
+ default:
+ return "NOT FOUND (IO)";
+ }
+ default:
+ return "NOT FOUND";
+ }
+ return "NOT FOUND";
+}
+
void load_builtin(char* ks, uint64_t op, Sexpr* env);
Sexpr* load_env(Sexpr* env);
+char* lookup_builtin(Sexpr* b);
+
#endif
}
Sexpr* load_arith_env(Sexpr* env) {
- load_builtin("+", (ARITH_PREFIX << 8) | ARITH_ADD, env);
- load_builtin("-", (ARITH_PREFIX << 8) | ARITH_SUB, env);
- load_builtin("*", (ARITH_PREFIX << 8) | ARITH_MUL, env);
- load_builtin("/", (ARITH_PREFIX << 8) | ARITH_DIV, env);
- load_builtin("%", (ARITH_PREFIX << 8) | ARITH_MOD, env);
+ load_builtin(ARITH_ADD_STR, (ARITH_PREFIX << 8) | ARITH_ADD, env);
+ load_builtin(ARITH_SUB_STR, (ARITH_PREFIX << 8) | ARITH_SUB, env);
+ load_builtin(ARITH_MUL_STR, (ARITH_PREFIX << 8) | ARITH_MUL, env);
+ load_builtin(ARITH_DIV_STR, (ARITH_PREFIX << 8) | ARITH_DIV, env);
+ load_builtin(ARITH_MOD_STR, (ARITH_PREFIX << 8) | ARITH_MOD, env);
return env;
}
#define ARITH_ADD 0x00
#define ARITH_ADD_ARGS 2
+#define ARITH_ADD_STR "+"
#define ARITH_SUB 0x01
#define ARITH_SUB_ARGS 2
+#define ARITH_SUB_STR "-"
#define ARITH_MUL 0x02
#define ARITH_MUL_ARGS 2
+#define ARITH_MUL_STR "*"
#define ARITH_DIV 0x03
#define ARITH_DIV_ARGS 2
+#define ARITH_DIV_STR "/"
#define ARITH_MOD 0x04
#define ARITH_MOD_ARGS 2
+#define ARITH_MOD_STR "%"
Sexpr* x_arith_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
Sexpr* load_arith_env(Sexpr* env);
Sexpr* z = from_opcode((COMB_PREFIX << 8) | COMB_Z);
Sexpr* zg = cons(z, cons(g2, from_nil()));
//return cons(g, rest);
- return cons(g,cons(zg, cons(v, rest)));
+ Sexpr* toret = cons(g,cons(zg, cons(v, rest)));
+ return toret;
}
}
Sexpr* load_comb_env(Sexpr* env) {
- load_builtin("I", (COMB_PREFIX << 8) | COMB_I, env);
- load_builtin("S", (COMB_PREFIX << 8) | COMB_S, env);
- load_builtin("K", (COMB_PREFIX << 8) | COMB_K, env);
- load_builtin("B", (COMB_PREFIX << 8) | COMB_B, env);
- load_builtin("C", (COMB_PREFIX << 8) | COMB_C, env);
- load_builtin("W", (COMB_PREFIX << 8) | COMB_W, env);
- load_builtin("Phi", (COMB_PREFIX << 8) | COMB_PHI, env);
- load_builtin("Psi", (COMB_PREFIX << 8) | COMB_PSI, env);
- load_builtin("Z", (COMB_PREFIX << 8) | COMB_Z, env);
+ load_builtin(COMB_I_STR, (COMB_PREFIX << 8) | COMB_I, env);
+ load_builtin(COMB_S_STR, (COMB_PREFIX << 8) | COMB_S, env);
+ load_builtin(COMB_K_STR, (COMB_PREFIX << 8) | COMB_K, env);
+ load_builtin(COMB_B_STR, (COMB_PREFIX << 8) | COMB_B, env);
+ load_builtin(COMB_C_STR, (COMB_PREFIX << 8) | COMB_C, env);
+ load_builtin(COMB_W_STR, (COMB_PREFIX << 8) | COMB_W, env);
+ load_builtin(COMB_PHI_STR, (COMB_PREFIX << 8) | COMB_PHI, env);
+ load_builtin(COMB_PSI_STR, (COMB_PREFIX << 8) | COMB_PSI, env);
+ load_builtin(COMB_Z_STR, (COMB_PREFIX << 8) | COMB_Z, env);
return env;
}
#define COMB_I 0x00
#define COMB_I_ARGS 1
+#define COMB_I_STR "I"
#define COMB_S 0x01
#define COMB_S_ARGS 3
+#define COMB_S_STR "S"
#define COMB_K 0x02
#define COMB_K_ARGS 2
+#define COMB_K_STR "K"
#define COMB_B 0x03
#define COMB_B_ARGS 3
+#define COMB_B_STR "B"
#define COMB_C 0x04
#define COMB_C_ARGS 3
+#define COMB_C_STR "C"
#define COMB_W 0x05
#define COMB_W_ARGS 2
+#define COMB_W_STR "W"
#define COMB_PHI 0x06
#define COMB_PHI_ARGS 4
+#define COMB_PHI_STR "Phi"
#define COMB_PSI 0x07
#define COMB_PSI_ARGS 4
+#define COMB_PSI_STR "Psi"
#define COMB_Z 0x08
#define COMB_Z_ARGS 2
+#define COMB_Z_STR "Z"
Sexpr* x_comb_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
Sexpr* load_comb_env(Sexpr* env);
Sexpr* load_core_env(Sexpr* env) {
- load_builtin("quote", (CORE_PREFIX << 8) | CORE_QUOTE, env);
- load_builtin("cons", (CORE_PREFIX << 8) | CORE_CONS, env);
- load_builtin("car", (CORE_PREFIX << 8) | CORE_CAR, env);
- load_builtin("cdr", (CORE_PREFIX << 8) | CORE_CDR, env);
- load_builtin("if", (CORE_PREFIX << 8) | CORE_IF, env);
- load_builtin("eq", (CORE_PREFIX << 8) | CORE_EQ, env);
- load_builtin("not", (CORE_PREFIX << 8) | CORE_NOT, env);
- load_builtin("atom", (CORE_PREFIX << 8) | CORE_ATOM, env);
+ load_builtin(CORE_QUOTE_STR, (CORE_PREFIX << 8) | CORE_QUOTE, env);
+ load_builtin(CORE_CONS_STR, (CORE_PREFIX << 8) | CORE_CONS, env);
+ load_builtin(CORE_CAR_STR, (CORE_PREFIX << 8) | CORE_CAR, env);
+ load_builtin(CORE_CDR_STR, (CORE_PREFIX << 8) | CORE_CDR, env);
+ load_builtin(CORE_IF_STR, (CORE_PREFIX << 8) | CORE_IF, env);
+ load_builtin(CORE_EQ_STR, (CORE_PREFIX << 8) | CORE_EQ, env);
+ load_builtin(CORE_NOT_STR, (CORE_PREFIX << 8) | CORE_NOT, env);
+ load_builtin(CORE_ATOM_STR, (CORE_PREFIX << 8) | CORE_ATOM, env);
- load_builtin("def", (CORE_PREFIX << 8) | CORE_DEF, env);
- load_builtin("exit", (CORE_PREFIX << 8) | CORE_EXIT, env);
+ load_builtin(CORE_DEF_STR, (CORE_PREFIX << 8) | CORE_DEF, env);
+ load_builtin(CORE_EXIT_STR, (CORE_PREFIX << 8) | CORE_EXIT, env);
return env;
}
#define CORE_QUOTE 0x00
#define CORE_QUOTE_ARGS 1
+#define CORE_QUOTE_STR "quote"
#define CORE_CONS 0x01
#define CORE_CONS_ARGS 2
+#define CORE_CONS_STR "cons"
#define CORE_CAR 0x02
#define CORE_CAR_ARGS 1
+#define CORE_CAR_STR "car"
#define CORE_CDR 0x03
#define CORE_CDR_ARGS 1
+#define CORE_CDR_STR "cdr"
#define CORE_IF 0x04
#define CORE_IF_ARGS 3
+#define CORE_IF_STR "if"
#define CORE_EQ 0x05
#define CORE_EQ_ARGS 2
+#define CORE_EQ_STR "eq"
#define CORE_NOT 0x06
#define CORE_NOT_ARGS 1
+#define CORE_NOT_STR "not"
#define CORE_ATOM 0x07
#define CORE_ATOM_ARGS 1
+#define CORE_ATOM_STR "atom"
#define CORE_APPLYN 0x08
#define CORE_APPLYN_ARGS 3
+#define CORE_APPLYN_STR "applyn"
#define CORE_DEF 0xfe // huh do i want this so close to exit?
#define CORE_DEF_ARGS 2
+#define CORE_DEF_STR "def"
#define CORE_EXIT 0xff
#define CORE_EXIT_ARGS 1
+#define CORE_EXIT_STR "exit"
Sexpr* x_core_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
Sexpr* load_core_env(Sexpr* env);
#include "../sexpr.h"
#include "../config.h"
#include "io.h"
+#include "../eval.h"
#include <stdlib.h>
#include <inttypes.h>
return cons(from_t(), rest);
}
+Sexpr* io_print_b(Sexpr* b, Sexpr* rest, Sexpr* env) {
+ if(IO_PB_ARGS != u64_get_num_args(b)) {
+ return cons(b, rest);
+ }
+ Sexpr* arg = clone(car(b->value.b.args));
+ sexpr_free(b);
+ Sexpr* argeval = eval(arg, env);
+ char* out = sprint_sexpr_builtin(argeval);
+ sexpr_free(argeval);
+ // uhh do i free arg? don't think so...
+ PRINT(out);
+ free(out);
+ return cons(from_t(), rest);
+}
+
Sexpr* x_io_dispatch(Sexpr* b, Sexpr* rest, Sexpr* env) {
uint64_t code = b->value.b.opcode & 0xff;
switch(code) {
case IO_PRINT:
return io_print(b, rest, env);
+ case IO_PB:
+ return io_print_b(b, rest, env);
default:
return from_nil();
}
}
Sexpr* load_io_env(Sexpr* env) {
- load_builtin("print", (IO_PREFIX << 8) | IO_PRINT, env);
+ load_builtin(IO_PRINT_STR, (IO_PREFIX << 8) | IO_PRINT, env);
+ load_builtin(IO_PB_STR, (IO_PREFIX << 8) | IO_PB, env);
return env;
}
#define IO_PRINT 0x00
#define IO_PRINT_ARGS 1
+#define IO_PRINT_STR "print"
+#define IO_PB 0x01
+#define IO_PB_ARGS 1
+#define IO_PB_STR "pb"
Sexpr* x_io_dispatch(Sexpr* s, Sexpr* rest, Sexpr* env);
Sexpr* load_io_env(Sexpr* env);
Sexpr* apply_builtin(Sexpr* func, Sexpr* arg, Sexpr* env);
Sexpr* eval(Sexpr* s, Sexpr* dict) {
- /* char* out = sprint_sexpr(s);
- printf("s: %s\n", out);
+ /* char* out = sprint_sexpr_builtin(s);
+ PRINT(out);
free(out); */
// okay.. important to note,
// this needs to free s
#include "types.h"
#include "sexpr.h"
+#include "builtins.h"
Sexpr* from_nil() {
out = malloc(nbytes*sizeof(char));
out[0] = '_';
snprintf(out + 1, nbytes, "%" PRIu64 "", s->value.b.opcode);
- return out;
+ return out;
}
else if(s->type == QUOTE) {
return sprint_sexpr(s->value.q);
}
return NULL;
}
+
+char* sprint_sexpr_builtin(Sexpr* s) {
+ if(s == NULL) {
+ WARN("UH OH IT'S NULL", "");
+ return NULL;
+ }
+ // assumes not null
+ size_t nbytes;
+ char* out;
+ if(s->type == NIL) {
+ out = malloc(4*sizeof(char));
+ strcpy(out, "nil");
+ return out;
+ }
+ else if(s->type == T) {
+ out = malloc(2*sizeof(char));
+ strcpy(out, "t");
+ return out;
+ }
+ else if(s->type == SYM) {
+ out = malloc(sizeof(char)*(strlen(s->value.s)+1));
+ strcpy(out, s->value.s);
+ return out;
+ }
+ else if(s->type == PTR) {
+ out = strdup("<*>");
+ return out;
+ }
+ else if(s->type == UINT) {
+ nbytes = snprintf(NULL, 0, "%" K_UINT_PRINT "", s->value.u) + 1;
+ out = malloc(nbytes*sizeof(char));
+ snprintf(out, nbytes, "%" PRIu64 "", s->value.u);
+ return out;
+ }
+ else if(s->type == BUILTIN) {
+ nbytes = snprintf(NULL, 0, "%s", lookup_builtin(s))+2;
+ //nbytes = snprintf(NULL, 0, "%" PRIu64 "", s->value.b.opcode) + 2;
+ out = malloc(nbytes*sizeof(char));
+ out[0] = '_';
+ snprintf(out + 1, nbytes, "%s", lookup_builtin(s));
+ //snprintf(out + 1, nbytes, "%" PRIu64 "", s->value.b.opcode);
+ out[nbytes-1] = '<';
+ //out[nbytes] = '\0';
+ char* rest = sprint_sexpr_builtin(s->value.b.args);
+ out = realloc(out, nbytes + strlen(rest) + 2);
+ strcpy(out+nbytes, rest);
+ out[nbytes+strlen(rest)] = '>';
+ out[nbytes+strlen(rest)+1] = '\0';
+ free(rest);
+ return out;
+ }
+ else if(s->type == QUOTE) {
+ return sprint_sexpr_builtin(s->value.q);
+ }
+ else if(s->type == CONS) {
+ Sexpr* curr_cell = s;
+ size_t currsize = 2;
+ out = malloc(currsize*sizeof(char));
+ out[0] = '(';
+ out[1] = '\0';
+ while(curr_cell->type == CONS) {
+ char* carstr = sprint_sexpr_builtin(car(curr_cell));
+ currsize += strlen(carstr) + 1; // trailing space/close paren
+ out = realloc(out, currsize);
+ strcat(out, carstr);
+ free(carstr);
+ strcat(out, " ");
+ curr_cell = cdr(curr_cell);
+ }
+ if(curr_cell->type == NIL) {
+ out[currsize-2] = ')';
+ out[currsize-1] = '\0';
+ return out;
+ }
+ else { // non-nil
+ char* cdrstr = sprint_sexpr_builtin(curr_cell);
+ currsize += strlen(cdrstr) + 4; // dot, space, close, null-terminator
+ strcat(out, ". ");
+ strcat(out, cdrstr);
+ strcat(out, ")");
+ out[currsize-1] = '\0';
+ free(cdrstr);
+ return out;
+ }
+ }
+ return NULL;
+}
Sexpr* reverse(Sexpr* s);
Sexpr* equal(Sexpr* a, Sexpr* b);
char* sprint_sexpr(Sexpr* s);
+char* sprint_sexpr_builtin(Sexpr* s);
#endif
home / projects / klapaucius / commitdiff