From http://esolangs.org/wiki/Category:Unimplemented , select a programming language. Write an implementation for it and post it. If you want to pick something else and implement it better than what's already there, go for it. No prizes or shit, because real EXPERT PROGRAMMERS do it for the thrill of the chase.
(No, I'm not L.A. Calculus, I'm not angry enough.)
I'll throw my hand in as well, so you can at least get the satisfaction of laughing at me. I might do CAT or Knight Shuffling Tower.
for (size_t i = 0; i < len; i++) {
if (in[i] == '\r' || in[i] == '\n') {
num_lines++;
if (in[i] == '\r' && i + 1 < len && in[i + 1] == '\n') {
i++;
}
}
}
str *jagg = malloc(sizeof(str) * num_lines);
int line = 0;
for (size_t i = 0; i < len; i++) {
char c = *in;
if (c == '\r' || c == '\n') {
jagg[line++] = (str) {.data = linestart, .len = in - linestart};
if (c == '\r' && i + 1 < len && *(in + 1) == '\n') { in++; i++; }
linestart = in + 1;
}
in++;
}
jagg[line++] = (str) {.data = linestart, .len = in - linestart};
return (arr_strs) {.arr = jagg, .len = line};
}
typedef struct {
int row, col, dir_row, dir_col;
int data_pointer, data_allocated;
int *data;
arr_strs script;
} interpreter_state;
void interpreter_error(char *error, interpreter_state *restrict s) {
char *direction = "???";
if (s->dir_row == 1 && s->dir_col == 0) direction = "Down";
else if (s->dir_row == -1 && s->dir_col == 0) direction = "Up";
else if (s->dir_row == 0 && s->dir_col == 1) direction = "Right";
else if (s->dir_row == 0 && s->dir_col == -1) direction = "Left";
fprintf(stderr, "\n---Error---\n%s\nLine %d char %d\nDirection: %s\nData pointer: %d\nData cells (hex):\n", error, s->row, s->col, direction, s->data_pointer);
for (int i = 0; i < s->data_allocated; i++) {
fprintf(stderr, "\t%08X: %08X\n", i, s->data[i]);
}
}
int ensure_data(interpreter_state *restrict s) {
if (s->data_pointer < 0) {
interpreter_error("Tried to write to a negative address", s);
return 0;
}
if (s->data_pointer >= s->data_allocated) {
int orig_allocated = s->data_allocated;
s->data_allocated = s->data_pointer + 1;
s->data = realloc(s->data, s->data_allocated * sizeof(*s->data));
if (s->data == NULL) {
interpreter_error("Out of memory", s);
return 0;
}
while (orig_allocated < s->data_allocated) {
s->data[orig_allocated++] = 0;
}
}
return 1;
}
int within_bounds(interpreter_state *restrict s) {
if (s->row < 0 || s->col < 0) return 0;
if (s->row >= s->script.len) return 0;
if (s->dir_row == 0 && s->col >= s->script.arr[s->row].len) return 0;
return 1;
}
int interpret_once(interpreter_state *restrict s) {
switch (s->script.arr[s->row].data[s->col]) {
case '<':
s->data_pointer--;
break;
case '>':
s->data_pointer++;
break;
case '+':
if (!ensure_data(s)) return 0;
s->data[s->data_pointer]++;
break;
case '-':
if (!ensure_data(s)) return 0;
s->data[s->data_pointer]--;
break;
case '.':
if (!ensure_data(s)) return 0;
putchar(s->data[s->data_pointer]);
break;
case ',':
if (!ensure_data(s)) return 0;
s->data[s->data_pointer] = getchar();
break;
case 'U':
s->dir_row = -1;
s->dir_col = 0;
break;
case 'D':
s->dir_row = 1;
s->dir_col = 0;
break;
case 'L':
s->dir_row = 0;
s->dir_col = -1;
break;
case 'R':
s->dir_row = 0;
s->dir_col = 1;
break;
case '[':
if (!ensure_data(s)) return 0;
if (s->data[s->data_pointer] == 0) {
int num_brackets = 1;
do {
s->row += s->dir_row;
s->col += s->dir_col;
if (!within_bounds(s)) break;
char c = s->script.arr[s->row].data[s->col];
if (c == '[') num_brackets++;
else if (c == ']') num_brackets--;
} while (num_brackets > 0);
if (!within_bounds(s)) {
interpreter_error("Fell off the end of the script looking for a \"]\"", s);
return 0;
}
}
break;
case ']':
if (!ensure_data(s)) return 0;
if (s->data[s->data_pointer] != 0) {
int num_brackets = 1;
do {
s->row -= s->dir_row;
s->col -= s->dir_col;
if (!within_bounds(s)) break;
char c = s->script.arr[s->row].data[s->col];
if (c == ']') num_brackets++;
else if (c == '[') num_brackets--;
} while (num_brackets > 0);
if (!within_bounds(s)) {
interpreter_error("Fell off the end of the script looking for a \"[\"", s);
return 0;
}
}
break;
case ' ':
break;
default:
interpreter_error("Invalid opcode", s);
return 0;
}
return 1;
}
void interpret(arr_strs script) {
interpreter_state s = {.dir_col = 1, .script = script};
while (within_bounds(&s)) {
if (s.col < s.script.arr[s.row].len)
if (!interpret_once(&s))
break;
s.row += s.dir_row;
s.col += s.dir_col;
}
if (s.data != NULL) free(s.data);
}
int main(int argc, char **argv) {
if (argc < 2) {
puts("At least give me some files to execute.");
return 0;
}
for (int i = 1; i < argc; i++) {
FILE *f = fopen(argv[i], "rb");
if (!f) {
fprintf(stderr, "Could not open the script \"%s\": ", argv[i]);
perror(NULL);
continue;
}
fseek(f, 0, SEEK_END);
long f_len = ftell(f);
fseek(f, 0, SEEK_SET);
>>9
Yep! Set Theory is definitely esoteric. I dont understand why people treat mathematics like something normal and even use it to describe physical phenomena.
Name:
L. A. Calculus!!wKyoNUUHDOmjW7I2013-06-02 20:44
>>14
COS DEYRE A BUNCH OF RETOIDED MATH BOYS. DATS Y.
Name:
Anonymous2013-06-02 21:00
>>15
What is your favorite infinite set, Calculus-kun?
>>7
Yeah, I know I'm late. I've got it almost working now, just some bugs with the AST generation. It thinks it's supposed to generate arithmetic for every operation instead of functions.
Name:
L. A. Calculus!!wKyoNUUHDOmjW7I2013-06-03 2:21
OP, late as fuck, of course. I blame it on the fact that the sample programs on KST were actually incorrect. I ended up doing actual AST building and such, so it's a bit too large to just post the code.
data Term = R | Lam | Seq Term Term | Loop Term
type Tape = Top :>> [Int] :>> Int
-- Run a P'' term over a tape, in an alphabet of size n.
-- Returns Nothing if the program moves off the tape. Note
-- that directions are flipped; the left-infinite tape is
-- implemented as a right-infinite list zipper.
runTerm :: Int -> Term -> Tape -> Maybe Tape
runTerm n R = leftward
runTerm n Lam = focus %~ (\x -> succ x `mod` n) >>> rightward
runTerm n (Seq p q) = runTerm n p >=> runTerm n q
runTerm n (Loop p) = \tape ->
case tape ^. focus of
0 -> Just tape
_ -> runTerm n p >=> runTerm n (Loop p) $ tape
-- Run a P'' program over an empty tape.
runP'' :: Int -> Term -> Maybe Tape
runP'' n p = runTerm n p blankTape
where blankTape = zipper (repeat 0) & fromWithin traverse