Hi, I am playing with stack semantics inspired from the prolog code and heading towards a more clean construction where we can have it live in both scheme and c.
The idea is to program like programming in scheme but outputting a subset of pure c code e.g. no gotos and the loops inspired by named let's, no gc, no lambdas etc. So it is pretty lame as features goes. To see how it looks consider the source code in stack.clam and the output by loading that file as out.c. This will be the first iteration. The idea is to refactor the code later on to depending on if output is scheme or c-code. Note this is just a very simplistic setup with almost no type deduction hence the functional properties of it will break where a little more intelligent type deduction is needed. So pretty lame right now. If interested I could put up a repo at github with the code (requires a patched fmt library as of version 0.8) /Stefan
stack.clam
Description: Binary data
/*
Copyright: Stefan Israelsson Tampe
Licence : LGPL, any version.
*/
const int stack__size = 1024;
#line 0
typedef struct stack {
int size;
char * data;
char * pt;
stack ** head;
stack * prev;
} stack;
#line 0
typedef struct stack__frame {
stack * head;
char * pt;
} stack__frame;
#line 0
typedef struct action {
char type;
} action;
#line 0
typedef struct stack__action {
char id;
stack__frame sf;
action header;
} stack__action;
stack * _sstacks_s[256];
stack__action * _sstack__actions_s[256];
int _sstack__list_s[256];
int _slast__stack__id_s = 0;
stack * _sres__stacks_s[256];
stack ** _sres__stack__pt_s;
void update__stack__action (action * a) {
{
void ret73145;
{
#line 124
{
stack__action * sa;
sa = (stack__action *)a;
{
int id;
id = sa->id;
{
stack__action * old;
old = AREF(_sstack__list_s, id);
{
#line 127
if (!old) {
{
#line 123
AREF(_sstack__actions_s,
_slast__stack__id_s)
= id;
#line 123
++_slast__stack__id_s;
}
}
#line 128
{
{
#line 128
AREF(_sstack__actions_s, id) = sa;
}
ret73145 = AREF(_sstack__actions_s, id);
}
}
}
}
}
}
ret73145;
}
}
stack * unwind (stack **, stack__frame *, int int);
void clear__stack (int int, stack__action **);
void free__stack (stack *);
stack * new__stack ();
void unwind__dependent__stacks (int unwind_p) {
{
void ret73148;
{
#line 176
{
int i;
i = 0;
loop:
{
#line 177
if (i < _slast__stack_s) {
{
stack__action * sta;
sta
= AREF(_sstack__actions_s,
AREF(_sstack__list_s, i));
{
stack * res;
res = unwind((sta->s), (sta->fr), unwind_p);
{
#line 185
if (unwind_p) {
{
#line 175
*_sres__stack_s = res;
#line 175
#line 175
}
}
#line 186
AREF(_sstack__actions_s,
AREF(_sstack__list_s, i))
= 0;
#line 187
{
i = i + 1;
goto loop;
}
}
}
}
} else {
{
{
#line 187
_slast__stack_s = 0;
}
ret73148 = _slast__stack_s;
}
}
}
}
}
ret73148;
}
}
stack * unwind__actions (stack__frame * sf, stack ** stp, int split_p) {
{
stack * ret73152;
{
#line 196
{
stack * st;
st = *stp;
{
action * sa;
sa = (action *)st->pt;
{
#line 198
{
stack * s;
s = st;
action * a;
a = sa;
loop:
{
{
#line 202
{
int case73151;
case73151 = a->type;
if (s == 0) {
{
#line 203
{
#line 204
a
= (action *)a
- &((stack__action *)0.header);
#line 205
update__stack__action((stack__action *)a);
}
}
}
}
}
{
#line 210
if ((char *)a == sf->pt) {
{
#line 214
ret73152
= unwind__dependent__stacks(split_p);
}
} else {
if ((char *)a == a->data) {
{
#line 219
{
stack * sold;
sold = s;
{
#line 220
s = s->prev;
#line 221
free__stack(sold);
#line 222
{
s = s;
a = s->pt;
goto loop;
}
}
}
}
} else {
{
#line 224
{
s = s;
a = a - 1;
goto loop;
}
}
}
}
}
}
}
}
}
}
}
return ret73152;
}
}
stack * unwind (stack__frame * sf, stack ** stp, int split_p) {
{
stack * ret73155;
{
#line 247
{
stack * st;
st = *stp;
{
#line 248
{
stack * s;
s = st;
stack * old;
old = st;
loop:
{
#line 249
if (s == sf->stack) {
{
#line 252
s->pt = sf->pt;
#line 253
if (split_p) {
{
int i;
i = s->pt - s->data;
{
int n;
n = s->size - i;
{
stack * ns;
ns = new__stack();
{
char * data;
data = s->pt;
{
#line 261
if (old == st) {
*stp = ns;
} else {
old->prev = ns;
}
#line 266
ns->data = data;
#line 267
ns->size = n;
#line 268
ns->pt = data;
#line 269
ns->head = stp;
#line 270
if (old == st) {
ns->prev
= null;
} else {
ns->prev = old;
}
#line 275
s->size = i;
#line 275
scheme@(guile-user)> ret73155 = ns;
}
}
}
}
}
} else {
ret73155 = s;
}
}
} else {
{
#line 281
if (split_p) {
if (s == old) {
s->prev = null;
} else {
s->prev = old;
}
}
#line 285
{
s = s->prev;
old = s;
goto loop;
}
}
}
}
}
}
}
}
return ret73155;
}
}
char * alloc__from__stack (int id, int size) {
{
char * ret73160;
{
#line 297
{
stack ** sp;
sp = AREF(_sstacks_s, id);
{
stack * s;
s = *sp;
{
int i;
i = s->pt - s->data;
{
int n;
n = size + i;
{
#line 301
{
stack * ns;
ns = new__stack();
{
char * ret;
ret = stack->pt;
{
#line 305
ns->next = s;
#line 306
ns->pt = ns->pt + size;
#line 307
*sp = ns;
#line 307
ret73160 = ret;
}
}
}
}
}
}
}
}
}
return ret73160;
}
}
stack__action * insert__stack__frame (int stack__id) {
{
stack__action * ret73167;
{
#line 319
{
stack__action * sa;
sa
= (stack__action *)alloc__from__stack(0,
(sizeof(stack__action)));
{
stack * s;
s = AREF(_sstacks_s, stack__id);
{
#line 323
sa->id = id;
#line 324
sa->sf.stack = s;
#line 325
sa->sf.pt = s->pt;
#line 326
sa->header.type = 0;
#line 326
ret73167 = sa;
}
}
}
}
return ret73167;
}
}
"
