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; } } "