/*
Copyright © 2023 Simon Forman
This file is part of Thun
Thun is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Thun is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Thun. If not see .
████████╗██╗ ██╗██╗ ██╗███╗ ██╗
╚══██╔══╝██║ ██║██║ ██║████╗ ██║
██║ ███████║██║ ██║██╔██╗ ██║
██║ ██╔══██║██║ ██║██║╚██╗██║
██║ ██║ ██║╚██████╔╝██║ ╚████║
╚═╝ ╚═╝ ╚═╝ ╚═════╝ ╚═╝ ╚═══╝
This program implements an interpreter for a dialect of Joy.
Joy is a programming language created by Manfred von Thun that is easy to
use and understand and has many other nice properties. This Python
package implements an interpreter for a dialect of Joy that attempts to
stay very close to the spirit of Joy but does not precisely match the
behaviour of the original version(s) written in C. The main difference
between Thun and the originals, other than being written in Python, is
that it works by the “Continuation-Passing Style”.
Here is an example of Joy code:
[ [[abs] ii <=]
[
[<>] [pop !-] ||
] &&
]
[[ !-] [[++]] [[--]] ifte dip]
[[pop !-] [--] [++] ifte ]
ifte
This function accepts two integers on the stack and increments or
decrements one of them such that the new pair of numbers is the next
coordinate pair in a square spiral (like the kind used to construct an
Ulam Spiral).
*/
#include
#include
#include
#include
#include
#include
const char *BLANKS = " \t";
const char *FALSE = "false";
const char *TRUE = "true";
enum JoyTypeType {
joySymbol,
joyTrue,
joyFalse,
joyInt,
joyList
};
struct JoyType {
enum JoyTypeType kind;
union {
int boolean;
mpz_t i;
struct list_node* el;
char *symbol;
} value;
} name ;
struct list_node {
struct JoyType head; /* Should this be a pointer? */
struct list_node* tail;
} JoyList;
void*
reallocate_function (void *ptr, __attribute__((unused)) size_t old_size, size_t new_size) {
return GC_REALLOC(ptr, new_size);
}
void
deallocate_function (void *ptr, __attribute__((unused)) size_t size) {
GC_FREE(ptr);
}
void
my_callback(GC_PTR void_obj, __attribute__((unused)) GC_PTR void_environment) {
/*MY_ENVIRONMENT *env = (MY_ENVIRONMENT)void_environment;*/
mpz_t *obj = (mpz_t*)void_obj;
mpz_clear(*obj);
}
struct list_node*
push_integer_from_str(char *str, struct list_node* tail)
{
struct list_node* el;
el = GC_malloc(sizeof(struct list_node));
el->head.kind = joyInt;
mpz_init_set_str(el->head.value.i, str, 10);
GC_register_finalizer(el->head.value.i, my_callback, NULL, NULL, NULL);
el->tail = tail;
return el;
}
/* Pre-declare so we can use it in print_node(). */
void
print_list(struct list_node* el);
void
print_node(struct JoyType j)
{
switch (j.kind) {
case joyInt:
gmp_printf("%Zd", j.value.i);
break;
case joySymbol:
printf("%s", j.value.symbol);
break;
case joyTrue:
printf("true");
break;
case joyFalse:
printf("false");
break;
case joyList:
printf("[");
print_list(j.value.el);
printf("]");
break;
default:
printf("wtf");
}
}
void
print_list(struct list_node* el)
{
while (NULL != el) {
print_node(el->head);
el = el->tail;
if (NULL != el) {
printf(" ");
}
}
}
char *
trim_leading_blanks(char *str)
{
size_t offset = strspn(str, BLANKS);
return (offset == strlen(str)) ? NULL : (str + offset);
}
struct list_node*
make_non_list_node(char *text, size_t size)
{
struct list_node *node;
char *sym;
sym = GC_malloc(size + 1); /* one more for the zero, right? */
strncat(sym, text, size);
node = GC_malloc(sizeof(struct list_node));
if (!strncmp(sym, FALSE, 6)) { /* I know it's wrong to hardcode the length here. Sorry. */
/* If head was a pointer we could reuse Boolean singletons... */
node->head.kind = joyFalse;
node->head.value.boolean = 0;
} else if (!strncmp(sym, TRUE, 5)) { /* I know it's wrong to hardcode the length here. Sorry. */
node->head.kind = joyTrue;
node->head.value.boolean = 1;
} else if (mpz_init_set_str(node->head.value.i, sym, 10)) {
/* Non-zero (-1) return value means the string is not an int. */
mpz_clear(node->head.value.i);
node->head.kind = joySymbol;
node->head.value.symbol = sym;
} else {
node->head.kind = joyInt;
GC_register_finalizer(node->head.value.i, my_callback, NULL, NULL, NULL);
}
return node;
}
/* Create a new list_node with a joyList head. */
struct list_node*
make_list_node(struct list_node *el)
{
struct list_node *node;
node = GC_malloc(sizeof(struct list_node));
node->head.kind = joyList;
node->head.value.el = el;
return node;
}
#define EMPTY_LIST (struct list_node*)NULL
/*
Extract terms from the text until a closing bracket is found.
*/
struct list_node*
parse_list(char **text)
{
char *rest;
ptrdiff_t diff;
struct list_node *result = NULL;
/* NULL string input? */
if (NULL == *text) {
printf("Missing ']' bracket. A\n");
exit(1);
};
*text = trim_leading_blanks(*text);
if (NULL == *text) {
printf("Missing ']' bracket. B\n");
exit(1);
};
/* Look for blanks or brackets. */
rest = strpbrk(*text, " []");
/*
rest now points to a space or '[' or ']' after a term,
-or- it is NULL if the rest of the string is a single term
with no spaces nor brackets. If that's the case then we're
missing a closing bracket!
*/
if (NULL == rest) {
printf("Missing ']' bracket. C\n");
exit(1);
};
/* How many chars have we got? */
diff = rest - *text;
if (diff) {
result = make_non_list_node(*text, diff);
*text = rest;
} else if ('[' == rest[0]) {
*text = ++rest;
result = make_list_node(parse_list(text));
} else if (']' == rest[0]) {
*text = ++rest;
return result;
}
result->tail = parse_list(text);
return result;
}
/*
Get the next node from the text, updating text
to point to the rest of the, uh, text.
*/
struct list_node*
parse_node(char **text)
{
char *rest;
ptrdiff_t diff;
struct list_node *thing;
/* NULL string input? */
if (NULL == *text) return EMPTY_LIST;
*text = trim_leading_blanks(*text);
/* All blanks? */
if (NULL == *text) return EMPTY_LIST;
/* Look for blanks or brackets. */
rest = strpbrk(*text, " []");
/*
rest now points to a space or '[' or ']' after a term,
-or- it is NULL if the rest of the string is a single term
with no spaces nor brackets. If that's the case then we're
done, and we can just return a list with one symbol in it.
*/
if (NULL == rest) {
thing = make_non_list_node(*text, strlen(*text));
*text = rest;
return thing;
}
/* How many chars have we got? */
diff = rest - *text;
if (diff) {
thing = make_non_list_node(*text, diff);
*text = rest;
return thing;
}
if ('[' == rest[0]) {
*text = ++rest;
return make_list_node(parse_list(text));
}
if (']' == rest[0]) {
printf("Extra ']' bracket.\n");
exit(1);
}
printf("Should be unreachable.");
exit(1);
}
struct list_node*
text_to_expression(char *text)
{
struct list_node *result, *head, *tail;
result = parse_node(&text);
head = result;
tail = parse_node(&text);
while (NULL != tail) {
head->tail = tail;
head = tail;
tail = parse_node(&text);
}
return result;
}
int
main(void)
{
char *line;
char *status;
mp_set_memory_functions(
&GC_malloc,
&reallocate_function,
&deallocate_function
);
line = (char *)GC_malloc(1025);
while (1) {
status = gets_s(line, 1025);
if (NULL == status) {
/*
From the man page:
> Upon successful completion, fgets(), gets_s(), and gets() return a
pointer to the string. If end-of-file occurs before any characters are
read, they return NULL and the buffer contents remain unchanged. If an
error occurs, they return NULL and the buffer contents are indeterminate.
The fgets(), gets_s(), and gets() functions do not distinguish between
end-of-file and error, and callers must use feof(3) and ferror(3) to
determine which occurred.
TODO: "use feof(3) and ferror(3)"...
*/
printf("bye\n");
break;
}
print_list(text_to_expression(line));
printf("\n");
}
return 0;
}